├── .github ├── .gitignore ├── workflows │ ├── pkgdown.yaml │ └── R-CMD-check.yaml ├── CONTRIBUTING.md └── CODE_OF_CONDUCT.md ├── vignettes ├── .gitignore ├── graphics │ ├── survey-of-shinysurveys │ │ ├── mc_example.png │ │ ├── matrix_example.png │ │ ├── minimal-survey.png │ │ ├── numeric_example.png │ │ ├── yes_no_example.png │ │ ├── dependency_example_1.png │ │ ├── dependency_example_2.png │ │ ├── select_input_example.png │ │ ├── required_submit_enabled.png │ │ ├── text_input_placeholder.png │ │ ├── required_submit_disabled.png │ │ └── text_input_character_string.png │ ├── custom-input-extensions │ │ ├── date_input.png │ │ └── slider_input.png │ └── get-survey-data │ │ ├── demo-survey-screenshot.png │ │ └── dependency-survey-screenshot.png ├── shinysurveys.Rmd ├── custom-input-extensions.Rmd ├── get-survey-data.Rmd └── surveying-shinysurveys.Rmd ├── LICENSE ├── .DS_Store ├── R ├── .DS_Store ├── zzz.R ├── utils.R ├── data.R ├── utils_multipage-ui.R ├── utils_get-survey-data.R ├── input_numberInput.R ├── utils_parse-questions.R ├── func_demo-surveys.R ├── utils_javascript-message-handlers.R ├── utils_survey-output.R ├── func_render-survey.R ├── utils_render-survey.R ├── func_get-survey-data.R ├── input_radioMatrixInput.R ├── func_extend-shinysurveys.R └── func_survey-output.R ├── data └── teaching_r_questions.rda ├── .gitignore ├── .Rbuildignore ├── inst ├── WORDLIST ├── save_data.js ├── radioMatrixInput │ ├── js │ │ └── radioMatrixInput.js │ └── css │ │ └── radioMatrixInput.css ├── shinysurveys-js.js └── render_survey.scss ├── tests └── testthat │ ├── test-helpers-survey-code.R │ ├── test-surveyOutput-teaching_r_questions.R │ ├── test-surveyOutput-matrix_questions.R │ ├── test-surveyOutput-ds_questions.R │ ├── test-surveyOutput-instructions.R │ ├── test-server-multi-check.R │ ├── test-get_survey_data.R │ ├── test-surveyOutput-paged_questions.R │ ├── test-survey_code.R │ └── _snaps │ └── surveyOutput-ds_questions.md ├── NAMESPACE ├── man ├── getID.Rd ├── get_questions.Rd ├── multipaged_ui.Rd ├── enable_element.Rd ├── title_placeholder.Rd ├── disable_element.Rd ├── pluck_by_index.Rd ├── split_dependence.Rd ├── add_class.Rd ├── create_radio_input_id.Rd ├── base_extract_user_id.Rd ├── remove_class.Rd ├── showDependence.Rd ├── surveyOutput_individual.Rd ├── checkIndividual.Rd ├── button_placeholders.Rd ├── toggle_element.Rd ├── listUniqueQuestions.Rd ├── addPages.Rd ├── getRequired_internal.Rd ├── radioMatHeader.Rd ├── radioBody.Rd ├── demo_survey.Rd ├── checkRequired_internal.Rd ├── radioMatrixButtons.Rd ├── addRequiredUI_internal.Rd ├── demo_survey_multipage.Rd ├── check_survey_metadata.Rd ├── surveyID.Rd ├── hideSurvey.Rd ├── surveyOptions.Rd ├── surveyLabel.Rd ├── listInputExtensions.Rd ├── teaching_r_questions.Rd ├── renderSurvey.Rd ├── numberInput.Rd ├── surveyOutput.Rd ├── getSurveyData.Rd ├── radioMatrixInput.Rd └── extendInputType.Rd ├── shinysurveys.Rproj ├── LICENSE.md ├── DESCRIPTION ├── _pkgdown.yml ├── NEWS.md └── README.md /.github/.gitignore: -------------------------------------------------------------------------------- 1 | *.html 2 | -------------------------------------------------------------------------------- /vignettes/.gitignore: -------------------------------------------------------------------------------- 1 | *.html 2 | *.R 3 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | YEAR: 2020 2 | COPYRIGHT HOLDER: Jonathan D. Trattner 3 | -------------------------------------------------------------------------------- /.DS_Store: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jdtrat/shinysurveys/HEAD/.DS_Store -------------------------------------------------------------------------------- /R/.DS_Store: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jdtrat/shinysurveys/HEAD/R/.DS_Store -------------------------------------------------------------------------------- /data/teaching_r_questions.rda: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jdtrat/shinysurveys/HEAD/data/teaching_r_questions.rda -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | .DS_Store 2 | .Rproj.user 3 | .Rhistory 4 | .RData 5 | .Ruserdata 6 | inst/doc 7 | docs 8 | doc 9 | Meta 10 | cran-comments.md 11 | -------------------------------------------------------------------------------- /vignettes/graphics/survey-of-shinysurveys/mc_example.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jdtrat/shinysurveys/HEAD/vignettes/graphics/survey-of-shinysurveys/mc_example.png -------------------------------------------------------------------------------- /vignettes/graphics/custom-input-extensions/date_input.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jdtrat/shinysurveys/HEAD/vignettes/graphics/custom-input-extensions/date_input.png -------------------------------------------------------------------------------- /vignettes/graphics/custom-input-extensions/slider_input.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jdtrat/shinysurveys/HEAD/vignettes/graphics/custom-input-extensions/slider_input.png -------------------------------------------------------------------------------- /vignettes/graphics/get-survey-data/demo-survey-screenshot.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jdtrat/shinysurveys/HEAD/vignettes/graphics/get-survey-data/demo-survey-screenshot.png -------------------------------------------------------------------------------- /vignettes/graphics/survey-of-shinysurveys/matrix_example.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jdtrat/shinysurveys/HEAD/vignettes/graphics/survey-of-shinysurveys/matrix_example.png -------------------------------------------------------------------------------- /vignettes/graphics/survey-of-shinysurveys/minimal-survey.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jdtrat/shinysurveys/HEAD/vignettes/graphics/survey-of-shinysurveys/minimal-survey.png -------------------------------------------------------------------------------- /vignettes/graphics/survey-of-shinysurveys/numeric_example.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jdtrat/shinysurveys/HEAD/vignettes/graphics/survey-of-shinysurveys/numeric_example.png -------------------------------------------------------------------------------- /vignettes/graphics/survey-of-shinysurveys/yes_no_example.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jdtrat/shinysurveys/HEAD/vignettes/graphics/survey-of-shinysurveys/yes_no_example.png -------------------------------------------------------------------------------- /vignettes/graphics/survey-of-shinysurveys/dependency_example_1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jdtrat/shinysurveys/HEAD/vignettes/graphics/survey-of-shinysurveys/dependency_example_1.png -------------------------------------------------------------------------------- /vignettes/graphics/survey-of-shinysurveys/dependency_example_2.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jdtrat/shinysurveys/HEAD/vignettes/graphics/survey-of-shinysurveys/dependency_example_2.png -------------------------------------------------------------------------------- /vignettes/graphics/survey-of-shinysurveys/select_input_example.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jdtrat/shinysurveys/HEAD/vignettes/graphics/survey-of-shinysurveys/select_input_example.png -------------------------------------------------------------------------------- /.Rbuildignore: -------------------------------------------------------------------------------- 1 | ^shinysurveys\.Rproj$ 2 | ^\.Rproj\.user$ 3 | ^LICENSE\.md$ 4 | ^\.github$ 5 | ^_pkgdown\.yml$ 6 | ^docs$ 7 | ^pkgdown$ 8 | ^CRAN-RELEASE$ 9 | ^cran-comments\.md$ 10 | -------------------------------------------------------------------------------- /vignettes/graphics/get-survey-data/dependency-survey-screenshot.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jdtrat/shinysurveys/HEAD/vignettes/graphics/get-survey-data/dependency-survey-screenshot.png -------------------------------------------------------------------------------- /vignettes/graphics/survey-of-shinysurveys/required_submit_enabled.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jdtrat/shinysurveys/HEAD/vignettes/graphics/survey-of-shinysurveys/required_submit_enabled.png -------------------------------------------------------------------------------- /vignettes/graphics/survey-of-shinysurveys/text_input_placeholder.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jdtrat/shinysurveys/HEAD/vignettes/graphics/survey-of-shinysurveys/text_input_placeholder.png -------------------------------------------------------------------------------- /vignettes/graphics/survey-of-shinysurveys/required_submit_disabled.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jdtrat/shinysurveys/HEAD/vignettes/graphics/survey-of-shinysurveys/required_submit_disabled.png -------------------------------------------------------------------------------- /inst/WORDLIST: -------------------------------------------------------------------------------- 1 | Attali 2 | Attali's 3 | CMD 4 | D'Agostino 5 | Github 6 | Lifecycle 7 | UI 8 | hadley 9 | https 10 | io 11 | jdtrat 12 | minimalistic 13 | purrr 14 | shinyapps 15 | shinyforms 16 | -------------------------------------------------------------------------------- /vignettes/graphics/survey-of-shinysurveys/text_input_character_string.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jdtrat/shinysurveys/HEAD/vignettes/graphics/survey-of-shinysurveys/text_input_character_string.png -------------------------------------------------------------------------------- /tests/testthat/test-helpers-survey-code.R: -------------------------------------------------------------------------------- 1 | test_that("base parse query string for user ID works", { 2 | 3 | query <- shiny::parseQueryString("?user_id=hadley&other_parameter=other/") 4 | 5 | base_val <- base_extract_user_id(query) 6 | 7 | expect_equal(base_val, "hadley") 8 | 9 | }) 10 | -------------------------------------------------------------------------------- /R/zzz.R: -------------------------------------------------------------------------------- 1 | .onLoad <- function(...) { 2 | 3 | shiny::registerInputHandler("radioMatrixInput.dataframe", function(value, ...) { 4 | if (is.null(value)) { 5 | return(value) 6 | } else { 7 | df <- safeFromJSON(value) 8 | return(df) 9 | } 10 | }, force = TRUE) 11 | } 12 | -------------------------------------------------------------------------------- /tests/testthat/test-surveyOutput-teaching_r_questions.R: -------------------------------------------------------------------------------- 1 | 2 | test_that("surveyOutput() works - teaching_r_questions", { 3 | local_edition(3) 4 | expect_snapshot_output(surveyOutput(df = teaching_r_questions, 5 | survey_title = "Testing Title", 6 | survey_description = "Testing Description")) 7 | }) 8 | -------------------------------------------------------------------------------- /NAMESPACE: -------------------------------------------------------------------------------- 1 | # Generated by roxygen2: do not edit by hand 2 | 3 | export(demo_survey) 4 | export(demo_survey_multipage) 5 | export(extendInputType) 6 | export(getSurveyData) 7 | export(listInputExtensions) 8 | export(numberInput) 9 | export(radioMatrixInput) 10 | export(renderSurvey) 11 | export(surveyID) 12 | export(surveyLabel) 13 | export(surveyOptions) 14 | export(surveyOutput) 15 | -------------------------------------------------------------------------------- /man/getID.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/utils_render-survey.R 3 | \name{getID} 4 | \alias{getID} 5 | \title{Get required IDs} 6 | \usage{ 7 | getID(df) 8 | } 9 | \arguments{ 10 | \item{df}{The dataframe of questions} 11 | } 12 | \value{ 13 | The input ID for required questions 14 | } 15 | \description{ 16 | Get required IDs 17 | } 18 | \keyword{internal} 19 | -------------------------------------------------------------------------------- /man/get_questions.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/utils_parse-questions.R 3 | \name{get_questions} 4 | \alias{get_questions} 5 | \title{Get unique questions from user-input dataframe} 6 | \usage{ 7 | get_questions(df) 8 | } 9 | \arguments{ 10 | \item{df}{User-input dataframe of questions} 11 | } 12 | \value{ 13 | List of questions 14 | } 15 | \description{ 16 | Get unique questions from user-input dataframe 17 | } 18 | \keyword{internal} 19 | -------------------------------------------------------------------------------- /man/multipaged_ui.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/utils_multipage-ui.R 3 | \name{multipaged_ui} 4 | \alias{multipaged_ui} 5 | \title{Place survey questions on multiple pages} 6 | \usage{ 7 | multipaged_ui(df) 8 | } 9 | \arguments{ 10 | \item{df}{The data frame of questions supplied by the user} 11 | } 12 | \value{ 13 | UI for all pages 14 | } 15 | \description{ 16 | Place survey questions on multiple pages 17 | } 18 | \keyword{internal} 19 | -------------------------------------------------------------------------------- /man/enable_element.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/utils_javascript-message-handlers.R 3 | \name{enable_element} 4 | \alias{enable_element} 5 | \title{Enable HTML element} 6 | \usage{ 7 | enable_element(.id) 8 | } 9 | \arguments{ 10 | \item{.id}{Shiny object inputId} 11 | } 12 | \value{ 13 | NA; used for side effects 14 | } 15 | \description{ 16 | Custom function for disabling an HTML element in {shinysurveys}. 17 | } 18 | \keyword{internal} 19 | -------------------------------------------------------------------------------- /man/title_placeholder.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/utils_survey-output.R 3 | \name{title_placeholder} 4 | \alias{title_placeholder} 5 | \title{Control Title UI Placement for Multi-paged Surveys} 6 | \usage{ 7 | title_placeholder(page) 8 | } 9 | \arguments{ 10 | \item{page}{} 11 | } 12 | \value{ 13 | UI for title if applicable 14 | } 15 | \description{ 16 | Control Title UI Placement for Multi-paged Surveys 17 | } 18 | \keyword{internal} 19 | -------------------------------------------------------------------------------- /man/disable_element.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/utils_javascript-message-handlers.R 3 | \name{disable_element} 4 | \alias{disable_element} 5 | \title{Disable HTML element} 6 | \usage{ 7 | disable_element(.id) 8 | } 9 | \arguments{ 10 | \item{.id}{Shiny object inputId} 11 | } 12 | \value{ 13 | NA; used for side effects 14 | } 15 | \description{ 16 | Custom function for disabling an HTML element in {shinysurveys}. 17 | } 18 | \keyword{internal} 19 | -------------------------------------------------------------------------------- /man/pluck_by_index.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/utils_parse-questions.R 3 | \name{pluck_by_index} 4 | \alias{pluck_by_index} 5 | \title{Simple pluck} 6 | \usage{ 7 | pluck_by_index(list, index) 8 | } 9 | \arguments{ 10 | \item{list}{A list object} 11 | 12 | \item{index}{A numeric index} 13 | } 14 | \value{ 15 | Returns list element. 16 | } 17 | \description{ 18 | simple and specific version of purrr::pluck to meet use-case 19 | } 20 | \keyword{internal} 21 | -------------------------------------------------------------------------------- /man/split_dependence.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/utils_parse-questions.R 3 | \name{split_dependence} 4 | \alias{split_dependence} 5 | \title{Split questions based on dependency} 6 | \usage{ 7 | split_dependence(df) 8 | } 9 | \arguments{ 10 | \item{df}{A data frame subset for one question} 11 | } 12 | \value{ 13 | A list where each element is one UI question. 14 | } 15 | \description{ 16 | Split questions based on dependency 17 | } 18 | \keyword{internal} 19 | -------------------------------------------------------------------------------- /man/add_class.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/utils_javascript-message-handlers.R 3 | \name{add_class} 4 | \alias{add_class} 5 | \title{Add CSS Class} 6 | \usage{ 7 | add_class(.id, .class) 8 | } 9 | \arguments{ 10 | \item{.id}{Shiny object inputId} 11 | 12 | \item{.class}{class to be added} 13 | } 14 | \value{ 15 | NA; used for side effects 16 | } 17 | \description{ 18 | Custom function for adding a CSS class used in {shinysurveys}. 19 | } 20 | \keyword{internal} 21 | -------------------------------------------------------------------------------- /man/create_radio_input_id.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/input_radioMatrixInput.R 3 | \name{create_radio_input_id} 4 | \alias{create_radio_input_id} 5 | \title{Create radio input ID} 6 | \usage{ 7 | create_radio_input_id(.responseItem) 8 | } 9 | \arguments{ 10 | \item{.responseItem}{} 11 | } 12 | \value{ 13 | The response item title in a form appropriate for HTML IDs (and tidy data) 14 | } 15 | \description{ 16 | Create radio input ID 17 | } 18 | \keyword{internal} 19 | -------------------------------------------------------------------------------- /man/base_extract_user_id.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/utils_parse-questions.R 3 | \name{base_extract_user_id} 4 | \alias{base_extract_user_id} 5 | \title{Extract user ID from query string} 6 | \usage{ 7 | base_extract_user_id(query_list) 8 | } 9 | \arguments{ 10 | \item{query_list}{The query list object from \code{shiny::parseQueryString}} 11 | } 12 | \value{ 13 | User ID 14 | } 15 | \description{ 16 | Extract user ID from query string 17 | } 18 | \keyword{internal} 19 | -------------------------------------------------------------------------------- /shinysurveys.Rproj: -------------------------------------------------------------------------------- 1 | Version: 1.0 2 | 3 | RestoreWorkspace: No 4 | SaveWorkspace: No 5 | AlwaysSaveHistory: Default 6 | 7 | EnableCodeIndexing: Yes 8 | UseSpacesForTab: Yes 9 | NumSpacesForTab: 2 10 | Encoding: UTF-8 11 | 12 | RnwWeave: Sweave 13 | LaTeX: pdfLaTeX 14 | 15 | AutoAppendNewline: Yes 16 | StripTrailingWhitespace: Yes 17 | LineEndingConversion: Posix 18 | 19 | BuildType: Package 20 | PackageUseDevtools: Yes 21 | PackageInstallArgs: --no-multiarch --with-keep.source 22 | PackageRoxygenize: rd,collate,namespace 23 | -------------------------------------------------------------------------------- /man/remove_class.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/utils_javascript-message-handlers.R 3 | \name{remove_class} 4 | \alias{remove_class} 5 | \title{Remove CSS Class} 6 | \usage{ 7 | remove_class(.id, .class) 8 | } 9 | \arguments{ 10 | \item{.id}{Shiny object inputId} 11 | 12 | \item{.class}{class to be removed} 13 | } 14 | \value{ 15 | NA; used for side effects 16 | } 17 | \description{ 18 | Custom function for removing a CSS class used in {shinysurveys}. 19 | } 20 | \keyword{internal} 21 | -------------------------------------------------------------------------------- /R/utils.R: -------------------------------------------------------------------------------- 1 | 2 | # Internal function copied from {shiny} source code. 3 | # 4 | # GitHub Link: 5 | # \url{https://github.com/rstudio/shiny/blob/dcca77c9362ad45992777a97b32726e6f373e059/R/shiny.R#L51} 6 | # If the input to jsonlite::fromJSON is not valid JSON, it will try to fetch a 7 | # # URL or read a file from disk. We don't want to allow that. 8 | # 9 | safeFromJSON <- function(txt, ...) { 10 | if (!jsonlite::validate(txt)) { 11 | stop("Argument 'txt' is not a valid JSON string.") 12 | } 13 | jsonlite::fromJSON(txt, ...) 14 | } 15 | -------------------------------------------------------------------------------- /man/showDependence.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/utils_render-survey.R 3 | \name{showDependence} 4 | \alias{showDependence} 5 | \title{Show dependence questions} 6 | \usage{ 7 | showDependence(input = input, df) 8 | } 9 | \arguments{ 10 | \item{input}{Input from server} 11 | 12 | \item{df}{One element (a dataframe) in the list of unique questions.} 13 | } 14 | \value{ 15 | NA; shows a dependence question in the UI. 16 | } 17 | \description{ 18 | Show dependence questions 19 | } 20 | \keyword{internal} 21 | -------------------------------------------------------------------------------- /man/surveyOutput_individual.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/func_survey-output.R 3 | \name{surveyOutput_individual} 4 | \alias{surveyOutput_individual} 5 | \title{Generate the UI Code for demographic questions} 6 | \usage{ 7 | surveyOutput_individual(df) 8 | } 9 | \arguments{ 10 | \item{df}{One element (a dataframe) in the list of unique questions.} 11 | } 12 | \value{ 13 | UI Code for a Shiny App. 14 | } 15 | \description{ 16 | Generate the UI Code for demographic questions 17 | } 18 | \keyword{internal} 19 | -------------------------------------------------------------------------------- /man/checkIndividual.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/utils_render-survey.R 3 | \name{checkIndividual} 4 | \alias{checkIndividual} 5 | \title{Check if individual inputs have a value} 6 | \usage{ 7 | checkIndividual(input = input, input_id) 8 | } 9 | \arguments{ 10 | \item{input}{Input from server} 11 | 12 | \item{input_id}{The input_id to check} 13 | } 14 | \value{ 15 | TRUE if the input has a value; false otherwise. 16 | } 17 | \description{ 18 | Check if individual inputs have a value 19 | } 20 | \keyword{internal} 21 | -------------------------------------------------------------------------------- /man/button_placeholders.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/utils_survey-output.R 3 | \name{button_placeholders} 4 | \alias{button_placeholders} 5 | \title{Button placement on each page of questions} 6 | \usage{ 7 | button_placeholders(page) 8 | } 9 | \arguments{ 10 | \item{page}{Current page to define UI for. Specified in \code{\link{multipaged_ui}}} 11 | } 12 | \value{ 13 | UI for "Next", "Previous", and "Submit" buttons 14 | } 15 | \description{ 16 | Button placement on each page of questions 17 | } 18 | \keyword{internal} 19 | -------------------------------------------------------------------------------- /man/toggle_element.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/utils_render-survey.R 3 | \name{toggle_element} 4 | \alias{toggle_element} 5 | \title{Toggle element state} 6 | \usage{ 7 | toggle_element(id, condition) 8 | } 9 | \arguments{ 10 | \item{id}{Shiny object inputId} 11 | 12 | \item{condition}{Condition on which to enable or disable} 13 | } 14 | \value{ 15 | NA; used for side effects 16 | } 17 | \description{ 18 | Custom function for toggling enable/disable state of HTML element in {shinysurveys}. 19 | } 20 | \keyword{internal} 21 | -------------------------------------------------------------------------------- /man/listUniqueQuestions.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/utils_parse-questions.R 3 | \name{listUniqueQuestions} 4 | \alias{listUniqueQuestions} 5 | \title{Convert dataframe of questions to list for use in Shiny UI} 6 | \usage{ 7 | listUniqueQuestions(df) 8 | } 9 | \arguments{ 10 | \item{df}{A user supplied dataframe in the format of teaching_r_questions.} 11 | } 12 | \value{ 13 | A list of unique questions for each UI element 14 | } 15 | \description{ 16 | Convert dataframe of questions to list for use in Shiny UI 17 | } 18 | \keyword{internal} 19 | -------------------------------------------------------------------------------- /man/addPages.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/utils_multipage-ui.R 3 | \name{addPages} 4 | \alias{addPages} 5 | \title{Wrap Questions in the Appropriate Page Divider} 6 | \usage{ 7 | addPages(question_df, page_id) 8 | } 9 | \arguments{ 10 | \item{question_df}{The data frame of questions supplied by the user, 11 | split in \code{\link{multipaged_ui}}.} 12 | 13 | \item{page_id}{The page ID} 14 | } 15 | \value{ 16 | UI for a "page" of questions 17 | } 18 | \description{ 19 | Wrap Questions in the Appropriate Page Divider 20 | } 21 | \keyword{internal} 22 | -------------------------------------------------------------------------------- /man/getRequired_internal.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/utils_render-survey.R 3 | \name{getRequired_internal} 4 | \alias{getRequired_internal} 5 | \title{Get a character vector of required questions} 6 | \usage{ 7 | getRequired_internal(questions) 8 | } 9 | \arguments{ 10 | \item{questions}{The list of unique questions from \code{\link{listUniqueQuestions}}.} 11 | } 12 | \value{ 13 | A character vectors with the input ID of required questions. 14 | } 15 | \description{ 16 | Get a character vector of required questions 17 | } 18 | \keyword{internal} 19 | -------------------------------------------------------------------------------- /man/radioMatHeader.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/input_radioMatrixInput.R 3 | \name{radioMatHeader} 4 | \alias{radioMatHeader} 5 | \title{Create the radio matrix input's header} 6 | \usage{ 7 | radioMatHeader(.choices, .required) 8 | } 9 | \arguments{ 10 | \item{.choices}{Possible choices} 11 | 12 | \item{.required}{Logical: TRUE/FALSE should a required asterisk be placed on the matrix question} 13 | } 14 | \value{ 15 | Header for the table (matrix input) 16 | } 17 | \description{ 18 | Create the radio matrix input's header 19 | } 20 | \keyword{internal} 21 | -------------------------------------------------------------------------------- /man/radioBody.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/input_radioMatrixInput.R 3 | \name{radioBody} 4 | \alias{radioBody} 5 | \title{Create the table body} 6 | \usage{ 7 | radioBody(.responseItems, .choices, .selected = NULL) 8 | } 9 | \arguments{ 10 | \item{.responseItems}{Questions to be asked (row labels)} 11 | 12 | \item{.choices}{Possible choices (values for radio buttons)} 13 | 14 | \item{.selected}{Initial selected value} 15 | } 16 | \value{ 17 | UI for the matrix input (table) body 18 | } 19 | \description{ 20 | Create the table body 21 | } 22 | \keyword{internal} 23 | -------------------------------------------------------------------------------- /man/demo_survey.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/func_demo-surveys.R 3 | \name{demo_survey} 4 | \alias{demo_survey} 5 | \title{Demo Survey} 6 | \usage{ 7 | demo_survey(theme = "#63B8FF") 8 | } 9 | \arguments{ 10 | \item{theme}{A valid hex color such as #63B8FF (default)} 11 | } 12 | \value{ 13 | A Shiny App 14 | } 15 | \description{ 16 | This function runs a Shiny app that shows an example of running a demographic 17 | survey in Shiny. It has a sample title and description and its theme color 18 | can be customized using a hex color code. 19 | } 20 | \examples{ 21 | if (interactive()) demo_survey() 22 | 23 | } 24 | -------------------------------------------------------------------------------- /man/checkRequired_internal.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/utils_render-survey.R 3 | \name{checkRequired_internal} 4 | \alias{checkRequired_internal} 5 | \title{Check all required questions have been answered} 6 | \usage{ 7 | checkRequired_internal(input = input, required_inputs_vector) 8 | } 9 | \arguments{ 10 | \item{input}{Input from server} 11 | 12 | \item{required_inputs_vector}{The output of \code{\link{getRequired_internal}}.} 13 | } 14 | \value{ 15 | TRUE if all required questions have been answered. FALSE otherwise. 16 | } 17 | \description{ 18 | Check all required questions have been answered 19 | } 20 | \keyword{internal} 21 | -------------------------------------------------------------------------------- /man/radioMatrixButtons.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/input_radioMatrixInput.R 3 | \name{radioMatrixButtons} 4 | \alias{radioMatrixButtons} 5 | \title{Create the actual radio button inputs} 6 | \usage{ 7 | radioMatrixButtons(inputId, choices, selected = NULL) 8 | } 9 | \arguments{ 10 | \item{inputId}{This is the ID for the question to which the radio button 11 | inputs correspond} 12 | 13 | \item{choices}{The choices (values) for each radio button to indicate} 14 | 15 | \item{selected}{A default selected value} 16 | } 17 | \value{ 18 | radio button input UI 19 | } 20 | \description{ 21 | Create the actual radio button inputs 22 | } 23 | \keyword{internal} 24 | -------------------------------------------------------------------------------- /man/addRequiredUI_internal.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/utils_render-survey.R 3 | \name{addRequiredUI_internal} 4 | \alias{addRequiredUI_internal} 5 | \title{Check if a question is required} 6 | \usage{ 7 | addRequiredUI_internal(df) 8 | } 9 | \arguments{ 10 | \item{df}{One element (a dataframe) in the list of unique questions.} 11 | } 12 | \value{ 13 | A label with or without an asterisk to signify it is required. 14 | } 15 | \description{ 16 | This function is for internal use. It will check if a question in the 17 | user-supplied questions dataframe is required. If so, it will add the label 18 | with an asterisk. If not, it will just return the label. 19 | } 20 | \keyword{internal} 21 | -------------------------------------------------------------------------------- /man/demo_survey_multipage.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/func_demo-surveys.R 3 | \name{demo_survey_multipage} 4 | \alias{demo_survey_multipage} 5 | \title{Demo Survey over Multiple Pages} 6 | \usage{ 7 | demo_survey_multipage(theme = "#63B8FF") 8 | } 9 | \arguments{ 10 | \item{theme}{A valid hex color such as #63B8FF (default)} 11 | } 12 | \value{ 13 | A Shiny App 14 | } 15 | \description{ 16 | This function runs a Shiny app that shows an example of running a demographic 17 | survey in Shiny, spanning multiple pages. It has a sample title and description and its theme color 18 | can be customized using a hex color code. 19 | } 20 | \examples{ 21 | if (interactive()) demo_survey_multipage() 22 | 23 | } 24 | -------------------------------------------------------------------------------- /man/check_survey_metadata.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/utils_survey-output.R 3 | \name{check_survey_metadata} 4 | \alias{check_survey_metadata} 5 | \title{Check survey metadata} 6 | \usage{ 7 | check_survey_metadata(survey_description, survey_title) 8 | } 9 | \arguments{ 10 | \item{survey_description}{The survey's description from surveyOutput} 11 | 12 | \item{survey_title}{The survey's title from surveyOutput} 13 | } 14 | \value{ 15 | Returns error messages if required paramters are not supplied, 16 | otherwise it returns the appropriate code for survey titles and description 17 | for use in surveyOutput. 18 | } 19 | \description{ 20 | Returns title/description HTML tags as needed. 21 | } 22 | \keyword{internal} 23 | -------------------------------------------------------------------------------- /man/surveyID.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/func_extend-shinysurveys.R 3 | \name{surveyID} 4 | \alias{surveyID} 5 | \title{Add correct ID for custom input types} 6 | \usage{ 7 | surveyID() 8 | } 9 | \value{ 10 | NA; used for side effects with \code{\link{extendInputType}}. 11 | } 12 | \description{ 13 | \code{surveyID()} is a helper function for \code{\link{extendInputType}}. When 14 | defining custom input types, the \code{inputId} argument for shiny UI components 15 | should equal \code{surveyID()}. See examples for more details. 16 | } 17 | \examples{ 18 | 19 | extendInputType("slider", { 20 | shiny::sliderInput( 21 | inputId = surveyID(), 22 | label = surveyLabel(), 23 | min = 1, 24 | max = 10, 25 | value = 5 26 | ) 27 | }) 28 | 29 | } 30 | \seealso{ 31 | \code{\link{extendInputType}} 32 | 33 | \code{\link{surveyLabel}} 34 | 35 | \code{\link{surveyOptions}} 36 | } 37 | -------------------------------------------------------------------------------- /man/hideSurvey.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/utils_javascript-message-handlers.R 3 | \name{hideSurvey} 4 | \alias{hideSurvey} 5 | \title{Hide shinysurvey} 6 | \usage{ 7 | hideSurvey() 8 | } 9 | \value{ 10 | NA; used to hide the survey. 11 | } 12 | \description{ 13 | This function allows you to easily hide the survey, something you may wish to 14 | do upon submission. 15 | } 16 | \examples{ 17 | 18 | if (interactive()) { 19 | 20 | library(shiny) 21 | library(shinysurveys) 22 | 23 | ui <- fluidPage( 24 | surveyOutput(teaching_r_questions, 25 | survey_title = "Now you see me...", 26 | survey_description = "A demo showing how to hide the survey body upon submission.") 27 | ) 28 | 29 | server <- function(input, output, session) { 30 | renderSurvey() 31 | observeEvent(input$submit, hideSurvey()) 32 | } 33 | 34 | shinyApp(ui, server) 35 | 36 | } 37 | 38 | } 39 | -------------------------------------------------------------------------------- /man/surveyOptions.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/func_extend-shinysurveys.R 3 | \name{surveyOptions} 4 | \alias{surveyOptions} 5 | \title{Add options for custom input types} 6 | \usage{ 7 | surveyOptions() 8 | } 9 | \value{ 10 | NA; used for side effects with \code{\link{extendInputType}}. 11 | } 12 | \description{ 13 | \code{surveyOptions()} is a helper function for \code{\link{extendInputType}}. When 14 | defining custom input types, the choices arguments for shiny UI components 15 | should equal \code{surveyOption()}. See examples for more details. 16 | } 17 | \examples{ 18 | 19 | extendInputType("inlineRadioButtons", { 20 | shiny::radioButtons( 21 | inputId = surveyID(), 22 | label = surveyLabel(), 23 | selected = character(0), 24 | choices = surveyOptions(), 25 | inline = TRUE 26 | ) 27 | }) 28 | 29 | } 30 | \seealso{ 31 | \code{\link{extendInputType}} 32 | 33 | \code{\link{surveyID}} 34 | 35 | \code{\link{surveyOptions}} 36 | } 37 | -------------------------------------------------------------------------------- /man/surveyLabel.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/func_extend-shinysurveys.R 3 | \name{surveyLabel} 4 | \alias{surveyLabel} 5 | \title{Add correct label for custom input types} 6 | \usage{ 7 | surveyLabel() 8 | } 9 | \value{ 10 | NA; used for side effects with \code{\link{extendInputType}}. 11 | } 12 | \description{ 13 | \code{surveyLabel()} is a helper function for \code{\link{extendInputType}}. When 14 | defining custom input types, the \code{label} argument for shiny UI components 15 | should equal \code{surveyLabel()}. It essentially takes on the value in the 16 | "question" column in the data supplied to \code{\link{surveyOutput}}. See 17 | examples for more details. 18 | } 19 | \examples{ 20 | 21 | extendInputType("slider", { 22 | shiny::sliderInput( 23 | inputId = surveyID(), 24 | label = surveyLabel(), 25 | min = 1, 26 | max = 10, 27 | value = 5 28 | ) 29 | }) 30 | 31 | } 32 | \seealso{ 33 | \code{\link{extendInputType}} 34 | 35 | \code{\link{surveyID}} 36 | 37 | \code{\link{surveyOptions}} 38 | } 39 | -------------------------------------------------------------------------------- /inst/save_data.js: -------------------------------------------------------------------------------- 1 | 2 | // define debounce function 3 | const debounce = function(func, delay) { 4 | let timeout; 5 | 6 | return function executed(...args) { 7 | const later = function() { 8 | clearTimeout(timeout); 9 | func(...args); 10 | }; 11 | 12 | clearTimeout(timeout); 13 | timeout = setTimeout(later, delay); 14 | 15 | }; 16 | 17 | }; 18 | 19 | $(document).on("shiny:connected", function() { 20 | Shiny.setInputValue('shinysurveysConnected', true); 21 | var initial_values; 22 | 23 | function getHiddenInputs() { 24 | 25 | hiddenDivs = $('.dependence'); 26 | var hiddenInputIds = []; 27 | var i; 28 | 29 | for (i = 0; i < hiddenDivs.length; i++) { 30 | hiddenInputIds[i] = $(hiddenDivs[i]).attr('id').split('-question')[0]; 31 | } 32 | Shiny.setInputValue('shinysurveysHiddenInputs', hiddenInputIds); 33 | 34 | } 35 | 36 | var log_hidden_inputs = debounce(function() { 37 | getHiddenInputs(); 38 | }, 1000) 39 | 40 | $('#submit').on('click', getHiddenInputs); 41 | 42 | $('.question-input').on('click', log_hidden_inputs); 43 | }); 44 | -------------------------------------------------------------------------------- /LICENSE.md: -------------------------------------------------------------------------------- 1 | # MIT License 2 | 3 | Copyright (c) 2020 Jonathan D. Trattner 4 | 5 | Permission is hereby granted, free of charge, to any person obtaining a copy 6 | of this software and associated documentation files (the "Software"), to deal 7 | in the Software without restriction, including without limitation the rights 8 | to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 9 | copies of the Software, and to permit persons to whom the Software is 10 | furnished to do so, subject to the following conditions: 11 | 12 | The above copyright notice and this permission notice shall be included in all 13 | copies or substantial portions of the Software. 14 | 15 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 16 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 17 | FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 18 | AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 19 | LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 20 | OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE 21 | SOFTWARE. 22 | -------------------------------------------------------------------------------- /man/listInputExtensions.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/func_extend-shinysurveys.R 3 | \name{listInputExtensions} 4 | \alias{listInputExtensions} 5 | \title{List all registered survey extensions} 6 | \usage{ 7 | listInputExtensions() 8 | } 9 | \value{ 10 | A named list containing the registered input type and their associated functions. 11 | } 12 | \description{ 13 | List all registered survey extensions 14 | } 15 | \examples{ 16 | 17 | if (interactive()) { 18 | 19 | # Register a date input to {shinysurveys}, 20 | # limiting possible dates to a twenty-day period. 21 | 22 | extendInputType("slider", { 23 | shiny::sliderInput( 24 | inputId = surveyID(), 25 | label = surveyLabel(), 26 | min = 1, 27 | max = 10, 28 | value = 5 29 | ) 30 | }) 31 | 32 | # Register a slider input to {shinysurveys} 33 | # with a custom minimum and maximum value. 34 | 35 | extendInputType("date", { 36 | shiny::dateInput( 37 | inputId = surveyID(), 38 | value = Sys.Date(), 39 | label = surveyLabel(), 40 | min = Sys.Date()-10, 41 | max = Sys.Date()+10 42 | ) 43 | }) 44 | 45 | listInputExtensions() 46 | 47 | } 48 | 49 | } 50 | -------------------------------------------------------------------------------- /inst/radioMatrixInput/js/radioMatrixInput.js: -------------------------------------------------------------------------------- 1 | var radioMatrixBinding = new Shiny.InputBinding(); 2 | 3 | $.extend(radioMatrixBinding, { 4 | 5 | find: function(scope) { 6 | return $(scope).find(".radioMatrixInput"); 7 | }, 8 | 9 | getValue: function(el) { 10 | 11 | checked = $(el).find('input:checked'); 12 | num_items = $(el).find('.radio-matrix-buttons').length; 13 | 14 | var values = [...Array(checked.length).keys()].map(i => ({ 15 | "question_id": $(checked[i]).attr('name'), 16 | "question_type": "matrix", 17 | "response": $(checked[i]).attr('value') 18 | })); 19 | 20 | if (checked.length === num_items) { 21 | return(JSON.stringify(values)); 22 | } else { 23 | return(null); 24 | } 25 | 26 | }, 27 | 28 | // on click, uncheck the previously selected input and check the new one. 29 | subscribe: function(el, callback) { 30 | 31 | $(el).on("change.radioMatrixBinding", function(evt) { 32 | 33 | $(evt.target).prop("checked", true); 34 | 35 | callback(); 36 | 37 | }); 38 | }, 39 | unsubscribe: function(el) { 40 | $(el).off(".radioMatrixInput"); 41 | }, 42 | 43 | getType: function(el) { 44 | return "radioMatrixInput.dataframe"; 45 | } 46 | 47 | 48 | }); 49 | 50 | Shiny.inputBindings.register(radioMatrixBinding); 51 | 52 | -------------------------------------------------------------------------------- /R/data.R: -------------------------------------------------------------------------------- 1 | #' A sample CSV file for demographic questions 2 | #' 3 | #' A dataset containing the prices and other attributes of almost 54,000 4 | #' diamonds. 5 | #' 6 | #' 7 | #' @format A data frame with 54 rows and 6 columns: 8 | #' \describe{ 9 | #' \item{question:}{The question to be asked.} 10 | #' \item{option:}{A possible response to the question. In multiple choice questions, 11 | #' for example, this would be the possible answers. For questions without 12 | #' discrete answers, such as a numeric input, this would be the default option 13 | #' shown on the input. For text inputs, it is the placeholder value.} 14 | #' \item{input_type:}{What type of response is expected? Numeric, multiple choice, text, etc...} 15 | #' \item{input_id:}{The input id for Shiny inputs.} 16 | #' \item{dependence:}{Does this question (row) depend on another? 17 | #' That is, should it only appear if a different question has a specific value? 18 | #' This column contains the input_id of whatever question this one depends upon.} 19 | #' \item{dependence_value:}{This column contains the specific value that the dependence 20 | #' question must take for this question (row) to be shown.} 21 | #' \item{required:}{logical TRUE/FALSE signifying if a question is required.} 22 | #' } 23 | #' @source D'Agostino McGowan Data Science Lab at Wake Forest University. 24 | "teaching_r_questions" 25 | -------------------------------------------------------------------------------- /DESCRIPTION: -------------------------------------------------------------------------------- 1 | Package: shinysurveys 2 | Title: Create and Deploy Surveys in 'Shiny' 3 | Version: 0.2.0.9000 4 | Authors@R: 5 | c( 6 | person(given = "Jonathan", 7 | family = "Trattner", 8 | role = c("aut", "cre"), 9 | email = "jdt@jdtrat.com", 10 | comment = c(ORCID = "0000-0002-1097-7603")), 11 | person(given = "Lucy", 12 | family = c("D'Agostino McGowan"), 13 | role = c("aut"), 14 | email = "mcgowald@wfu.edu"), 15 | person(given = "Paul", 16 | family = c("Le Grand"), 17 | role = c("ctb"), 18 | email = "ptlegrand1@gmail.com") 19 | ) 20 | Description: Easily create and deploy surveys in 'Shiny'. This package includes 21 | a minimalistic framework similar to 'Google Forms' that allows for url-based 22 | user tracking, customizable submit actions, easy survey-theming, and more. 23 | License: MIT + file LICENSE 24 | URL: https://shinysurveys.jdtrat.com, https://github.com/jdtrat/shinysurveys 25 | BugReports: https://github.com/jdtrat/shinysurveys/issues 26 | Encoding: UTF-8 27 | LazyData: true 28 | Roxygen: list(markdown = TRUE) 29 | RoxygenNote: 7.1.2 30 | Imports: 31 | shiny, 32 | sass, 33 | htmltools, 34 | jsonlite 35 | Depends: 36 | R (>= 2.10) 37 | Suggests: 38 | knitr, 39 | rmarkdown, 40 | tibble 41 | VignetteBuilder: knitr 42 | -------------------------------------------------------------------------------- /R/utils_multipage-ui.R: -------------------------------------------------------------------------------- 1 | 2 | 3 | #' Wrap Questions in the Appropriate Page Divider 4 | #' 5 | #' @param question_df The data frame of questions supplied by the user, 6 | #' split in \code{\link{multipaged_ui}}. 7 | #' @param page_id The page ID 8 | #' 9 | #' @keywords internal 10 | #' 11 | #' @return UI for a "page" of questions 12 | #' 13 | addPages <- function(question_df, page_id) { 14 | 15 | shiny::div(class = ifelse(page_id != "1", "page page-hidden", "page page-visible"), 16 | id = paste0("page-", page_id), 17 | title_placeholder(page = page_id), 18 | lapply(question_df, surveyOutput_individual), 19 | button_placeholders(page = page_id)) 20 | 21 | } 22 | 23 | 24 | #' Place survey questions on multiple pages 25 | #' 26 | #' @param df The data frame of questions supplied by the user 27 | #' 28 | #' @keywords internal 29 | #' 30 | #' @return UI for all pages 31 | #' 32 | multipaged_ui <- function(df) { 33 | 34 | paged <- split(df, factor(df$page, levels = unique(df$page))) 35 | paged <- lapply(paged, listUniqueQuestions) 36 | # Keep track of number of pages for controlling button behavior 37 | survey_env$num_pages <- length(names(paged)) 38 | # convert all page indicators to ordered list 39 | names(paged) <- as.character(seq(1:length(names(paged)))) 40 | class(paged) <- c("list", "paged") 41 | output <- mapply(FUN = addPages, 42 | question_df = paged, 43 | page_id = names(paged), 44 | SIMPLIFY = FALSE) 45 | return(output) 46 | } 47 | -------------------------------------------------------------------------------- /man/teaching_r_questions.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/data.R 3 | \docType{data} 4 | \name{teaching_r_questions} 5 | \alias{teaching_r_questions} 6 | \title{A sample CSV file for demographic questions} 7 | \format{ 8 | A data frame with 54 rows and 6 columns: 9 | \describe{ 10 | \item{question:}{The question to be asked.} 11 | \item{option:}{A possible response to the question. In multiple choice questions, 12 | for example, this would be the possible answers. For questions without 13 | discrete answers, such as a numeric input, this would be the default option 14 | shown on the input. For text inputs, it is the placeholder value.} 15 | \item{input_type:}{What type of response is expected? Numeric, multiple choice, text, etc...} 16 | \item{input_id:}{The input id for Shiny inputs.} 17 | \item{dependence:}{Does this question (row) depend on another? 18 | That is, should it only appear if a different question has a specific value? 19 | This column contains the input_id of whatever question this one depends upon.} 20 | \item{dependence_value:}{This column contains the specific value that the dependence 21 | question must take for this question (row) to be shown.} 22 | \item{required:}{logical TRUE/FALSE signifying if a question is required.} 23 | } 24 | } 25 | \source{ 26 | D'Agostino McGowan Data Science Lab at Wake Forest University. 27 | } 28 | \usage{ 29 | teaching_r_questions 30 | } 31 | \description{ 32 | A dataset containing the prices and other attributes of almost 54,000 33 | diamonds. 34 | } 35 | \keyword{datasets} 36 | -------------------------------------------------------------------------------- /tests/testthat/test-surveyOutput-matrix_questions.R: -------------------------------------------------------------------------------- 1 | 2 | matrix_questions <- data.frame( 3 | question = c(rep("I love sushi.", 3), rep("I love chocolate.",3), 4 | "What's your favorite food?", rep("Goat cheese is the GOAT.", 5), 5 | rep("Yogurt and berries are a great snack.",5), 6 | rep("SunButter® is a fantastic alternative to peanut butter.", 5)), 7 | option = c(rep(c("Disagree", "Neutral", "Agree"), 2), "text", 8 | rep(c("Strongly Disagree", "Disagree", "Neutral", "Agree", "Strongly Agree"), 3)), 9 | input_type = c(rep("matrix", 6), "text", rep("matrix", 15)), 10 | # For matrix questions, the IDs should be the same for each question 11 | # but different for each matrix input unit 12 | input_id = c(rep("matId", 6), "favorite_food", rep("matId2", 15)), 13 | dependence = NA, 14 | dependence_value = NA, 15 | required = FALSE 16 | ) 17 | 18 | test_that("surveyOutput() works - matrix questions", { 19 | local_edition(3) 20 | expect_snapshot_output(shiny::fluidPage( 21 | shinysurveys::surveyOutput(df = matrix_questions, 22 | survey_title = "Testing Matrix Questions") 23 | )) 24 | }) 25 | 26 | matrix_questions_required <- transform(matrix_questions, required = TRUE) 27 | 28 | test_that("surveyOutput() works - required matrix questions", { 29 | local_edition(3) 30 | expect_snapshot_output(shiny::fluidPage( 31 | shinysurveys::surveyOutput(df = matrix_questions_required, 32 | survey_title = "Testing Matrix Questions - Required") 33 | )) 34 | }) 35 | 36 | 37 | 38 | 39 | 40 | -------------------------------------------------------------------------------- /.github/workflows/pkgdown.yaml: -------------------------------------------------------------------------------- 1 | on: 2 | push: 3 | branches: 4 | - main 5 | - master 6 | tags: 7 | -'*' 8 | 9 | name: pkgdown 10 | 11 | jobs: 12 | pkgdown: 13 | runs-on: macOS-latest 14 | env: 15 | GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }} 16 | steps: 17 | - uses: actions/checkout@v2 18 | 19 | - uses: r-lib/actions/setup-r@v1 20 | 21 | - uses: r-lib/actions/setup-pandoc@v1 22 | 23 | - name: Query dependencies 24 | run: | 25 | install.packages('remotes') 26 | saveRDS(remotes::dev_package_deps(dependencies = TRUE), ".github/depends.Rds", version = 2) 27 | writeLines(sprintf("R-%i.%i", getRversion()$major, getRversion()$minor), ".github/R-version") 28 | shell: Rscript {0} 29 | 30 | - name: Restore R package cache 31 | uses: actions/cache@v2 32 | with: 33 | path: ${{ env.R_LIBS_USER }} 34 | key: ${{ runner.os }}-${{ hashFiles('.github/R-version') }}-1-${{ hashFiles('.github/depends.Rds') }} 35 | restore-keys: ${{ runner.os }}-${{ hashFiles('.github/R-version') }}-1- 36 | 37 | - name: Install dependencies 38 | run: | 39 | remotes::install_deps(dependencies = TRUE) 40 | remotes::install_github("jdtrat/jdtdown") 41 | install.packages("pkgdown", type = "binary") 42 | shell: Rscript {0} 43 | 44 | - name: Install package 45 | run: R CMD INSTALL . 46 | 47 | - name: Deploy package 48 | run: | 49 | git config --local user.email "actions@github.com" 50 | git config --local user.name "GitHub Actions" 51 | Rscript -e 'pkgdown::deploy_to_branch(new_process = FALSE)' 52 | -------------------------------------------------------------------------------- /tests/testthat/test-surveyOutput-ds_questions.R: -------------------------------------------------------------------------------- 1 | 2 | ds_questions <- data.frame(question = c("What is your name?", 3 | "Who's your advisor?", 4 | "What are your research interests?", 5 | "What are your long term career goals?", 6 | "What other courses are you taking / other big commitments?", 7 | "How would you rate your current understanding of the topics in this course (data science, exploratory data analysis, graphical data analysis)?", 8 | "How much experience have you already had with R?", 9 | "In general, how much programming experience have you had?"), 10 | option = "Your Answer", 11 | input_type = "text", 12 | input_id = c("name", "advisor", "interests", "goals", "other_courses", "current_understanding", "experience_with_r", "programming_experience"), 13 | dependence = c(NA, "name", NA, NA, NA, NA, NA, NA), 14 | dependence_value = c(NA, "bas", NA, NA, NA, NA, NA, NA), 15 | required = c(T, F, F, F, T, F, F, T)) 16 | 17 | test_that("surveyOutput() works - ds_questions", { 18 | local_edition(3) 19 | expect_snapshot_output(shiny::fluidPage( 20 | shinysurveys::surveyOutput(df = ds_questions, 21 | survey_title = "Getting To Know You", 22 | survey_description = "Welcome! This is a quick survey for us to become familiar with each other's backgrounds in this class.") 23 | )) 24 | }) 25 | -------------------------------------------------------------------------------- /R/utils_get-survey-data.R: -------------------------------------------------------------------------------- 1 | # Internal function to make the survey response data frame when there are mismatched 2 | # data frame rows, as is likely to happen with custom input extensions. 3 | make_survey_response_df <- function(.question_id, .question_type, .response) { 4 | 5 | numId <- length(.question_id) 6 | numType <- length(.question_type) 7 | numResponse <- nrow(.response) 8 | 9 | if (numId == numType & numId == numResponse) { 10 | output <- data.frame( 11 | question_id = .question_id, 12 | question_type = .question_type, 13 | response = .response 14 | ) 15 | } else if (numId == numType & numId > numResponse) { 16 | 17 | output <- data.frame( 18 | question_id = .question_id, 19 | question_type = .question_type, 20 | response = rbind(.response, rep(NA, numId - numResponse)) 21 | ) 22 | 23 | } else if (numId == numType & numId < numResponse) { 24 | 25 | output <- data.frame( 26 | question_id = c(.question_id, rep(NA, numResponse - numId)), 27 | question_type = c(.question_type, rep(NA, numResponse - numType)), 28 | response = .response 29 | ) 30 | 31 | } else { 32 | stop("Could not save data. Unknown error.\n Please file an issue at https://github.com/jdtrat/shinysurveys/issues, including a data set that recreates this problem.") 33 | } 34 | 35 | return(output) 36 | } 37 | 38 | # Check for questions that return multiple answers 39 | # such as selectInput(multiple = TRUE) or checkboxGroupInput 40 | # If that's the case, collapse the input into one row for aggregating responses 41 | check_length <- function(.input) { 42 | if (length(.input) == 1) { 43 | as.character(.input) 44 | } else if (length(.input) != 1) { 45 | as.character(paste0(.input, collapse = ",")) 46 | } 47 | } 48 | -------------------------------------------------------------------------------- /man/renderSurvey.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/func_render-survey.R 3 | \name{renderSurvey} 4 | \alias{renderSurvey} 5 | \title{Server code for adding survey questions} 6 | \usage{ 7 | renderSurvey(df, theme = "#63B8FF") 8 | } 9 | \arguments{ 10 | \item{df}{\strong{Deprecated} \emph{please only place argument in 11 | \code{\link{surveyOutput}}.} A user supplied data frame in the format of 12 | teaching_r_questions.} 13 | 14 | \item{theme}{\strong{Deprecated} \emph{please place the theme argument in 15 | \code{\link{surveyOutput}}.} A valid R color: predefined such as "red" or 16 | "blue"; hex colors such as #63B8FF (default). To customize the survey's 17 | appearance entirely, supply NULL.} 18 | } 19 | \value{ 20 | NA; used for server-side logic in Shiny apps. 21 | } 22 | \description{ 23 | Include server-side logic for shinysurveys. 24 | } 25 | \examples{ 26 | 27 | if (interactive()) { 28 | 29 | library(shiny) 30 | library(shinysurveys) 31 | 32 | df <- data.frame(question = "What is your favorite food?", 33 | option = "Your Answer", 34 | input_type = "text", 35 | input_id = "favorite_food", 36 | dependence = NA, 37 | dependence_value = NA, 38 | required = F) 39 | 40 | ui <- fluidPage( 41 | surveyOutput(df = df, 42 | survey_title = "Hello, World!", 43 | theme = "#63B8FF") 44 | ) 45 | 46 | server <- function(input, output, session) { 47 | renderSurvey() 48 | 49 | observeEvent(input$submit, { 50 | showModal(modalDialog( 51 | title = "Congrats, you completed your first shinysurvey!", 52 | "You can customize what actions happen when a user finishes a survey using input$submit." 53 | )) 54 | }) 55 | } 56 | 57 | shinyApp(ui, server) 58 | 59 | } 60 | 61 | } 62 | -------------------------------------------------------------------------------- /inst/radioMatrixInput/css/radioMatrixInput.css: -------------------------------------------------------------------------------- 1 | .radioMatrixInput .shiny-options-group { 2 | padding-left: 12px; 3 | padding-right: 12px; 4 | } 5 | 6 | .radioMatrixInput table { 7 | width: 97.5%; 8 | border-collapse: separate; 9 | -webkit-border-vertical-spacing: 1rem; 10 | -webkit-border-horizontal-spacing: 0.5rem; 11 | } 12 | 13 | th, td { 14 | vertical-align: middle !important; 15 | text-align: center !important; 16 | width: 25px; 17 | } 18 | 19 | .radioMatrixInput .radio-matrix-buttons-label { 20 | width: 40%; 21 | } 22 | 23 | tr.spaceUnder>td { 24 | padding-bottom: 1em; 25 | } 26 | 27 | .radioMatrixInput .radio-matrix-buttons:hover { 28 | background-color: #F5F5F5; 29 | } 30 | 31 | @media screen and (max-width: 375px) { 32 | 33 | th, td { 34 | padding-left: 1px !important; 35 | padding-right: 1px !important; 36 | font-size: x-small; 37 | } 38 | } 39 | 40 | @media screen and (max-width: 429px) and (min-width: 376px) { 41 | 42 | th, td { 43 | padding-left: 2px !important; 44 | padding-right: 2px !important; 45 | font-size: x-small; 46 | } 47 | } 48 | 49 | @media screen and (max-width: 525px) and (min-width: 430px) { 50 | 51 | th, td { 52 | padding-left: 2px !important; 53 | padding-right: 2px !important; 54 | font-size: smaller; 55 | } 56 | } 57 | 58 | @media screen and (max-width: 767px) and (min-width: 526px) { 59 | 60 | th, td { 61 | padding-left: 4px !important; 62 | padding-right: 4px !important; 63 | } 64 | } 65 | 66 | @media screen and (max-width: 992px) and (min-width: 768px) { 67 | 68 | th, td { 69 | padding-left: 5px !important; 70 | padding-right: 5px !important; 71 | } 72 | 73 | } 74 | 75 | @media screen and (min-width: 993px) { 76 | 77 | th, td { 78 | padding-left: 5px !important; 79 | padding-right: 5px !important; 80 | } 81 | 82 | } 83 | 84 | .radioMatrixInput .radio-inline input[type=radio] { 85 | position: relative !important; 86 | } 87 | -------------------------------------------------------------------------------- /man/numberInput.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/input_numberInput.R 3 | \name{numberInput} 4 | \alias{numberInput} 5 | \title{Create a numeric input} 6 | \usage{ 7 | numberInput( 8 | inputId, 9 | label, 10 | value = NULL, 11 | min = NA, 12 | max = NA, 13 | step = NA, 14 | placeholder = NULL, 15 | width = NULL 16 | ) 17 | } 18 | \arguments{ 19 | \item{inputId}{The \code{input} slot that will be used to access the value.} 20 | 21 | \item{label}{Display label for the control, or \code{NULL} for no label.} 22 | 23 | \item{value}{Initial value. NULL by default.} 24 | 25 | \item{min}{Minimum allowed value} 26 | 27 | \item{max}{Maximum allowed value} 28 | 29 | \item{step}{Interval to use when stepping between min and max} 30 | 31 | \item{placeholder}{A character string giving the user a hint as to what can 32 | be entered into the control. Internet Explorer 8 and 9 do not support this 33 | option.} 34 | 35 | \item{width}{The width of the input, e.g. \code{'400px'}, or \code{'100\%'}; see 36 | \code{\link[=validateCssUnit]{validateCssUnit()}}.} 37 | } 38 | \value{ 39 | A numeric input control that can be added to a UI definition. 40 | } 41 | \description{ 42 | Create an input control for entry of numeric values. This is identical to 43 | \code{\link[shiny:numericInput]{shiny::numericInput()}} but is more flexible in \strong{not} requiring an initial 44 | value and in allowing placeholders. 45 | } 46 | \section{Server value}{ 47 | A numeric vector of length 1. 48 | } 49 | 50 | \examples{ 51 | 52 | if (interactive()) { 53 | library(shiny) 54 | library(shinysurveys) 55 | 56 | ui <- fluidPage( 57 | numberInput("obs", "Observations:", placeholder = "How many do you see?", min = 1, max = 100), 58 | verbatimTextOutput("value") 59 | ) 60 | server <- function(input, output) { 61 | output$value <- renderText({ input$obs }) 62 | } 63 | shinyApp(ui, server) 64 | } 65 | 66 | } 67 | \seealso{ 68 | \code{\link[shiny:updateNumericInput]{shiny::updateNumericInput()}} 69 | } 70 | -------------------------------------------------------------------------------- /man/surveyOutput.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/func_survey-output.R 3 | \name{surveyOutput} 4 | \alias{surveyOutput} 5 | \title{Generate the UI Code for demographic questions} 6 | \usage{ 7 | surveyOutput(df, survey_title, survey_description, theme = "#63B8FF", ...) 8 | } 9 | \arguments{ 10 | \item{df}{A user supplied data frame in the format of teaching_r_questions.} 11 | 12 | \item{survey_title}{(Optional) user supplied title for the survey} 13 | 14 | \item{survey_description}{(Optional) user supplied description for the survey} 15 | 16 | \item{theme}{A valid R color: predefined such as "red" or "blue"; hex colors 17 | such as #63B8FF (default). To customize the survey's appearance entirely, supply NULL.} 18 | 19 | \item{...}{Additional arguments to pass into \link[shiny]{actionButton} used to submit survey responses.} 20 | } 21 | \value{ 22 | UI Code for a Shiny App. 23 | } 24 | \description{ 25 | Create the UI code for a Shiny app based on user-supplied questions. 26 | } 27 | \examples{ 28 | 29 | if (interactive()) { 30 | 31 | library(shiny) 32 | library(shinysurveys) 33 | 34 | df <- data.frame(question = "What is your favorite food?", 35 | option = "Your Answer", 36 | input_type = "text", 37 | input_id = "favorite_food", 38 | dependence = NA, 39 | dependence_value = NA, 40 | required = F) 41 | 42 | ui <- fluidPage( 43 | surveyOutput(df = df, 44 | survey_title = "Hello, World!", 45 | theme = "#63B8FF") 46 | ) 47 | 48 | server <- function(input, output, session) { 49 | renderSurvey() 50 | 51 | observeEvent(input$submit, { 52 | showModal(modalDialog( 53 | title = "Congrats, you completed your first shinysurvey!", 54 | "You can customize what actions happen when a user finishes a survey using input$submit." 55 | )) 56 | }) 57 | } 58 | 59 | shinyApp(ui, server) 60 | 61 | } 62 | } 63 | -------------------------------------------------------------------------------- /inst/shinysurveys-js.js: -------------------------------------------------------------------------------- 1 | 2 | Shiny.addCustomMessageHandler("add_class", function(params) { 3 | $("#" + params.input_id).addClass(params.class_name); 4 | }); 5 | 6 | Shiny.addCustomMessageHandler("remove_class", function(params) { 7 | $("#" + params.input_id).removeClass(params.class_name); 8 | }); 9 | 10 | Shiny.addCustomMessageHandler("disable", function(params) { 11 | $el = $("#" + params.input_id); 12 | $el.prop("disabled", true); 13 | $el.addClass("disabled"); 14 | }); 15 | 16 | Shiny.addCustomMessageHandler("enable", function(params) { 17 | $el = $("#" + params.input_id); 18 | $el.prop("disabled", false); 19 | $el.removeClass("disabled"); 20 | }); 21 | 22 | Shiny.addCustomMessageHandler('hideSurvey', function(_) { 23 | $('.survey').hide(); 24 | }); 25 | 26 | 27 | $(document).ready(function() { 28 | // When one of the buttons are clicked, get the current page 29 | // from the button ID. 30 | $('.survey-buttons .btn').on('click', function(e) { 31 | current_id = $(e.target).attr('id'); 32 | current_page = parseInt(current_id.split('-')[1]); 33 | 34 | // If the button is a "next" button, hide current page and show the next one 35 | if ($(e.target).attr('page-action') === 'next') { 36 | 37 | next_page = current_page + 1; 38 | 39 | $('#page-' + current_page).addClass('page-hidden'); 40 | $('#page-' + current_page).removeClass('page-visible'); 41 | $('#page-' + next_page).removeClass('page-hidden'); 42 | $('#page-' + next_page).addClass('page-visible'); 43 | 44 | // If the button is a "previous" button, hide current page and show the previous one 45 | 46 | } else if ($(e.target).attr('page-action') === 'previous') { 47 | 48 | previous_page = current_page - 1; 49 | 50 | $('#page-' + current_page).addClass('page-hidden'); 51 | $('#page-' + current_page).removeClass('page-visible'); 52 | $('#page-' + previous_page).removeClass('page-hidden'); 53 | $('#page-' + previous_page).addClass('page-visible'); 54 | 55 | } 56 | 57 | }); 58 | 59 | }); 60 | -------------------------------------------------------------------------------- /man/getSurveyData.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/func_get-survey-data.R 3 | \name{getSurveyData} 4 | \alias{getSurveyData} 5 | \title{Get survey data} 6 | \usage{ 7 | getSurveyData( 8 | custom_id = NULL, 9 | include_dependencies = TRUE, 10 | dependency_string = "HIDDEN-QUESTION" 11 | ) 12 | } 13 | \arguments{ 14 | \item{custom_id}{A unique identifier for the survey's respondents. NULL by 15 | default, and the built-in {shinysurveys} userID will be used.} 16 | 17 | \item{include_dependencies}{LOGICAL: TRUE (default) and all dependency 18 | questions will be returned, regardless of if the individual respondent saw 19 | it. For respondents who did not see a specific question, the 'response' 20 | will take on the value from the \code{dependency_string} argument. If FALSE, the 21 | output will have variable rows depending on which questions a given 22 | participant answered.} 23 | 24 | \item{dependency_string}{A character string to be imputed for dependency 25 | questions that a respondent did not see. Default is "HIDDEN-QUESTION".} 26 | } 27 | \value{ 28 | A data frame with four columns containing information about the 29 | participant's survey responses: The 'subject_id' column can be used for 30 | identifying respondents. By default, it utilizes shinysurveys URL-based 31 | user tracking feature. The 'question_id' and 'question_type' columns 32 | correspond to 'input_id' and 'input_type' from the original data frame of 33 | questions. The 'response' column is the participant's answer. 34 | 35 | The number of rows, corresponding to the questions an individual saw, 36 | depends on the \code{include_dependencies} argument. If TRUE, by default, then 37 | the resulting data frame will have one row per unique input ID. If FALSE, 38 | the data frame may have variable length depending on which questions a 39 | given individual answers. 40 | } 41 | \description{ 42 | Get a participant's responses. 43 | } 44 | \examples{ 45 | 46 | if (interactive()) { 47 | 48 | library(shiny) 49 | 50 | ui <- fluidPage( 51 | surveyOutput(teaching_r_questions) 52 | ) 53 | 54 | server <- function(input, output, session) { 55 | renderSurvey() 56 | # Upon submission, print a data frame with participant responses 57 | observeEvent(input$submit, { 58 | print(getSurveyData()) 59 | }) 60 | } 61 | 62 | shinyApp(ui, server) 63 | 64 | } 65 | 66 | } 67 | -------------------------------------------------------------------------------- /R/input_numberInput.R: -------------------------------------------------------------------------------- 1 | shinyInputLabel <- utils::getFromNamespace("shinyInputLabel", "shiny") 2 | 3 | #' Create a numeric input 4 | #' 5 | #' Create an input control for entry of numeric values. This is identical to 6 | #' [shiny::numericInput()] but is more flexible in **not** requiring an initial 7 | #' value and in allowing placeholders. 8 | #' 9 | #' 10 | #' 11 | #' @param inputId The `input` slot that will be used to access the value. 12 | #' @param label Display label for the control, or `NULL` for no label. 13 | #' @param value Initial value. NULL by default. 14 | #' @param width The width of the input, e.g. `'400px'`, or `'100%'`; see 15 | #' [validateCssUnit()]. 16 | #' @param placeholder A character string giving the user a hint as to what can 17 | #' be entered into the control. Internet Explorer 8 and 9 do not support this 18 | #' option. 19 | #' @param min Minimum allowed value 20 | #' @param max Maximum allowed value 21 | #' @param step Interval to use when stepping between min and max 22 | #' 23 | #' @return A numeric input control that can be added to a UI definition. 24 | #' 25 | #' @seealso [shiny::updateNumericInput()] 26 | #' 27 | #' @examples 28 | #' 29 | #' if (interactive()) { 30 | #' library(shiny) 31 | #' library(shinysurveys) 32 | #' 33 | #' ui <- fluidPage( 34 | #' numberInput("obs", "Observations:", placeholder = "How many do you see?", min = 1, max = 100), 35 | #' verbatimTextOutput("value") 36 | #' ) 37 | #' server <- function(input, output) { 38 | #' output$value <- renderText({ input$obs }) 39 | #' } 40 | #' shinyApp(ui, server) 41 | #' } 42 | #' 43 | #' @section Server value: A numeric vector of length 1. 44 | #' 45 | #' @export 46 | #' 47 | numberInput <- function(inputId, label, value = NULL, min = NA, max = NA, step = NA, 48 | placeholder = NULL, width = NULL) { 49 | 50 | inputTag <- shiny::tags$input(id = inputId, type = "number", 51 | class = "form-control", 52 | placeholder = placeholder) 53 | 54 | if (!is.na(min)) 55 | inputTag$attribs$min <- min 56 | if (!is.na(max)) 57 | inputTag$attribs$max <- max 58 | if (!is.na(step)) 59 | inputTag$attribs$step <- step 60 | if (!is.null(value)) 61 | inputTag$attribs$value <- value 62 | 63 | shiny::tagList( 64 | shiny::div(class = "surveyNumericInput form-group shiny-input-container", 65 | style = htmltools::css(width = shiny::validateCssUnit(width)), 66 | shinyInputLabel(inputId, label), inputTag) 67 | 68 | ) 69 | } 70 | 71 | -------------------------------------------------------------------------------- /R/utils_parse-questions.R: -------------------------------------------------------------------------------- 1 | # Create a new environment for access within a survey 2 | survey_env <- base::new.env(parent = base::emptyenv()) 3 | 4 | #' Extract user ID from query string 5 | #' 6 | #' 7 | #' @param query_list The query list object from \code{shiny::parseQueryString} 8 | #' 9 | #' @keywords internal 10 | #' @return User ID 11 | #' 12 | base_extract_user_id <- function(query_list) { 13 | regmatches(query_list[["user_id"]], regexpr(pattern = "[^*/]+", text = query_list[["user_id"]])) 14 | } 15 | 16 | 17 | #' Get unique questions from user-input dataframe 18 | #' 19 | #' @param df User-input dataframe of questions 20 | #' 21 | #' @keywords internal 22 | #' 23 | #' @return List of questions 24 | #' 25 | get_questions <- function(df) { 26 | 27 | output <- split(df, factor(df$input_id, levels = unique(df$input_id))) 28 | names(output) <- NULL 29 | return(output) 30 | 31 | } 32 | 33 | #' Split questions based on dependency 34 | #' 35 | #' @param df A data frame subset for one question 36 | #' 37 | #' @keywords internal 38 | #' 39 | #' @return A list where each element is one UI question. 40 | #' 41 | split_dependence <- function(df) { 42 | if (all(is.na(df$dependence)) | all(!is.na(df$dependence))) { 43 | list(df) 44 | } else { 45 | list( 46 | df[is.na(df$dependence),], 47 | df[!is.na(df$dependence),] 48 | ) 49 | } 50 | } 51 | 52 | #' Simple pluck 53 | #' 54 | #' simple and specific version of purrr::pluck to meet use-case 55 | #' @param list A list object 56 | #' @param index A numeric index 57 | #' 58 | #' 59 | #' @keywords internal 60 | #' 61 | #' @return Returns list element. 62 | #' 63 | pluck_by_index <- function(list, index) { 64 | list[[index]] 65 | } 66 | 67 | 68 | #' Convert dataframe of questions to list for use in Shiny UI 69 | #' 70 | #' @param df A user supplied dataframe in the format of teaching_r_questions. 71 | #' 72 | #' 73 | #' @keywords internal 74 | #' 75 | #' @return A list of unique questions for each UI element 76 | #' 77 | listUniqueQuestions <- function(df) { 78 | 79 | # Replace any NAs in the option column with "Placeholder" 80 | df[["option"]][is.na(df[["option"]])] <- "Placeholder" 81 | 82 | # separate unique questions partially -- some in nested list 83 | partial <- lapply(get_questions(df), split_dependence) 84 | 85 | # pull each element so every UI element (dependence/question combo) is in one list 86 | output <- NULL 87 | 88 | for (question in 1:length(partial)) { 89 | output <- c(output, pluck_by_index(partial, question)) 90 | } 91 | 92 | return(output) 93 | } 94 | 95 | 96 | 97 | -------------------------------------------------------------------------------- /_pkgdown.yml: -------------------------------------------------------------------------------- 1 | destination: docs 2 | 3 | url: https://shinysurveys.jdtrat.com 4 | repo: 5 | home: https://github.com/jdtrat/shinysurveys/ 6 | source: https://github.com/jdtrat/shinysurveys/blob/master/ 7 | issue: https://github.com/jdtrat/shinysurveys/issues/ 8 | user: https://github.com/jdtrat/ 9 | 10 | template: 11 | package: jdtdown 12 | opengraph: 13 | image: 14 | src: man/figures/logo.png 15 | alt: "shinysurveys package" 16 | twitter: 17 | creator: "@jdtrat" 18 | card: summary 19 | 20 | authors: 21 | Jonathan Trattner: 22 | href: "https://jdtrat.com" 23 | Lucy D'Agostino McGowan: 24 | href: "https://lucymcgowan.com" 25 | 26 | home: 27 | strip_header: true 28 | links: 29 | - text: Learn more 30 | href: "" 31 | 32 | # structure of website themed with jdtdown 33 | # based on structure of jdtdown 34 | navbar: 35 | title: ~ 36 | type: default 37 | structure: 38 | left: [intro, examples, articles] 39 | right: [reference, news, github] 40 | components: 41 | home: 42 | reference: 43 | text: Reference 44 | href: reference/index.html 45 | github: 46 | icon: fab fa-github fa-lg 47 | href: https://github.com/jdtrat/shinysurveys 48 | news: 49 | text: News 50 | menu: 51 | - text: "Changelog" 52 | href: news/index.html 53 | - text: "------------------" 54 | - text: "Blog posts" 55 | - text: "shinysurveys 0.2.0" 56 | href: https://www.jdtrat.com/blog/shinysurveys-0-2-0/ 57 | 58 | articles: 59 | - title: Vignettes 60 | navbar: ~ 61 | contents: 62 | - surveying-shinysurveys 63 | - custom-input-extensions 64 | - get-survey-data 65 | 66 | reference: 67 | - title: "Creating a Basic Shiny Survey" 68 | desc: > 69 | Functions for creating a typical survey in Shiny. 70 | contents: 71 | - surveyOutput 72 | - renderSurvey 73 | - title: "Creating an Advanced Shiny Survey" 74 | desc: > 75 | Functions for stepping up your shiny survey game. 76 | contents: 77 | - getSurveyData 78 | - extendInputType 79 | - surveyID 80 | - surveyLabel 81 | - surveyOptions 82 | - listInputExtensions 83 | - hideSurvey 84 | - title: "Shinysurvey Inputs" 85 | decc: > 86 | Input types from shinysurveys to be used in shiny apps. 87 | contents: 88 | - radioMatrixInput 89 | - numberInput 90 | - title: "Demo tools" 91 | desc: > 92 | Functions and data to help you get started with {shinysurveys}. 93 | contents: 94 | - demo_survey 95 | - demo_survey_multipage 96 | - teaching_r_questions 97 | -------------------------------------------------------------------------------- /man/radioMatrixInput.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/input_radioMatrixInput.R 3 | \name{radioMatrixInput} 4 | \alias{radioMatrixInput} 5 | \title{Create a matrix of radio buttons.} 6 | \usage{ 7 | radioMatrixInput(inputId, responseItems, choices, selected = NULL, ...) 8 | } 9 | \arguments{ 10 | \item{inputId}{The input id} 11 | 12 | \item{responseItems}{The questions to be asked (row labels)} 13 | 14 | \item{choices}{Possible choices (column labels)} 15 | 16 | \item{selected}{Initial selected value} 17 | 18 | \item{...}{Additional arguments specific to {shinysurveys} required questions.} 19 | } 20 | \value{ 21 | A matrix of radio buttons that can be added to a UI definition. When 22 | run in a Shiny application, this will return \code{NULL} until all possible 23 | response items have been answered, at which time a data frame with the 24 | question_id, question_type, and response, the format used in 25 | \code{\link{getSurveyData}}. 26 | } 27 | \description{ 28 | Create a matrix of radio buttons. 29 | } 30 | \examples{ 31 | # For use as a normal Shiny input: 32 | 33 | if (interactive()) { 34 | 35 | library(shiny) 36 | 37 | ui <- fluidPage( 38 | radioMatrixInput("matInput", 39 | responseItems = c("Love sushi?", "Love chocolate?"), 40 | choices = c("Disagree", "Neutral", "Agree")) 41 | ) 42 | 43 | server <- function(input, output, session) { 44 | observe({ 45 | print(input$matInput) 46 | }) 47 | } 48 | 49 | shinyApp(ui, server) 50 | 51 | } 52 | 53 | # For use in {shinysurveys} 54 | 55 | if (interactive()) { 56 | 57 | df <- data.frame( 58 | question = c(rep("I love sushi.", 3), rep("I love chocolate.",3), 59 | "What's your favorite food?", rep("Goat cheese is the GOAT.", 5), 60 | rep("Yogurt and berries are a great snack.",5), 61 | rep("SunButter® is a fantastic alternative to peanut butter.", 5)), 62 | option = c(rep(c("Disagree", "Neutral", "Agree"), 2), "text", 63 | rep(c("Strongly Disagree", "Disagree", "Neutral", "Agree", "Strongly Agree"), 3)), 64 | input_type = c(rep("matrix", 6), "text", rep("matrix", 15)), 65 | # For matrix questions, the IDs should be the same for each question 66 | # but different for each matrix input unit 67 | input_id = c(rep("matId", 6), "favorite_food", rep("matId2", 15)), 68 | dependence = NA, 69 | dependence_value = NA, 70 | required = FALSE 71 | ) 72 | 73 | library(shiny) 74 | 75 | ui <- fluidPage( 76 | surveyOutput(df) 77 | ) 78 | 79 | server <- function(input, output, session) { 80 | renderSurvey() 81 | observe({ 82 | print(input$matId) 83 | print(input$favorite_food) 84 | print(input$matId2) 85 | }) 86 | } 87 | 88 | shinyApp(ui, server) 89 | 90 | } 91 | 92 | } 93 | -------------------------------------------------------------------------------- /R/func_demo-surveys.R: -------------------------------------------------------------------------------- 1 | #' Demo Survey 2 | #' 3 | #' This function runs a Shiny app that shows an example of running a demographic 4 | #' survey in Shiny. It has a sample title and description and its theme color 5 | #' can be customized using a hex color code. 6 | #' 7 | #' @param theme A valid hex color such as #63B8FF (default) 8 | #' 9 | #' @return A Shiny App 10 | #' @export 11 | #' 12 | #' @examples 13 | #' if (interactive()) demo_survey() 14 | #' 15 | demo_survey <- function(theme = "#63B8FF") { 16 | 17 | ui <- shiny::fluidPage( 18 | surveyOutput(shinysurveys::teaching_r_questions, 19 | survey_title = "A survey title", 20 | survey_description = "A description that is longer than the title.", 21 | theme = theme) 22 | ) 23 | 24 | server <- function(input, output, session) { 25 | 26 | renderSurvey() 27 | 28 | shiny::observeEvent(input$submit, { 29 | 30 | shiny::showModal(shiny::modalDialog( 31 | title = "Congratulations, you completed your first shinysurvey!", 32 | "You can customize what actions happen when a user finishes a survey using input$submit." 33 | )) 34 | 35 | }) 36 | 37 | } 38 | 39 | # Run the application 40 | shiny::shinyApp(ui = ui, server = server) 41 | 42 | } 43 | 44 | 45 | #' Demo Survey over Multiple Pages 46 | #' 47 | #' This function runs a Shiny app that shows an example of running a demographic 48 | #' survey in Shiny, spanning multiple pages. It has a sample title and description and its theme color 49 | #' can be customized using a hex color code. 50 | #' 51 | #' @param theme A valid hex color such as #63B8FF (default) 52 | #' 53 | #' @return A Shiny App 54 | #' @export 55 | #' 56 | #' @examples 57 | #' if (interactive()) demo_survey_multipage() 58 | #' 59 | demo_survey_multipage <- function(theme = "#63B8FF") { 60 | 61 | data <- transform(shinysurveys::teaching_r_questions, 62 | page = c(rep("intro", 12), rep("mid", 30), rep("finale", 12)) 63 | ) 64 | 65 | ui <- shiny::fluidPage( 66 | surveyOutput(df = data, 67 | survey_title = "A survey title", 68 | survey_description = "A description that is longer than the title.", 69 | theme = theme) 70 | ) 71 | 72 | server <- function(input, output, session) { 73 | 74 | renderSurvey() 75 | 76 | shiny::observeEvent(input$submit, { 77 | 78 | shiny::showModal(shiny::modalDialog( 79 | title = "Congratulations, you completed your first shinysurvey!", 80 | "You can customize what actions happen when a user finishes a survey using input$submit." 81 | )) 82 | 83 | }) 84 | 85 | } 86 | 87 | # Run the application 88 | shiny::shinyApp(ui = ui, server = server) 89 | 90 | } 91 | -------------------------------------------------------------------------------- /tests/testthat/test-surveyOutput-instructions.R: -------------------------------------------------------------------------------- 1 | instructions_added <- 2 | rbind(data.frame(question = "In the following thing, please do this thing.", 3 | option = NA, 4 | input_type = "instructions", 5 | # Note the input IDs are specific for the language option 6 | input_id = "age", 7 | dependence = NA, 8 | dependence_value = NA, 9 | required = TRUE), 10 | rbind(teaching_r_questions)) 11 | 12 | 13 | test_that("surveyOutput() works - instructions added", { 14 | local_edition(3) 15 | expect_snapshot_output(shiny::fluidPage( 16 | shinysurveys::surveyOutput(df = instructions_added, 17 | survey_title = "Testing Instructions") 18 | )) 19 | }) 20 | 21 | 22 | matrix_instructions <- data.frame(question = c("Please indicate how much you agree or disagree with the following statements:", 23 | rep("My team members can depend upon me as a 'safe space' when they are experiencing stressful workplace experiences.", 5), 24 | rep("I feel competent in my role as a leader",5), rep("I have a different identity as a leader than I do when I am with family or friends.", 5), 25 | rep("The best way to get my team members to work independently is to keep them at a distance", 5), rep("In the past 3 months, I have used breathing exercises", 5), 26 | rep("In the past 3 months, I have practiced silencing my mind.", 5), rep("I communicate the emotions I am feeling to my team members.", 5), 27 | rep("To check the words I use to express emotions with my body to see if the words are right for the feelings.", 5)), 28 | option = c(NA, rep(c("Strongly Disagree", "Disagree", "Neither Agree or Disagree", "Agree", "Strongly Agree"), 8)), 29 | input_type = c("instructions", rep("matrix", 40)), 30 | input_id = "matId_1", 31 | dependence = NA, 32 | dependence_value = NA, 33 | required = F) 34 | 35 | test_that("surveyOutput() works - instructions with matrix", { 36 | local_edition(3) 37 | expect_snapshot_output(shiny::fluidPage( 38 | shinysurveys::surveyOutput(df = matrix_instructions, 39 | survey_title = "Testing Instructions - Matrix") 40 | )) 41 | }) 42 | 43 | multiple_instructions <- rbind(instructions_added, matrix_instructions) 44 | 45 | 46 | test_that("surveyOutput() works - instructions with matrix and teaching-r-questions", { 47 | local_edition(3) 48 | expect_snapshot_output(shiny::fluidPage( 49 | shinysurveys::surveyOutput(df = multiple_instructions, 50 | survey_title = "Testing Instructions - Matrix & Teaching R Questions") 51 | )) 52 | }) 53 | -------------------------------------------------------------------------------- /R/utils_javascript-message-handlers.R: -------------------------------------------------------------------------------- 1 | #' Remove CSS Class 2 | #' 3 | #' Custom function for removing a CSS class used in {shinysurveys}. 4 | #' 5 | #' @param .id Shiny object inputId 6 | #' @param .class class to be removed 7 | #' @keywords internal 8 | #' 9 | #' @return NA; used for side effects 10 | #' 11 | remove_class <- function(.id, .class) { 12 | session <- shiny::getDefaultReactiveDomain() 13 | session$sendCustomMessage( 14 | "remove_class", 15 | list(input_id = .id, 16 | class_name = .class) 17 | ) 18 | } 19 | 20 | #' Add CSS Class 21 | #' 22 | #' Custom function for adding a CSS class used in {shinysurveys}. 23 | #' 24 | #' @param .id Shiny object inputId 25 | #' @param .class class to be added 26 | #' @keywords internal 27 | #' 28 | #' @return NA; used for side effects 29 | #' 30 | add_class <- function(.id, .class) { 31 | session <- shiny::getDefaultReactiveDomain() 32 | session$sendCustomMessage( 33 | "add_class", 34 | list(input_id = .id, 35 | class_name = .class) 36 | ) 37 | } 38 | 39 | #' Disable HTML element 40 | #' 41 | #' Custom function for disabling an HTML element in {shinysurveys}. 42 | #' 43 | #' @param .id Shiny object inputId 44 | #' @keywords internal 45 | #' 46 | #' @return NA; used for side effects 47 | #' 48 | disable_element <- function(.id) { 49 | session <- shiny::getDefaultReactiveDomain() 50 | session$sendCustomMessage( 51 | "disable", 52 | list(input_id = .id) 53 | ) 54 | } 55 | 56 | #' Enable HTML element 57 | #' 58 | #' Custom function for disabling an HTML element in {shinysurveys}. 59 | #' 60 | #' @param .id Shiny object inputId 61 | #' @keywords internal 62 | #' 63 | #' @return NA; used for side effects 64 | #' 65 | enable_element <- function(.id) { 66 | session <- shiny::getDefaultReactiveDomain() 67 | session$sendCustomMessage( 68 | "enable", 69 | list(input_id = .id) 70 | ) 71 | } 72 | 73 | #' Hide shinysurvey 74 | #' 75 | #' This function allows you to easily hide the survey, something you may wish to 76 | #' do upon submission. 77 | #' 78 | #' @return NA; used to hide the survey. 79 | #' 80 | #' @examples 81 | #' 82 | #' if (interactive()) { 83 | #' 84 | #' library(shiny) 85 | #' library(shinysurveys) 86 | #' 87 | #' ui <- fluidPage( 88 | #' surveyOutput(teaching_r_questions, 89 | #' survey_title = "Now you see me...", 90 | #' survey_description = "A demo showing how to hide the survey body upon submission.") 91 | #' ) 92 | #' 93 | #' server <- function(input, output, session) { 94 | #' renderSurvey() 95 | #' observeEvent(input$submit, hideSurvey()) 96 | #' } 97 | #' 98 | #' shinyApp(ui, server) 99 | #' 100 | #' } 101 | #' 102 | hideSurvey <- function() { 103 | session <- shiny::getDefaultReactiveDomain() 104 | session$sendCustomMessage('hideSurvey', list()) 105 | } 106 | -------------------------------------------------------------------------------- /tests/testthat/test-server-multi-check.R: -------------------------------------------------------------------------------- 1 | 2 | 3 | # This example requires custom input extension, e.g.: 4 | # extendInputType("check", { 5 | # shiny::checkboxGroupInput( 6 | # inputId = surveyID(), 7 | # label = surveyLabel(), 8 | # choices = surveyOptions() 9 | # ) 10 | # }) 11 | 12 | ice_cream_questions <- data.frame( 13 | stringsAsFactors = FALSE, 14 | question = c("Please indicate your top three favorite ice cream flavors.", 15 | "Please indicate your top three favorite ice cream flavors.", 16 | "Please indicate your top three favorite ice cream flavors.", 17 | "Please indicate your top three favorite ice cream flavors.", 18 | "Please indicate your top three favorite ice cream flavors.", 19 | "Please indicate your top three favorite ice cream flavors.", 20 | "Please indicate your top three favorite ice cream flavors.", 21 | "Please indicate your top three favorite ice cream flavors.", 22 | "Please indicate your top three favorite ice cream flavors.", 23 | "Please indicate your top three favorite ice cream flavors.","Specify:"), 24 | option = c("Chocolate","Vanilla", 25 | "Strawberry","Mint Chocolate Chip","Rocky Road", 26 | "Cookie Batter","Hazelnut","Cookies N' Cream","Pistachio","Other", 27 | NA), 28 | input_type = c("check","check","check", 29 | "check","check","check","check","check","check","check", 30 | "text"), 31 | input_id = c("favorite_ice_cream", 32 | "favorite_ice_cream","favorite_ice_cream","favorite_ice_cream", 33 | "favorite_ice_cream","favorite_ice_cream", 34 | "favorite_ice_cream","favorite_ice_cream","favorite_ice_cream", 35 | "favorite_ice_cream","favorite_ice_cream_other"), 36 | dependence = c(NA,NA,NA,NA,NA,NA,NA,NA, 37 | NA,NA,"favorite_ice_cream"), 38 | dependence_value = c(NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, "Other"), 39 | required = c(FALSE,FALSE,FALSE,FALSE, 40 | FALSE,FALSE,FALSE,FALSE,FALSE,FALSE,FALSE), 41 | page = c("1", "1", "1", "1", "1", "1", "1", "1", "1", "1", "1") 42 | ) 43 | 44 | test_that("server works with dependency questions - multiple values for an input", { 45 | server <- function(input, output, session) { 46 | 47 | listed <- listUniqueQuestions(ice_cream_questions) 48 | 49 | show_dependency <- reactive({showDependence(input = input, df = listed[[2]])}) 50 | 51 | } 52 | 53 | shiny::testServer(server, { 54 | session$setInputs(favorite_ice_cream = c("Chocolate")) 55 | expect_false(show_dependency()) 56 | session$setInputs(favorite_ice_cream = c("Chocolate", "Cookies N' Cream")) 57 | expect_false(show_dependency()) 58 | session$setInputs(favorite_ice_cream = c("Chocolate", "Cookies N' Cream", "Other")) 59 | expect_true(show_dependency()) 60 | }) 61 | 62 | }) 63 | -------------------------------------------------------------------------------- /.github/workflows/R-CMD-check.yaml: -------------------------------------------------------------------------------- 1 | # For help debugging build failures open an issue on the RStudio community with the 'github-actions' tag. 2 | # https://community.rstudio.com/new-topic?category=Package%20development&tags=github-actions 3 | on: 4 | push: 5 | branches: 6 | - main 7 | - master 8 | pull_request: 9 | branches: 10 | - main 11 | - master 12 | 13 | name: R-CMD-check 14 | 15 | jobs: 16 | R-CMD-check: 17 | runs-on: ${{ matrix.config.os }} 18 | 19 | name: ${{ matrix.config.os }} (${{ matrix.config.r }}) 20 | 21 | strategy: 22 | fail-fast: false 23 | matrix: 24 | config: 25 | - {os: windows-latest, r: 'release'} 26 | - {os: macOS-latest, r: 'release'} 27 | - {os: ubuntu-20.04, r: 'release', rspm: "https://packagemanager.rstudio.com/cran/__linux__/focal/latest"} 28 | - {os: ubuntu-20.04, r: 'devel', rspm: "https://packagemanager.rstudio.com/cran/__linux__/focal/latest"} 29 | 30 | env: 31 | R_REMOTES_NO_ERRORS_FROM_WARNINGS: true 32 | RSPM: ${{ matrix.config.rspm }} 33 | GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }} 34 | 35 | steps: 36 | - uses: actions/checkout@v2 37 | 38 | - uses: r-lib/actions/setup-r@v1 39 | with: 40 | r-version: ${{ matrix.config.r }} 41 | 42 | - uses: r-lib/actions/setup-pandoc@v1 43 | 44 | - name: Query dependencies 45 | run: | 46 | install.packages('remotes') 47 | saveRDS(remotes::dev_package_deps(dependencies = TRUE), ".github/depends.Rds", version = 2) 48 | writeLines(sprintf("R-%i.%i", getRversion()$major, getRversion()$minor), ".github/R-version") 49 | shell: Rscript {0} 50 | 51 | - name: Cache R packages 52 | if: runner.os != 'Windows' 53 | uses: actions/cache@v2 54 | with: 55 | path: ${{ env.R_LIBS_USER }} 56 | key: ${{ runner.os }}-${{ hashFiles('.github/R-version') }}-1-${{ hashFiles('.github/depends.Rds') }} 57 | restore-keys: ${{ runner.os }}-${{ hashFiles('.github/R-version') }}-1- 58 | 59 | - name: Install system dependencies 60 | if: runner.os == 'Linux' 61 | run: | 62 | while read -r cmd 63 | do 64 | eval sudo $cmd 65 | done < <(Rscript -e 'writeLines(remotes::system_requirements("ubuntu", "20.04"))') 66 | 67 | - name: Install dependencies 68 | run: | 69 | remotes::install_deps(dependencies = TRUE) 70 | remotes::install_cran("rcmdcheck") 71 | shell: Rscript {0} 72 | 73 | - name: Check 74 | env: 75 | _R_CHECK_CRAN_INCOMING_REMOTE_: false 76 | run: rcmdcheck::rcmdcheck(args = c("--no-manual", "--as-cran"), error_on = "warning", check_dir = "check") 77 | shell: Rscript {0} 78 | 79 | - name: Upload check results 80 | if: failure() 81 | uses: actions/upload-artifact@main 82 | with: 83 | name: ${{ runner.os }}-r${{ matrix.config.r }}-results 84 | path: check 85 | -------------------------------------------------------------------------------- /.github/CONTRIBUTING.md: -------------------------------------------------------------------------------- 1 | # Contributing to shinysurveys 2 | 3 | Howdy :wave:! Thanks for your interest in making shinysurveys better! The guidelines below outline how to propose a change to shinysurveys. They are based on (i.e. the same as) the `tidyverse` contribution guidelines. If you have any additional questions, please [open an issue](https://github.com/jdtrat/shinysurveys/issues) or send me a [message on Twitter](https://twitter.com/jdtrat). 4 | 5 | ## Fixing typos 6 | 7 | You can fix typos, spelling mistakes, or grammatical errors in the documentation directly using the GitHub web interface, as long as the changes are made in the *source* file. This generally means you'll need to edit [roxygen2 comments](https://roxygen2.r-lib.org/articles/roxygen2.html) in an `.R`, not a `.Rd` file. You can find the `.R` file that generates the `.Rd` by reading the comment in the first line. 8 | 9 | ## Bigger changes 10 | 11 | If you want to make a bigger change, it's a good idea to first file an [issue](https://github.com/jdtrat/shinysurveys/issues). If you've found a bug, please file an issue that illustrates the bug with a minimal [reprex](https://reprex.tidyverse.org) (this will also help you write a unit test, if needed). 12 | 13 | ### Pull request process 14 | 15 | - Fork the package and clone onto your computer. If you haven't done this before, we recommend using `usethis::create_from_github("jdtrat/shinysurveys", fork = TRUE)`. 16 | 17 | - Install all development dependencies with `devtools::install_dev_deps()`, and then make sure the package passes R CMD check by running `devtools::check()`. If R CMD check doesn't pass cleanly, it's a good idea to ask for help before continuing. 18 | 19 | - Create a Git branch for your pull request (PR). We recommend using `usethis::pr_init("brief-description-of-change")`. 20 | 21 | - Make your changes, commit to git, and then create a PR by running `usethis::pr_push()`, and following the prompts in your browser. The title of your PR should briefly describe the change. The body of your PR should contain `Fixes #issue-number`. 22 | 23 | - For user-facing changes, add a bullet to the top of `NEWS.md` (i.e. just below the first header). Follow the style described in . 24 | 25 | ### Code style 26 | 27 | - New code should follow the tidyverse [style guide](https://style.tidyverse.org). You can use the [styler](https://CRAN.R-project.org/package=styler) package to apply these styles, but please don't restyle code that has nothing to do with your PR. 28 | 29 | - We use [roxygen2](https://cran.r-project.org/package=roxygen2), with [Markdown syntax](https://cran.r-project.org/web/packages/roxygen2/vignettes/rd-formatting.html), for documentation. 30 | 31 | - We use [testthat](https://cran.r-project.org/package=testthat) for unit tests. Contributions with test cases included are easier to accept. 32 | 33 | ## Code of Conduct 34 | 35 | Please note that the shinysurveys project is released with a [Contributor Code of Conduct](CODE_OF_CONDUCT.md). By contributing to this project you agree to abide by its terms. 36 | -------------------------------------------------------------------------------- /man/extendInputType.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/func_extend-shinysurveys.R 3 | \name{extendInputType} 4 | \alias{extendInputType} 5 | \title{Add Custom Input Types for a Survey} 6 | \usage{ 7 | extendInputType(input_type, extension) 8 | } 9 | \arguments{ 10 | \item{input_type}{A string of the input type supplied in the data frame of questions.} 11 | 12 | \item{extension}{A shiny input type not natively supported by {shinysurveys}. See the examples section for more information.} 13 | } 14 | \value{ 15 | NA; used to register custom input types for use with a shiny survey. 16 | } 17 | \description{ 18 | Add Custom Input Types for a Survey 19 | } 20 | \examples{ 21 | 22 | # Register a slider input to {shinysurveys} with a custom minimum and maximum value. 23 | 24 | extendInputType("slider", { 25 | shiny::sliderInput( 26 | inputId = surveyID(), 27 | label = surveyLabel(), 28 | min = 1, 29 | max = 10, 30 | value = 5 31 | ) 32 | }) 33 | 34 | # Define a question as normal with the `input_type` set to the custom slider type defined above. 35 | slider_question <- data.frame(question = "On a scale from 1-10, 36 | how much do you love sushi?", 37 | option = NA, 38 | input_type = "slider", 39 | input_id = "sushi_scale", 40 | dependence = NA, 41 | dependence_value = NA, 42 | required = TRUE) 43 | 44 | # Watch it in action 45 | if (interactive()) { 46 | ui <- fluidPage( 47 | surveyOutput(df = slider_question, "Sushi Scale Example") 48 | ) 49 | 50 | server <- function(input, output, session) { 51 | renderSurvey() 52 | } 53 | 54 | shinyApp(ui, server) 55 | 56 | } 57 | 58 | 59 | 60 | # Register a date input to {shinysurveys}, 61 | # limiting possible dates to a twenty-day period. 62 | 63 | extendInputType("date", { 64 | shiny::dateInput( 65 | inputId = surveyID(), 66 | value = Sys.Date(), 67 | label = surveyLabel(), 68 | min = Sys.Date()-10, 69 | max = Sys.Date()+10 70 | ) 71 | }) 72 | 73 | # Define a question as normal with the `input_type` set to 74 | # the custom date type defined above. 75 | 76 | date_question <- data.frame(question = "When do you graduate?", 77 | option = NA, 78 | input_type = "date", 79 | input_id = "grad_date", 80 | dependence = NA, 81 | dependence_value = NA, 82 | required = FALSE) 83 | 84 | # Watch it in action 85 | if (interactive()) { 86 | ui <- fluidPage( 87 | surveyOutput(df = date_question, "Date Input Extension Example") 88 | ) 89 | 90 | server <- function(input, output, session) { 91 | renderSurvey() 92 | } 93 | 94 | shinyApp(ui, server) 95 | } 96 | 97 | 98 | # Combine both custom input types: 99 | 100 | if (interactive()) { 101 | ui <- fluidPage( 102 | surveyOutput(df = rbind(slider_question, date_question), 103 | "Date & Slider Input Extension Example") 104 | ) 105 | 106 | server <- function(input, output, session) { 107 | renderSurvey() 108 | } 109 | 110 | shinyApp(ui, server) 111 | } 112 | 113 | 114 | } 115 | \seealso{ 116 | \code{\link{surveyID}} 117 | 118 | \code{\link{surveyLabel}} 119 | } 120 | -------------------------------------------------------------------------------- /R/utils_survey-output.R: -------------------------------------------------------------------------------- 1 | #' Check survey metadata 2 | #' 3 | #' Returns title/description HTML tags as needed. 4 | #' 5 | #' @param survey_description The survey's description from surveyOutput 6 | #' @param survey_title The survey's title from surveyOutput 7 | #' 8 | #' @keywords internal 9 | #' 10 | #' @return Returns error messages if required paramters are not supplied, 11 | #' otherwise it returns the appropriate code for survey titles and description 12 | #' for use in surveyOutput. 13 | #' 14 | check_survey_metadata <- function(survey_description, survey_title) { 15 | 16 | if (!missing(survey_description) && missing(survey_title)) { 17 | stop("Must provide a survey title in order to provide a survey description.") 18 | } else if (missing(survey_title) && missing(survey_description)) { 19 | return() 20 | } else if (!missing(survey_title) && missing(survey_description)) { 21 | 22 | if (is.null(survey_title)) { 23 | return() 24 | } else { 25 | return( 26 | shiny::div(class = "title-description", 27 | shiny::h1(id = "survey-title", survey_title)) 28 | ) 29 | } 30 | 31 | 32 | } else if (!missing(survey_title) && !missing(survey_description)) { 33 | 34 | if (is.null(survey_title) && is.null(survey_description)){ 35 | return() 36 | } else { 37 | return( 38 | shiny::div(class = "title-description", 39 | shiny::h1(id = "survey-title", survey_title), 40 | shiny::p(id = "survey-description", survey_description)) 41 | ) 42 | } 43 | 44 | } 45 | } 46 | 47 | #' Control Title UI Placement for Multi-paged Surveys 48 | #' 49 | #' @param page 50 | #' 51 | #' @keywords internal 52 | #' 53 | #' @return UI for title if applicable 54 | #' 55 | title_placeholder <- function(page) { 56 | if (page == "1") { 57 | check_survey_metadata(survey_description = survey_env$description, 58 | survey_title = survey_env$title) 59 | } else { 60 | NULL 61 | } 62 | } 63 | 64 | 65 | 66 | #' Button placement on each page of questions 67 | #' 68 | #' @param page Current page to define UI for. Specified in \code{\link{multipaged_ui}} 69 | #' 70 | #' @keywords internal 71 | #' 72 | #' @return UI for "Next", "Previous", and "Submit" buttons 73 | #' 74 | button_placeholders <- function(page) { 75 | 76 | # If there's only one page, just display submit button 77 | if (page == "1" && length(unique(survey_env$question_df$page)) == 1) { 78 | shiny::div(class = "survey-buttons", 79 | shiny::actionButton("submit", "Submit") 80 | ) 81 | 82 | } else if (page == "1" && length(unique(survey_env$question_df$page)) != 1) { 83 | shiny::div(class = "survey-buttons", 84 | shiny::actionButton(paste0("next-", page), "Next", `page-action` = "next") 85 | ) 86 | } else if (page != "1" && page != as.character(survey_env$num_pages)) { 87 | shiny::div(class = "survey-buttons", 88 | shiny::actionButton(paste0("previous-", page), "Previous", `page-action` = "previous"), 89 | shiny::actionButton(paste0("next-", page), "Next", `page-action` = "next") 90 | ) 91 | } else if (page == as.character(survey_env$num_pages)) { 92 | shiny::div(class = "survey-buttons", 93 | shiny::actionButton(paste0("previous-", page), "Previous", `page-action` = "previous"), 94 | shiny::actionButton("submit", "Submit") 95 | ) 96 | } 97 | } 98 | -------------------------------------------------------------------------------- /tests/testthat/test-get_survey_data.R: -------------------------------------------------------------------------------- 1 | # Setup test questions ---------------------------------------------------- 2 | 3 | 4 | food_question <- data.frame(question = "What is your favorite food?", 5 | option = "Your Answer", 6 | input_type = "text", 7 | input_id = "favorite_food", 8 | dependence = NA, 9 | dependence_value = NA, 10 | required = F) 11 | 12 | matrix_questions <- data.frame( 13 | question = c(rep("I love sushi.", 3), rep("I love chocolate.",3), 14 | "What's your favorite food?", rep("Goat cheese is the GOAT.", 5), 15 | rep("Yogurt and berries are a great snack.",5), 16 | rep("SunButter® is a fantastic alternative to peanut butter.", 5)), 17 | option = c(rep(c("Disagree", "Neutral", "Agree"), 2), "text", 18 | rep(c("Strongly Disagree", "Disagree", "Neutral", "Agree", "Strongly Agree"), 3)), 19 | input_type = c(rep("matrix", 6), "text", rep("matrix", 15)), 20 | input_id = c(rep("matId", 6), "favorite_food", rep("matId2", 15)), 21 | dependence = NA, 22 | dependence_value = NA, 23 | required = FALSE 24 | ) 25 | 26 | 27 | 28 | 29 | library(shiny) 30 | #remotes::install_github("jdtrat/shinysurveys@extend-shinysurveys") 31 | library(shinysurveys) 32 | 33 | 34 | # Register a date input to {shinysurveys}, 35 | # limiting possible dates to a twenty-day period. 36 | 37 | extendInputType("date", { 38 | shiny::dateInput( 39 | inputId = surveyID(), 40 | value = Sys.Date(), 41 | label = surveyLabel(), 42 | min = Sys.Date()-10, 43 | max = Sys.Date()+10 44 | ) 45 | }) 46 | 47 | # Define a question as normal with the `input_type` set to 48 | # the custom date type defined above. 49 | 50 | date_question <- data.frame(question = "When do you graduate?", 51 | option = NA, 52 | input_type = "date", 53 | input_id = "grad_date", 54 | dependence = NA, 55 | dependence_value = NA, 56 | required = FALSE) 57 | 58 | 59 | ui <- fluidPage( 60 | surveyOutput(df = date_question, "Date Input Extension Example") 61 | ) 62 | 63 | server <- function(input, output, session) { 64 | renderSurvey() 65 | } 66 | 67 | shinyApp(ui, server) 68 | 69 | 70 | 71 | 72 | 73 | 74 | 75 | df <- data.frame( 76 | question = c("What's your favorite food?", rep("Do you like SunButter®", 2), 77 | "Where do you live?", "What is the temperature where you are?"), 78 | option = c("Sushi", "Yes", "No", "North Carolina", "79"), 79 | input_type = c("text", rep("y/n", 2), "text", "numeric"), 80 | input_id = c("favorite_food", rep("sunbutter", 2), "location", "temperature"), 81 | dependence = c(NA, "favorite_food", "favorite_food", NA, NA), 82 | dependence_value = c(NA, "Sushi", "Sushi", NA, NA), 83 | required = FALSE 84 | ) 85 | 86 | ui <- fluidPage( 87 | surveyOutput(df, 88 | survey_title = "{shinysurveys} Automatic Response Aggregation Example", 89 | survey_description = "The function `getSurveyData()` takes into account dependencies, 90 | and will only include questions that participants saw when aggregating responses." 91 | ) 92 | ) 93 | 94 | server <- function(input, output, session) { 95 | renderSurvey() 96 | 97 | observeEvent(input$submit, { 98 | print(getSurveyData()) 99 | }) 100 | } 101 | 102 | shinyApp(ui, server) 103 | -------------------------------------------------------------------------------- /inst/render_survey.scss: -------------------------------------------------------------------------------- 1 | @import url('https://fonts.googleapis.com/css?family=Source+Code+Pro|Montserrat|Raleway'); 2 | 3 | $little_dark: darken($color, 5%); 4 | $middle_dark: darken($color, 10%); 5 | $little_light: lighten($color, 5%); 6 | $middle_light: lighten($color, 10%); 7 | $questions_background: $middle_light; 8 | $light: lighten($color, 15%); 9 | $dark: darken($color, 15%); 10 | 11 | body { 12 | font-family: 'Raleway', sans-serif; 13 | background-color: $light; 14 | } 15 | 16 | h1, h2, h3, h4, h5, h6 { 17 | color: #333; 18 | font-family: 'Montserrat', sans-serif; 19 | } 20 | 21 | h1, h2, h3 { 22 | text-transform: uppercase; 23 | text-align: left; 24 | letter-spacing: .1em; 25 | line-height: 1.2; 26 | } 27 | 28 | h1 { 29 | font-size: 3rem; 30 | margin: 36px 0; 31 | 32 | &.title { 33 | color: #416983;; 34 | } 35 | } 36 | 37 | h3 { 38 | font-style: italic; 39 | font-family: 'Montserrat', sans-serif; 40 | } 41 | 42 | p { 43 | color: #333; 44 | margin: 35px; 45 | margin-bottom: 10px; 46 | font-family: 'Raleway', sans-serif; 47 | } 48 | 49 | li.l { 50 | margin-left: 40px; 51 | margin-right: 35px; 52 | } 53 | 54 | input[type=text]:focus { 55 | border-bottom: 1.5px solid $little_dark; 56 | -webkit-box-shadow: none 57 | } 58 | 59 | input[type=text] { 60 | font-size: 1.5rem; 61 | border: none; 62 | box-shadow: none; 63 | border-radius: 0; 64 | border-bottom: 1px dashed rgba(0,0,0,0.12); 65 | padding: 15px 0; 66 | outline: none; 67 | color: #3A506B; 68 | background-color: transparent; 69 | } 70 | 71 | label { 72 | margin-bottom: 10px; 73 | font-size: 1.5rem; 74 | } 75 | 76 | .required { 77 | color: red; 78 | } 79 | 80 | .container-fluid { 81 | 82 | .survey { 83 | padding: 20px; 84 | padding-left: 20%; 85 | padding-right: 20%; 86 | 87 | @media (max-width: 1195px) { 88 | padding-left: 15%; 89 | padding-right: 15%; 90 | } 91 | 92 | @media (max-width: 992px) { 93 | padding-left: 12.5%; 94 | padding-right: 12.5%; 95 | } 96 | 97 | @media (max-width: 767px) { 98 | padding-left: 10%; 99 | padding-right: 10%; 100 | } 101 | 102 | @media (max-width: 575px) { 103 | padding-left: 7.5%; 104 | padding-right: 7.5%; 105 | } 106 | 107 | .title-description { 108 | background-color: white; 109 | border-radius: 20px; 110 | border-top: 20px solid $middle_dark; 111 | padding: { 112 | left: 5%; 113 | right: 5%; 114 | bottom: 10px; 115 | } 116 | margin-bottom: 12px; 117 | 118 | #survey-description { 119 | text-align: center; 120 | margin: 2px; 121 | font-size: 1.8rem; 122 | } 123 | 124 | #survey-title { 125 | text-align: center; 126 | margin-top: 20px; 127 | margin-bottom: 12px; 128 | } 129 | } 130 | 131 | .page-hidden { 132 | display: none; 133 | } 134 | 135 | .questions { 136 | display: grid; 137 | background-color: white; 138 | border: 0.5px solid #CCCCCC; 139 | border-radius: 10px; 140 | margin-bottom: 12px; 141 | padding: 10px; 142 | min-height: 138px; 143 | font-size: 1.4rem; 144 | 145 | &.dependence { 146 | padding: 0; 147 | display: none; 148 | } 149 | 150 | .question-input { 151 | margin: auto; 152 | width: 100%; 153 | 154 | .shiny-input-container { 155 | width: 100%; 156 | padding: 0; 157 | 158 | } 159 | } 160 | } 161 | } 162 | } 163 | -------------------------------------------------------------------------------- /R/func_render-survey.R: -------------------------------------------------------------------------------- 1 | 2 | #' Server code for adding survey questions 3 | #' 4 | #' Include server-side logic for shinysurveys. 5 | #' 6 | #' 7 | #' @param df **Deprecated** *please only place argument in 8 | #' \code{\link{surveyOutput}}.* A user supplied data frame in the format of 9 | #' teaching_r_questions. 10 | #' @param theme **Deprecated** *please place the theme argument in 11 | #' \code{\link{surveyOutput}}.* A valid R color: predefined such as "red" or 12 | #' "blue"; hex colors such as #63B8FF (default). To customize the survey's 13 | #' appearance entirely, supply NULL. 14 | #' 15 | #' @export 16 | #' 17 | #' @return NA; used for server-side logic in Shiny apps. 18 | #' 19 | #' @examples 20 | #' 21 | 22 | #' if (interactive()) { 23 | #' 24 | #' library(shiny) 25 | #' library(shinysurveys) 26 | #' 27 | #' df <- data.frame(question = "What is your favorite food?", 28 | #' option = "Your Answer", 29 | #' input_type = "text", 30 | #' input_id = "favorite_food", 31 | #' dependence = NA, 32 | #' dependence_value = NA, 33 | #' required = F) 34 | #' 35 | #' ui <- fluidPage( 36 | #' surveyOutput(df = df, 37 | #' survey_title = "Hello, World!", 38 | #' theme = "#63B8FF") 39 | #' ) 40 | #' 41 | #' server <- function(input, output, session) { 42 | #' renderSurvey() 43 | #' 44 | #' observeEvent(input$submit, { 45 | #' showModal(modalDialog( 46 | #' title = "Congrats, you completed your first shinysurvey!", 47 | #' "You can customize what actions happen when a user finishes a survey using input$submit." 48 | #' )) 49 | #' }) 50 | #' } 51 | #' 52 | #' shinyApp(ui, server) 53 | #' 54 | #' } 55 | #' 56 | renderSurvey <- function(df, theme = "#63B8FF") { 57 | 58 | if (missing(df)) { 59 | df <- survey_env$question_df 60 | } else if (!missing(df)) { 61 | warning("The `df` argument in `renderSurvey()` is deprecated and will be removed in a future version. Please only pass the data frame of questions to `surveyOutput()`.") 62 | } 63 | 64 | if (missing(theme)) { 65 | theme <- survey_env$theme 66 | } else if (!missing(theme)) { 67 | warning("The `theme` argument in `renderSurvey()` is deprecated and will be removed in a future version. Please only pass the theme color to `surveyOutput()`.") 68 | } 69 | 70 | session <- shiny::getDefaultReactiveDomain() 71 | 72 | required_vec <- getRequired_internal(survey_env$unique_questions) 73 | 74 | shiny::observe({ 75 | 76 | query <- shiny::parseQueryString(session$clientData$url_search) 77 | if (!base::is.null(query[["user_id"]])) { 78 | new_value <- base_extract_user_id(query) 79 | shiny::updateTextInput(session, inputId = "userID", value = new_value) 80 | } 81 | 82 | # Update the dependencies 83 | for (id in seq_along(survey_env$unique_questions)) showDependence(input = session$input, df = survey_env$unique_questions[[id]]) 84 | 85 | toggle_element(id = "submit", 86 | condition = checkRequired_internal(input = session$input, 87 | required_inputs_vector = required_vec)) 88 | 89 | }) 90 | 91 | # Clean up non-essential internal environmental variables 92 | shiny::onStop(function() rm(list = ls(survey_env)[which(!ls(survey_env) %in% c("question_df", 93 | "unique_questions", 94 | "input_type", 95 | "input_extension"))], envir = survey_env)) 96 | 97 | shiny::onStop(function() unlink(survey_env$css_file)) 98 | 99 | } 100 | -------------------------------------------------------------------------------- /vignettes/shinysurveys.Rmd: -------------------------------------------------------------------------------- 1 | --- 2 | title: "Learn shinysurveys" 3 | output: rmarkdown::html_vignette 4 | vignette: > 5 | %\VignetteIndexEntry{Learn shinysurveys} 6 | %\VignetteEngine{knitr::rmarkdown} 7 | %\VignetteEncoding{UTF-8} 8 | --- 9 | 10 | ```{r, include = FALSE} 11 | knitr::opts_chunk$set( 12 | collapse = TRUE, 13 | comment = "#>" 14 | ) 15 | ``` 16 | 17 | 18 | # Introduction 19 | 20 | {shinysurveys} provides easy-to-use, minimalistic code for creating and deploying surveys in R. It extends the {shiny} package and converts a table of questions into an interactive web-based application. Administering surveys with this package allows users to combine the computational tools of R with the interactivity of web applications. This helps bridge the gap between data collection and data analysis. 21 | 22 | ## Installation 23 | 24 | You can install {shinysurveys} via CRAN or GitHub and load it as follows: 25 | 26 | ```r 27 | # Install released version from CRAN 28 | install.packages("shinysurveys") 29 | 30 | # Or, install the development version from GitHub 31 | remotes::install_github("jdtrat/shinysurveys") 32 | 33 | # Load package 34 | library(shinysurveys) 35 | ``` 36 | 37 | ## Basic Survey 38 | 39 | {shinysurveys} exports two functions: `surveyOutput()` and `renderSurvey()`. The former goes in the UI portion of a Shiny app, and the latter goes in the server portion. To create a survey, you can build a data frame with your questions. The following columns are required. 40 | 41 | - *question*: The question to be asked. 42 | - *option*: A possible response to the question. In multiple choice questions, for example, this would be the possible answers. For questions without discrete answers, such as a numeric input, this would be the default option shown on the input. For text inputs, it is the placeholder value. 43 | - *input_type*: What type of response is expected? Currently supported types include `numeric`, `mc` for multiple choice, `text`, `select`, and `y/n` for yes/no questions. 44 | - *input_id*: The id for Shiny inputs. 45 | - *dependence*: Does this question (row) depend on another? That is, should it only appear if a different question has a specific value? This column contains the input_id of whatever question this one depends upon. 46 | - *dependence_value*: This column contains the specific value that the dependence question must take for this question (row) to be shown. 47 | - *required*: logical TRUE/FALSE signifying if a question is required. Surveys can only be submitted when all required questions are answered. 48 | 49 | A demo survey can be created as follows: 50 | 51 | ```r 52 | library(shiny) 53 | library(shinysurveys) 54 | 55 | df <- data.frame(question = "What is your favorite food?", 56 | option = "Your Answer", 57 | input_type = "text", 58 | input_id = "favorite_food", 59 | dependence = NA, 60 | dependence_value = NA, 61 | required = F) 62 | 63 | ui <- fluidPage( 64 | surveyOutput(df = df, 65 | survey_title = "Hello, World!", 66 | survey_description = "Welcome! This is a demo survey showing off the {shinysurveys} package.") 67 | ) 68 | 69 | server <- function(input, output, session) { 70 | renderSurvey() 71 | 72 | observeEvent(input$submit, { 73 | showModal(modalDialog( 74 | title = "Congrats, you completed your first shinysurvey!", 75 | "You can customize what actions happen when a user finishes a survey using input$submit." 76 | )) 77 | }) 78 | } 79 | 80 | shinyApp(ui, server) 81 | ``` 82 | 83 | In the browser, this looks like: 84 | 85 | ![](https://www.jdtrat.com/project/shinysurveys/shinysurveys-final-demo.gif) 86 | 87 | ## Further Reading 88 | 89 | For a more in-depth explanation of {shinysurveys}, please see the vignette [*A survey of {shinysurveys}*](https://shinysurveys.jdtrat.com/articles/surveying-shinysurveys.html). 90 | -------------------------------------------------------------------------------- /NEWS.md: -------------------------------------------------------------------------------- 1 | # shinysurveys (development version) 2 | 3 | ## New features 4 | 5 | - Added a function `hideSurvey()` for easily hiding the survey. This may be useful for, as an example, displaying results upon submission. 6 | 7 | ## Minor improvements and fixes 8 | 9 | - Made input checks more robust for required questions -- necessary for some custom input types (#32). 10 | - Updated CSS for matrix questions to ensure their width covers the entire question container. This was a problem for some users with Google Chrome and Safari. 11 | - Fixed issue resulting in required matrix questions with instructions not working. 12 | 13 | # shinysurveys 0.2.0 14 | 15 | ## Breaking changes 16 | 17 | - Deprecated all arguments to `renderSurvey()`. Both the `df` and `theme` arguments should **only** be passed to `surveyOutput()`. A warning message appears if either argument is passed to `renderSurvey()`, though the code still works. This will truly be a breaking change in the next release of shinysurveys. 18 | 19 | ## New features 20 | 21 | ### Input Types 22 | 23 | - Created `numerInput()`, which is identical to `shiny::numericInput()` but is more flexible in the sense that it **does not** require an initial value and it allows placeholders. This is now the default for "numeric" input questions. 24 | 25 | - Created a shiny input, `radioMatrixInput()`, for matrix questions. It will return `NULL` until all possible response items have been answered, at which time a data frame with the 'question_id', 'question_type', and 'response' will be returned. 26 | 27 | - Added support for "matrix" input types using `radioMatrixInput()` for creating matrix blocks. [See the documentation for an example.](https://shinysurveys.jdtrat.com/articles/surveying-shinysurveys.html#matrix-input) 28 | 29 | - Added support for "instructions" 'input' types for use within other question types or standalone blocks. 30 | 31 | - Added support for user-defined, custom input types. These can be registered with `extendInputType()`. For more details, see my [blog post](https://www.jdtrat.com/blog/extending-shinysurveys/) or [vignette](https://shinysurveys.jdtrat.com/articles/custom-input-extensions.html). 32 | 33 | ### Miscellaneous (but exciting!) 34 | 35 | - Added support for multiple page surveys by adding a 'page' column to the data frame of questions supplied to `surveyOutput()`. The column can either have numeric `(e.g. c(1, 1, 2, 3))` or character values (`c("intro", "intro", "middle", "final")`). For more information, see my [blog post on multipaged shinysurveys](https://www.jdtrat.com/blog/multi-paged-shinysurvey/). 36 | 37 | - Added support for aggregating response data with `getSurveyData()`. This feature allows you to automatically save responses for each individual. That is, this function accounts for dependencies; it will only aggregate data from questions a participant saw. It returns a data frame with a participant's ID, question (input) ID, the question type (e.g. numeric, text, etc.) and response. For more details, see ["Aggregate Responses with getSurveyData()"](https://shinysurveys.jdtrat.com/articles/get-survey-data.html). 38 | 39 | ## Minor improvements and fixes 40 | 41 | - Fixed bug where required dependency questions prevented people from submitting the survey (since they could not "answer" hidden questions the submit button would not be enabled). 42 | 43 | - Added error messages to help with identifying common errors with creating surveys, specifically unrecognized input types. 44 | 45 | - Removed "grid" CSS container surrounding the survey div. 46 | 47 | - Changed how SASS rendered the CSS internally to improve performance. CSS rules are placed within style tags in the DOM. 48 | 49 | # shinysurveys 0.1.2 50 | 51 | ## Breaking Changes 52 | 53 | - The `renderSurvey()` function no longer takes shiny `input`, `output`, and `session`. Rather, it accesses them internally with the function `shiny::getDefaultReactiveDomain()`. Thanks to Dean Attali for the suggestion! 54 | 55 | ## Bug Fixes 56 | 57 | - Fixed survey appearance issues on smaller screens. Thanks to Paul Le Grand for the help! 58 | 59 | ## Minor Changes 60 | 61 | - Updated tests for server-side and internal functions 62 | 63 | # shinysurveys 0.1.1 64 | 65 | - Removed `dplyr`, `tidyr`, `rlang`, and `magrittr` dependencies. 66 | 67 | # shinysurveys 0.1.0 68 | 69 | ## New Features 70 | 71 | - Addition of survey titles and description as arguments for `surveyOutput()`. 72 | - Theme parameter in `renderSurvey()` 73 | 74 | ## Bug Fixes 75 | 76 | - For surveys with no required questions, error message involving unexpected `NULL` in `vec_slice_impl()` appeared. 77 | 78 | ## Minor Changes 79 | 80 | - Changed order of arguments in `renderSurvey()` to `c(df, input, output, session, theme)`. 81 | 82 | # shinysurveys 0.0.0.9000 83 | 84 | - Publish initial development version. 85 | -------------------------------------------------------------------------------- /R/utils_render-survey.R: -------------------------------------------------------------------------------- 1 | 2 | #' Check if a question is required 3 | #' 4 | #' This function is for internal use. It will check if a question in the 5 | #' user-supplied questions dataframe is required. If so, it will add the label 6 | #' with an asterisk. If not, it will just return the label. 7 | #' 8 | #' @param df One element (a dataframe) in the list of unique questions. 9 | #' 10 | #' 11 | #' @keywords internal 12 | #' @return A label with or without an asterisk to signify it is required. 13 | #' 14 | #' 15 | addRequiredUI_internal <- function(df) { 16 | 17 | if (length(base::unique(df$question)) != 1 & base::unique(df$input_type) != "matrix") { 18 | stop(paste0("The question with input ID '", df$input_id, "' has more than one question in the `question` column. Perhaps there is a spelling error?")) 19 | } 20 | 21 | if (df$required[1] == TRUE) { 22 | label <- shiny::tagList(base::unique(df$question), shiny::span("*", class = "required")) 23 | } else if (df$required[1] == FALSE) { 24 | label <- base::unique(df$question) 25 | } 26 | return(label) 27 | } 28 | 29 | #' Toggle element state 30 | #' 31 | #' Custom function for toggling enable/disable state of HTML element in {shinysurveys}. 32 | #' 33 | #' @param id Shiny object inputId 34 | #' @param condition Condition on which to enable or disable 35 | #' @keywords internal 36 | #' 37 | #' @return NA; used for side effects 38 | #' 39 | toggle_element <- function(id, condition) { 40 | 41 | if (!condition) { 42 | disable_element(.id = id) 43 | } else if (condition) { 44 | enable_element(.id = id) 45 | } 46 | 47 | } 48 | 49 | #' Show dependence questions 50 | #' 51 | #' @param input Input from server 52 | #' @param df One element (a dataframe) in the list of unique questions. 53 | #' 54 | #' 55 | #' @keywords internal 56 | #' @return NA; shows a dependence question in the UI. 57 | #' 58 | showDependence <- function(input = input, df) { 59 | 60 | # Are there any dependencies? 61 | if (any(!is.na(df$dependence_value))) { 62 | 63 | # Using the first dependence value for a question 64 | # assumes all dependence values per question are equal 65 | if (any(input[[df$dependence[1]]] == df$dependence_value[1])) { 66 | remove_class( 67 | .id = paste0(df$input_id[1], "-question"), 68 | .class = "dependence" 69 | ) 70 | df$required <- TRUE 71 | } else { 72 | add_class( 73 | .id = paste0(df$input_id[1], "-question"), 74 | .class = "dependence" 75 | ) 76 | df$required <- FALSE 77 | } 78 | } 79 | 80 | } 81 | 82 | 83 | #' Get required IDs 84 | #' 85 | #' @param df The dataframe of questions 86 | #' 87 | #' @keywords internal 88 | #' 89 | #' @return The input ID for required questions 90 | #' 91 | getID <- function(df) { 92 | if (df$required[1] == TRUE) { 93 | base::unique(df$input_id) 94 | } else { 95 | return(NA) 96 | } 97 | } 98 | 99 | 100 | #' Get a character vector of required questions 101 | #' 102 | #' @param questions The list of unique questions from \code{\link{listUniqueQuestions}}. 103 | #' 104 | #' 105 | #' @keywords internal 106 | #' @return A character vectors with the input ID of required questions. 107 | #' 108 | getRequired_internal <- function(questions) { 109 | 110 | out <- as.data.frame( 111 | do.call( 112 | rbind, 113 | lapply(questions, getID) 114 | ), 115 | stringsAsFactors = FALSE 116 | ) 117 | 118 | names(out) <- "required_id" 119 | 120 | out <- out$required_id 121 | 122 | return(out) 123 | 124 | } 125 | 126 | #' Check if individual inputs have a value 127 | #' 128 | #' @param input Input from server 129 | #' @param input_id The input_id to check 130 | #' 131 | #' 132 | #' @keywords internal 133 | #' @return TRUE if the input has a value; false otherwise. 134 | #' 135 | checkIndividual <- function(input = input, input_id) { 136 | if (!is.null(input[[input_id]]) && as.character(input[[input_id]]) != "" && !is.na(input[[input_id]])) { 137 | TRUE 138 | } else { 139 | FALSE 140 | } 141 | } 142 | 143 | #' Check all required questions have been answered 144 | #' 145 | #' @param input Input from server 146 | #' @param required_inputs_vector The output of \code{\link{getRequired_internal}}. 147 | #' 148 | #' 149 | #' @keywords internal 150 | #' 151 | #' @return TRUE if all required questions have been answered. FALSE otherwise. 152 | #' 153 | 154 | checkRequired_internal <- function(input = input, required_inputs_vector) { 155 | if (all(is.na(required_inputs_vector))) { 156 | return(TRUE) 157 | } else { 158 | required_inputs_vector <- required_inputs_vector[!is.na(required_inputs_vector)] 159 | } 160 | 161 | instructions_id <- do.call(c, lapply(survey_env$unique_questions, function(question) { 162 | if (all(question$input_type == "instructions")) unique(question$input_id) 163 | })) 164 | 165 | required_inputs_vector <- required_inputs_vector[which(!required_inputs_vector %in% c(input$shinysurveysHiddenInputs, instructions_id))] 166 | 167 | all(vapply(required_inputs_vector, checkIndividual, input = input, FUN.VALUE = logical(1), USE.NAMES = FALSE)) 168 | } 169 | 170 | -------------------------------------------------------------------------------- /.github/CODE_OF_CONDUCT.md: -------------------------------------------------------------------------------- 1 | # Contributor Covenant Code of Conduct 2 | 3 | ## Our Pledge 4 | 5 | We as members, contributors, and leaders pledge to make participation in our community a harassment-free experience for everyone, regardless of age, body size, visible or invisible disability, ethnicity, sex characteristics, gender identity and expression, level of experience, education, socio-economic status, nationality, personal appearance, race, religion, or sexual identity and orientation. 6 | 7 | We pledge to act and interact in ways that contribute to an open, welcoming, diverse, inclusive, and healthy community. 8 | 9 | ## Our Standards 10 | 11 | Examples of behavior that contributes to a positive environment for our community include: 12 | 13 | - Demonstrating empathy and kindness toward other people 14 | - Being respectful of differing opinions, viewpoints, and experiences 15 | - Giving and gracefully accepting constructive feedback 16 | - Accepting responsibility and apologizing to those affected by our mistakes, and learning from the experience 17 | - Focusing on what is best not just for us as individuals, but for the overall community 18 | 19 | Examples of unacceptable behavior include: 20 | 21 | - The use of sexualized language or imagery, and sexual attention or advances of any kind 22 | - Trolling, insulting or derogatory comments, and personal or political attacks 23 | - Public or private harassment 24 | - Publishing others' private information, such as a physical or email address, without their explicit permission 25 | - Other conduct which could reasonably be considered inappropriate in a professional setting 26 | 27 | ## Enforcement Responsibilities 28 | 29 | Community leaders are responsible for clarifying and enforcing our standards of acceptable behavior and will take appropriate and fair corrective action in response to any behavior that they deem inappropriate, threatening, offensive, or harmful. 30 | 31 | Community leaders have the right and responsibility to remove, edit, or reject comments, commits, code, wiki edits, issues, and other contributions that are not aligned to this Code of Conduct, and will communicate reasons for moderation decisions when appropriate. 32 | 33 | ## Scope 34 | 35 | This Code of Conduct applies within all community spaces, and also applies when an individual is officially representing the community in public spaces. Examples of representing our community include using an official e-mail address, posting via an official social media account, or acting as an appointed representative at an online or offline event. 36 | 37 | ## Enforcement 38 | 39 | Instances of abusive, harassing, or otherwise unacceptable behavior may be reported to the community leaders responsible for enforcement at [jdt\@jdtrat.com](mailto:jdt@jdtrat.com){.email}. All complaints will be reviewed and investigated promptly and fairly. 40 | 41 | All community leaders are obligated to respect the privacy and security of the reporter of any incident. 42 | 43 | ## Enforcement Guidelines 44 | 45 | Community leaders will follow these Community Impact Guidelines in determining the consequences for any action they deem in violation of this Code of Conduct: 46 | 47 | ### 1. Correction 48 | 49 | **Community Impact**: Use of inappropriate language or other behavior deemed unprofessional or unwelcome in the community. 50 | 51 | **Consequence**: A private, written warning from community leaders, providing clarity around the nature of the violation and an explanation of why the behavior was inappropriate. A public apology may be requested. 52 | 53 | ### 2. Warning 54 | 55 | **Community Impact**: A violation through a single incident or series of actions. 56 | 57 | **Consequence**: A warning with consequences for continued behavior. No interaction with the people involved, including unsolicited interaction with those enforcing the Code of Conduct, for a specified period of time. This includes avoiding interactions in community spaces as well as external channels like social media. Violating these terms may lead to a temporary or permanent ban. 58 | 59 | ### 3. Temporary Ban 60 | 61 | **Community Impact**: A serious violation of community standards, including sustained inappropriate behavior. 62 | 63 | **Consequence**: A temporary ban from any sort of interaction or public communication with the community for a specified period of time. No public or private interaction with the people involved, including unsolicited interaction with those enforcing the Code of Conduct, is allowed during this period. Violating these terms may lead to a permanent ban. 64 | 65 | ### 4. Permanent Ban 66 | 67 | **Community Impact**: Demonstrating a pattern of violation of community standards, including sustained inappropriate behavior, harassment of an individual, or aggression toward or disparagement of classes of individuals. 68 | 69 | **Consequence**: A permanent ban from any sort of public interaction within the community. 70 | 71 | ## Attribution 72 | 73 | This Code of Conduct is adapted from the [Contributor Covenant](https://www.contributor-covenant.org), version 2.0, available at code_of_conduct.html. 74 | 75 | Community Impact Guidelines were inspired by [Mozilla's code of conduct enforcement ladder](https://github.com/mozilla/diversity). 76 | 77 | For answers to common questions about this code of conduct, see the FAQ at . Translations are available at . 78 | -------------------------------------------------------------------------------- /R/func_get-survey-data.R: -------------------------------------------------------------------------------- 1 | #' Get survey data 2 | #' 3 | #' Get a participant's responses. 4 | #' 5 | #' @param custom_id A unique identifier for the survey's respondents. NULL by 6 | #' default, and the built-in {shinysurveys} userID will be used. 7 | #' @param include_dependencies LOGICAL: TRUE (default) and all dependency 8 | #' questions will be returned, regardless of if the individual respondent saw 9 | #' it. For respondents who did not see a specific question, the 'response' 10 | #' will take on the value from the `dependency_string` argument. If FALSE, the 11 | #' output will have variable rows depending on which questions a given 12 | #' participant answered. 13 | #' @param dependency_string A character string to be imputed for dependency 14 | #' questions that a respondent did not see. Default is "HIDDEN-QUESTION". 15 | #' 16 | #' @return A data frame with four columns containing information about the 17 | #' participant's survey responses: The 'subject_id' column can be used for 18 | #' identifying respondents. By default, it utilizes shinysurveys URL-based 19 | #' user tracking feature. The 'question_id' and 'question_type' columns 20 | #' correspond to 'input_id' and 'input_type' from the original data frame of 21 | #' questions. The 'response' column is the participant's answer. 22 | #' 23 | #' The number of rows, corresponding to the questions an individual saw, 24 | #' depends on the `include_dependencies` argument. If TRUE, by default, then 25 | #' the resulting data frame will have one row per unique input ID. If FALSE, 26 | #' the data frame may have variable length depending on which questions a 27 | #' given individual answers. 28 | #' 29 | #' @export 30 | #' 31 | #' @examples 32 | #' 33 | #' if (interactive()) { 34 | #' 35 | #' library(shiny) 36 | #' 37 | #' ui <- fluidPage( 38 | #' surveyOutput(teaching_r_questions) 39 | #' ) 40 | #' 41 | #' server <- function(input, output, session) { 42 | #' renderSurvey() 43 | #' # Upon submission, print a data frame with participant responses 44 | #' observeEvent(input$submit, { 45 | #' print(getSurveyData()) 46 | #' }) 47 | #' } 48 | #' 49 | #' shinyApp(ui, server) 50 | #' 51 | #' } 52 | #' 53 | getSurveyData <- function(custom_id = NULL, include_dependencies = TRUE, dependency_string = "HIDDEN-QUESTION") { 54 | 55 | session <- shiny::getDefaultReactiveDomain() 56 | 57 | # get id of instructions input types to exclude from survey response collection 58 | instructions_id <- survey_env$question_df[which(survey_env$question_df$input_type == "instructions"), "input_id", drop = FALSE]$input_id 59 | shown_questions <- unique(survey_env$question_df$input_id[which(!survey_env$question_df$input_id %in% instructions_id)]) 60 | 61 | for (i in seq_along(survey_env$unique_questions)) { 62 | survey_env$unique_questions[[i]]$question_number <- rep(i, nrow(survey_env$unique_questions[[i]])) 63 | } 64 | 65 | survey_env$ordered_question_df <- do.call(rbind, survey_env$unique_questions) 66 | 67 | shown_subset <- survey_env$ordered_question_df[which(survey_env$ordered_question_df$input_id %in% shown_questions),] 68 | shown_input_types <- do.call(rbind, 69 | lapply( 70 | split(shown_subset, factor(shown_subset$input_id, levels = unique(shown_subset$input_id))), 71 | function(x) x[1,"input_type", drop = FALSE]$input_type) 72 | ) 73 | 74 | responses <- do.call(rbind, 75 | lapply( 76 | shown_questions, function(x) { 77 | data.frame(response = check_length(.input = session$input[[x]])) 78 | } 79 | )) 80 | 81 | output <- make_survey_response_df(.question_id = shown_questions, 82 | .question_type = shown_input_types, 83 | .response = responses) 84 | 85 | if ("matrix" %in% survey_env$ordered_question_df$input_type) { 86 | 87 | matrix_ids <- unique(survey_env$ordered_question_df[which(survey_env$ordered_question_df$input_type == "matrix"), "input_id"])$input_id 88 | 89 | matrix_responses <- do.call(rbind, 90 | lapply( 91 | matrix_ids, function(x) session$input[[x]] 92 | ) 93 | ) 94 | output <- rbind(output, matrix_responses) 95 | rownames(output) <- NULL 96 | 97 | bounded <- survey_env$ordered_question_df 98 | bounded[which(bounded$input_type == "matrix"), "input_id"] <- bounded[which(bounded$input_type == "matrix"), "question"] 99 | bounded[which(bounded$input_type == "matrix"),"input_id"] <- vapply(X = bounded[which(bounded$input_type == "matrix"), "input_id"]$input_id, FUN = function(x) { 100 | create_radio_input_id(x)}, FUN.VALUE = character(1), USE.NAMES = FALSE) 101 | bounded <- bounded[,c("input_id", "input_type", "question_number")] 102 | names(bounded) <- c("question_id", "question_type", "question_number") 103 | 104 | output <- merge(output, bounded) 105 | output <- output[order(output$question_number), ] 106 | output <- output[,-4] 107 | 108 | } 109 | 110 | if (!is.null(custom_id)) { 111 | output <- cbind(subject_id = custom_id, 112 | output) 113 | } else if (is.null(custom_id)) { 114 | output <- cbind(subject_id = session$input$userID, 115 | output) 116 | } 117 | 118 | output <- split(output, factor(output$question_id, levels = unique(output$question_id))) 119 | output <- do.call(rbind, lapply( 120 | output, function(x) x[1,] 121 | )) 122 | rownames(output) <- NULL 123 | 124 | if (include_dependencies) { 125 | output[which(output$question_id %in% session$input$shinysurveysHiddenInputs), "response"] <- dependency_string 126 | } else if (!include_dependencies) { 127 | output <- output[which(!output$question_id %in% session$input$shinysurveysHiddenInputs),] 128 | } 129 | 130 | return(output) 131 | 132 | } 133 | 134 | -------------------------------------------------------------------------------- /R/input_radioMatrixInput.R: -------------------------------------------------------------------------------- 1 | 2 | #' Create the actual radio button inputs 3 | #' 4 | #' @param inputId This is the ID for the question to which the radio button 5 | #' inputs correspond 6 | #' @param choices The choices (values) for each radio button to indicate 7 | #' @param selected A default selected value 8 | #' 9 | #' @return radio button input UI 10 | #' @keywords internal 11 | #' 12 | radioMatrixButtons <- function (inputId, choices, selected = NULL) { 13 | 14 | options <- lapply(choices, FUN = function(value) { 15 | 16 | inputTag <- shiny::tags$td(shiny::tags$input(type = "radio", name = inputId, value = value)) 17 | 18 | if (value %in% selected) { 19 | inputTag$attribs$checked <- "checked" 20 | } 21 | 22 | inputTag 23 | }) 24 | options 25 | } 26 | 27 | #' Create radio input ID 28 | #' 29 | #' @param .responseItem 30 | #' 31 | #' @return The response item title in a form appropriate for HTML IDs (and tidy data) 32 | #' @keywords internal 33 | #' 34 | create_radio_input_id <- function(.responseItem) { 35 | gsub(" ", "_", gsub("[\\'[:punct:]]", "", tolower(.responseItem), perl = FALSE)) 36 | } 37 | 38 | 39 | 40 | #' Create the radio matrix input's header 41 | #' 42 | #' @param .choices Possible choices 43 | #' @param .required Logical: TRUE/FALSE should a required asterisk be placed on the matrix question 44 | #' 45 | #' @return Header for the table (matrix input) 46 | #' @keywords internal 47 | #' 48 | radioMatHeader <- function(.choices, .required) { 49 | 50 | if (.required) { 51 | required_placeholder <- shiny::tags$th(class = "required", "*", style = "font-size: 18px;") 52 | } else { 53 | required_placeholder <- shiny::tags$th() 54 | } 55 | 56 | shiny::tags$tr( 57 | required_placeholder, 58 | lapply(X = .choices, function(choice) { 59 | shiny::tags$th(choice) 60 | }) 61 | ) 62 | } 63 | 64 | 65 | #' Create the table body 66 | #' 67 | #' @param .responseItems Questions to be asked (row labels) 68 | #' @param .choices Possible choices (values for radio buttons) 69 | #' @param .selected Initial selected value 70 | #' 71 | #' @return UI for the matrix input (table) body 72 | #' @keywords internal 73 | #' 74 | radioBody <- function(.responseItems, .choices, .selected = NULL) { 75 | 76 | shiny::tags$tbody( 77 | lapply( 78 | X = .responseItems, function(item, choice, select) { 79 | shiny::tags$tr(class = "radio-matrix-buttons", 80 | id = paste0("tr-", create_radio_input_id(item)), 81 | shiny::tags$td(class = "radio-matrix-buttons-label", 82 | id = paste0("td-", create_radio_input_id(item)), 83 | item 84 | ), 85 | radioMatrixButtons(inputId = create_radio_input_id(item), 86 | choices = choice, 87 | selected = select) 88 | ) 89 | }, 90 | choice = .choices, 91 | select = .selected 92 | ) 93 | ) 94 | } 95 | 96 | #' Create a matrix of radio buttons. 97 | #' 98 | #' @param inputId The input id 99 | #' @param responseItems The questions to be asked (row labels) 100 | #' @param choices Possible choices (column labels) 101 | #' @param selected Initial selected value 102 | #' @param ... Additional arguments specific to {shinysurveys} required questions. 103 | #' 104 | #' @return A matrix of radio buttons that can be added to a UI definition. When 105 | #' run in a Shiny application, this will return \code{NULL} until all possible 106 | #' response items have been answered, at which time a data frame with the 107 | #' question_id, question_type, and response, the format used in 108 | #' \code{\link{getSurveyData}}. 109 | #' 110 | #' @export 111 | #' 112 | #' @examples 113 | #' # For use as a normal Shiny input: 114 | #' 115 | #' if (interactive()) { 116 | #' 117 | #' library(shiny) 118 | #' 119 | #' ui <- fluidPage( 120 | #' radioMatrixInput("matInput", 121 | #' responseItems = c("Love sushi?", "Love chocolate?"), 122 | #' choices = c("Disagree", "Neutral", "Agree")) 123 | #' ) 124 | #' 125 | #' server <- function(input, output, session) { 126 | #' observe({ 127 | #' print(input$matInput) 128 | #' }) 129 | #' } 130 | #' 131 | #' shinyApp(ui, server) 132 | #' 133 | #' } 134 | #' 135 | #' # For use in {shinysurveys} 136 | #' 137 | #' if (interactive()) { 138 | #' 139 | #' df <- data.frame( 140 | #' question = c(rep("I love sushi.", 3), rep("I love chocolate.",3), 141 | #' "What's your favorite food?", rep("Goat cheese is the GOAT.", 5), 142 | #' rep("Yogurt and berries are a great snack.",5), 143 | #' rep("SunButter® is a fantastic alternative to peanut butter.", 5)), 144 | #' option = c(rep(c("Disagree", "Neutral", "Agree"), 2), "text", 145 | #' rep(c("Strongly Disagree", "Disagree", "Neutral", "Agree", "Strongly Agree"), 3)), 146 | #' input_type = c(rep("matrix", 6), "text", rep("matrix", 15)), 147 | #' # For matrix questions, the IDs should be the same for each question 148 | #' # but different for each matrix input unit 149 | #' input_id = c(rep("matId", 6), "favorite_food", rep("matId2", 15)), 150 | #' dependence = NA, 151 | #' dependence_value = NA, 152 | #' required = FALSE 153 | #' ) 154 | #' 155 | #' library(shiny) 156 | #' 157 | #' ui <- fluidPage( 158 | #' surveyOutput(df) 159 | #' ) 160 | #' 161 | #' server <- function(input, output, session) { 162 | #' renderSurvey() 163 | #' observe({ 164 | #' print(input$matId) 165 | #' print(input$favorite_food) 166 | #' print(input$matId2) 167 | #' }) 168 | #' } 169 | #' 170 | #' shinyApp(ui, server) 171 | #' 172 | #' } 173 | #' 174 | radioMatrixInput <- function(inputId, responseItems, choices, selected = NULL, ...) { 175 | shiny::tagList( 176 | htmltools::htmlDependency( 177 | name = "radioMatrixInput", 178 | version = utils::packageVersion("shinysurveys"), 179 | package = "shinysurveys", 180 | src = "radioMatrixInput", 181 | script = "js/radioMatrixInput.js", 182 | stylesheet = "css/radioMatrixInput.css" 183 | ), 184 | shiny::div(class = "radioMatrixInput", 185 | id = inputId, 186 | shiny::tags$table( 187 | radioMatHeader(.choices = choices, ...), 188 | radioBody(.responseItems = responseItems, 189 | .choices = choices, 190 | .selected = selected) 191 | ) 192 | ) 193 | ) 194 | } 195 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # shinysurveys 2 | 3 | #### Easily Create and Deploy Surveys in Shiny 4 | 5 | 6 | 7 | [![R-CMD-check](https://github.com/jdtrat/shinysurveys/workflows/R-CMD-check/badge.svg)](https://github.com/jdtrat/shinysurveys/actions) [![CRAN status](https://www.r-pkg.org/badges/version/shinysurveys)](https://CRAN.R-project.org/package=shinysurveys) 8 | 9 | 10 | 11 | ------------------------------------------------------------------------ 12 | 13 | 14 | 15 | {shinysurveys} provides easy-to-use, minimalistic code for creating and deploying surveys in Shiny. Originally inspired by Dean Attali's [shinyforms](https://github.com/daattali/shinyforms), our package provides a framework for robust surveys, similar to Google Forms, in R with [Shiny](https://github.com/rstudio/shiny/). 16 | 17 | ## Table of contents 18 | 19 | - [Installation](#installation) 20 | - [Demos](#demos) 21 | - [Getting Started](#getting-started) 22 | - [Advanced Surveys](#advanced-surveys) 23 | - [Further Reading](#further-reading) 24 | - [Feedback](#feedback) 25 | - [Code of Conduct](#code-of-conduct) 26 | 27 | ------------------------------------------------------------------------ 28 | 29 | ## Installation 30 | 31 | You can install {shinysurveys} via CRAN or GitHub and load it as follows: 32 | 33 | ```r 34 | # Install released version from CRAN 35 | install.packages("shinysurveys") 36 | 37 | # Or, install the development version from GitHub 38 | remotes::install_github("jdtrat/shinysurveys") 39 | 40 | # Load package 41 | library(shinysurveys) 42 | ``` 43 | 44 | ## Demos 45 | 46 | A survey made with our package might look like this: 47 | 48 | ![](https://www.jdtrat.com/project/shinysurveys/shinysurveys-final-demo.gif) 49 | 50 | You can run a demo survey with the function `shinysurveys::demo_survey()`. 51 | 52 | ## Getting Started 53 | 54 | Aside from `demo_survey()`, {shinysurveys} exports two functions: `surveyOutput()` and `renderSurvey()`. The former goes in the UI portion of a Shiny app, and the latter goes in the server portion. To create a survey, you can build a data frame with your questions. The following columns are required. 55 | 56 | - *question*: The question to be asked. 57 | - *option*: A possible response to the question. In multiple choice questions, for example, this would be the possible answers. For questions without discrete answers, such as a numeric input, this would be the default option shown on the input. For text inputs, it is the placeholder value. 58 | - *input_type*: What type of response is expected? Currently supported types include `numeric`, `mc` for multiple choice, `text`, `select`, and `y/n` for yes/no questions. 59 | - *input_id*: The id for Shiny inputs. 60 | - *dependence*: Does this question (row) depend on another? That is, should it only appear if a different question has a specific value? This column contains the input_id of whatever question this one depends upon. 61 | - *dependence_value*: This column contains the specific value that the dependence question must take for this question (row) to be shown. 62 | - *required*: logical TRUE/FALSE signifying if a question is required. Surveys can only be submitted when all required questions are answered. 63 | 64 | Our demo survey can be created as follows: 65 | 66 | ```r 67 | library(shiny) 68 | library(shinysurveys) 69 | 70 | df <- data.frame(question = "What is your favorite food?", 71 | option = "Your Answer", 72 | input_type = "text", 73 | input_id = "favorite_food", 74 | dependence = NA, 75 | dependence_value = NA, 76 | required = F) 77 | 78 | ui <- fluidPage( 79 | surveyOutput(df = df, 80 | survey_title = "Hello, World!", 81 | survey_description = "Welcome! This is a demo survey showing off the {shinysurveys} package.") 82 | ) 83 | 84 | server <- function(input, output, session) { 85 | renderSurvey() 86 | 87 | observeEvent(input$submit, { 88 | showModal(modalDialog( 89 | title = "Congrats, you completed your first shinysurvey!", 90 | "You can customize what actions happen when a user finishes a survey using input$submit." 91 | )) 92 | }) 93 | } 94 | 95 | shinyApp(ui, server) 96 | ``` 97 | 98 | ## Advanced Surveys 99 | 100 | - **Dependencies** can be added so a specific question will appear based on a participant's answer to preceding questions. The `dependence` column takes an input_id of a preceding question and, if the participant answers with the value in `dependence_value`, the new question will be shown. 101 | 102 | - **Required questions** can be specified by adding the value `TRUE` to the `required` column. If a required question is not answered, the user will not be able to submit their responses. 103 | 104 | - **URL-based user tracking** functionality lets you keep track of participants easily and systematically. If you deploy your survey on [shinyapps.io](https://www.shinyapps.io/), or run it locally in a browser, you can add a URL parameter after the backslash as follows: `?user_id=UNIQUE_ID`. A live demo can be found here: https://jdtrat-apps.shinyapps.io/shinysurveys_user_tracking/?user_id=hadley 105 | 106 | - **Multi-paged surveys** can be used to better organize questions and make it easier for people to complete. As of v0.2.0., users can add an additional column page to the data frame of questions. The column can either have numeric (e.g. `c(1, 1, 2, 3`) or character (`c("intro", "intro", "middle", "final")`) values. For more documentation, see my [blog post](https://www.jdtrat.com/blog/multi-paged-shinysurvey/). 107 | 108 | - **Automatic response aggregation** to easily gather participant's data upon submission with `getSurveyData()`. See the [official vignette](https://shinysurveys.jdtrat.com/articles/get-survey-data.html) for more details. 109 | 110 | ## Further Reading 111 | 112 | For a more in-depth explanation of {shinysurveys}, please see the vignette [*A survey of {shinysurveys}*](https://shinysurveys.jdtrat.com/articles/surveying-shinysurveys.html). 113 | 114 | ## Feedback 115 | 116 | If you want to see a feature, or report a bug, please [file an issue](https://github.com/jdtrat/shinysurveys/issues) or open a [pull-request](https://github.com/jdtrat/shinysurveys/pulls)! As this package is just getting off the ground, we welcome all feedback and contributions. See our [contribution guidelines](https://github.com/jdtrat/shinysurveys/blob/main/.github/CONTRIBUTING.md) for more details on getting involved! 117 | 118 | ## Code of Conduct 119 | 120 | Please note that the shinysurveys project is released with a [Contributor Code of Conduct](https://contributor-covenant.org/version/2/0/CODE_OF_CONDUCT.html). By contributing to this project, you agree to abide by its terms. 121 | -------------------------------------------------------------------------------- /vignettes/custom-input-extensions.Rmd: -------------------------------------------------------------------------------- 1 | --- 2 | title: "Extending shinysurveys with Custom Input Types" 3 | output: rmarkdown::html_vignette 4 | vignette: > 5 | %\VignetteIndexEntry{Extending shinysurveys with Custom Input Types} 6 | %\VignetteEngine{knitr::rmarkdown} 7 | %\VignetteEncoding{UTF-8} 8 | --- 9 | 10 | ```{r, include = FALSE} 11 | knitr::opts_chunk$set( 12 | collapse = TRUE, 13 | comment = "#>" 14 | ) 15 | library(shinysurveys) 16 | library(tibble) 17 | ``` 18 | 19 | > Note: This is a pared down version of an article originally posted on [my personal blog](https://www.jdtrat.com/blog/extending-shinysurveys/). I plan to update documentation there more regularly than in the vignettes. 20 | 21 | # Motivation 22 | 23 | The original idea for {shinysurveys} was to provide a select set of 24 | well-supported input types that are commonly used with surveys. However, 25 | shortly after the package was published on CRAN, additional input types 26 | were requested (see GitHub [issue 27 | \#6](https://github.com/jdtrat/shinysurveys/issues/6) or 28 | [\#18](https://github.com/jdtrat/shinysurveys/issues/18)). 29 | 30 | In order to make the package as light-weight as possible (minimize 31 | dependence on external code), I did not wish to implement any input 32 | types not native to {shiny}. I also did not want to rewrite the 33 | internals of {shinysurveys} whenever a new input-type was requested. As 34 | a solution, I developed a framework for custom inputs to allow users to 35 | include different input types that meet their use case. In the next 36 | section, I outline two examples of how to add custom input types. 37 | 38 | # Examples 39 | 40 | ## Adding a `sliderInput` 41 | 42 | Consider the question "On a scale from 1-10, how much do you love 43 | sushi?". An ideal input type would be {shiny}'s `sliderInput`. However, 44 | this is not natively supported by {shinysurveys} as the slider input 45 | requires multiple arguments, including a minimum, maximum, and starting 46 | value. To get around this, we can define a new input type using a new 47 | function `extendInputType()`. As in a typical shiny survey, we can 48 | define our question as follows: 49 | 50 | ```{r define-question} 51 | # Define a question as normal with the `input_type` set to "slider", which is not natively supported by {shinysurveys}. 52 | 53 | slider_question <- data.frame( 54 | question = "On a scale from 1-10, how much do you love sushi?", 55 | option = NA, 56 | input_type = "slider", 57 | input_id = "sushi_scale", 58 | dependence = NA, 59 | dependence_value = NA, 60 | required = TRUE 61 | ) 62 | ``` 63 | 64 | This looks like: 65 | 66 | ```{r echo = FALSE} 67 | slider_question 68 | ``` 69 | 70 | If we try to define the user-interface component of the shiny 71 | application, we will get the following error which most commonly occurs 72 | when {shinysurveys} doesn't recognize an input type. 73 | 74 | ```{r demo-slider-without-extension, error = TRUE} 75 | library(shiny) 76 | library(shinysurveys) 77 | 78 | ui <- fluidPage( 79 | surveyOutput(df = slider_question, 80 | survey_title = "Testing the Slider Input") 81 | ) 82 | 83 | ``` 84 | 85 | To overcome this, we can use `extendInputType()`. This function accepts 86 | two arguments. The first, `input_type`, is a string of the input type 87 | used in the questions data frame. The second is the input definition. 88 | Consider: 89 | 90 | ```{r extend-input-type-slider} 91 | 92 | # Register a slider input to {shinysurveys} with a custom minimum and maximum value. 93 | 94 | extendInputType(input_type = "slider", { 95 | shiny::sliderInput( 96 | inputId = surveyID(), 97 | label = surveyLabel(), 98 | min = 1, 99 | max = 10, 100 | value = 5 101 | ) 102 | }) 103 | 104 | ``` 105 | 106 | Note the inputId and label are set to `surveyID()` and `surveyLabel()`, 107 | respectively. These are necessary helper functions to ensure that survey 108 | features such as required questions function properly. As such, **all 109 | extensions need `inputId = surveyID()` and `label = surveyLabel()`.** 110 | 111 | Now, when we try to define the user-interface, we don't see any errors: 112 | 113 | ```{r demo-slider-input} 114 | 115 | # By defining the input type above, this works! Yay! 116 | ui <- fluidPage( 117 | surveyOutput(df = slider_question, 118 | survey_title = "Testing the Slider Input") 119 | ) 120 | 121 | ``` 122 | 123 | When running the full application, we see the following survey: 124 | 125 | ![](graphics/custom-input-extensions/slider_input.png) 126 | 127 | ## Adding a `dateInput` 128 | 129 | As requested in issue 130 | [\#18](https://github.com/jdtrat/shinysurveys/issues/18), a user needed 131 | a `dateInput` with special restrictions for possible values (dates). 132 | [The user's 133 | reprex](https://github.com/jdtrat/shinysurveys/issues/18#issue-856073749) 134 | showed the error we saw earlier, because {shinysurveys} does not 135 | natively support "date" inputs. Consider again the following question: 136 | 137 | ```{r define-date-question} 138 | 139 | # Define a question as normal with the `input_type` set to "date", which is not natively supported by {shinysurveys}. 140 | date_question <- data.frame( 141 | question = "When do you graduate?", 142 | option = NA, 143 | input_type = "date", 144 | input_id = "grad_date", 145 | dependence = NA, 146 | dependence_value = NA, 147 | required = FALSE 148 | ) 149 | ``` 150 | 151 | This looks like: 152 | 153 | ```{r echo = FALSE} 154 | date_question 155 | ``` 156 | 157 | As in the slider example, if we try to define the user-interface 158 | component of the shiny application, we will get the following error 159 | which most commonly occurs when {shinysurveys} doesn't recognize an 160 | input type. 161 | 162 | ```{r demo-date-without-extension, error = TRUE} 163 | library(shiny) 164 | library(shinysurveys) 165 | 166 | ui <- fluidPage( 167 | surveyOutput(df = date_question, 168 | survey_title = "Testing the Date Input") 169 | ) 170 | 171 | ``` 172 | 173 | Using `extendInputType()` we can overcome this. 174 | 175 | ```{r extend-input-type-date} 176 | 177 | # Register a date input to {shinysurveys}, limiting possible dates to a twenty-day period. 178 | 179 | extendInputType("date", { 180 | shiny::dateInput( 181 | inputId = surveyID(), 182 | value = Sys.Date(), 183 | label = surveyLabel(), 184 | min = Sys.Date()-10, 185 | max = Sys.Date()+10 186 | ) 187 | }) 188 | 189 | ``` 190 | 191 | Now, when we try to define the user-interface, we don't see any errors: 192 | 193 | ```{r demo-date-input} 194 | 195 | # By defining the input type above, this works! Yay! 196 | ui <- fluidPage( 197 | surveyOutput(df = date_question, 198 | survey_title = "Testing the Date Input") 199 | ) 200 | 201 | ``` 202 | 203 | When running the full application, we see the following survey: 204 | 205 | ![](graphics/custom-input-extensions/date_input.png) 206 | -------------------------------------------------------------------------------- /R/func_extend-shinysurveys.R: -------------------------------------------------------------------------------- 1 | #' Add correct ID for custom input types 2 | #' 3 | #' `surveyID()` is a helper function for \code{\link{extendInputType}}. When 4 | #' defining custom input types, the `inputId` argument for shiny UI components 5 | #' should equal `surveyID()`. See examples for more details. 6 | #' 7 | #' @seealso \code{\link{extendInputType}} 8 | #' @seealso \code{\link{surveyLabel}} 9 | #' @seealso \code{\link{surveyOptions}} 10 | #' @return NA; used for side effects with \code{\link{extendInputType}}. 11 | #' @export 12 | #' 13 | #' @examples 14 | #' 15 | #' extendInputType("slider", { 16 | #' shiny::sliderInput( 17 | #' inputId = surveyID(), 18 | #' label = surveyLabel(), 19 | #' min = 1, 20 | #' max = 10, 21 | #' value = 5 22 | #' ) 23 | #' }) 24 | #' 25 | surveyID <- function() { 26 | unique(survey_env$current_question$input_id) 27 | } 28 | 29 | #' Add correct label for custom input types 30 | #' 31 | #' `surveyLabel()` is a helper function for \code{\link{extendInputType}}. When 32 | #' defining custom input types, the `label` argument for shiny UI components 33 | #' should equal `surveyLabel()`. It essentially takes on the value in the 34 | #' "question" column in the data supplied to \code{\link{surveyOutput}}. See 35 | #' examples for more details. 36 | #' 37 | #' @seealso \code{\link{extendInputType}} 38 | #' @seealso \code{\link{surveyID}} 39 | #' @seealso \code{\link{surveyOptions}} 40 | #' @return NA; used for side effects with \code{\link{extendInputType}}. 41 | #' @export 42 | #' 43 | #' @examples 44 | #' 45 | #' extendInputType("slider", { 46 | #' shiny::sliderInput( 47 | #' inputId = surveyID(), 48 | #' label = surveyLabel(), 49 | #' min = 1, 50 | #' max = 10, 51 | #' value = 5 52 | #' ) 53 | #' }) 54 | #' 55 | surveyLabel <- function() { 56 | addRequiredUI_internal(survey_env$current_question) 57 | } 58 | 59 | #' Add options for custom input types 60 | #' 61 | #' `surveyOptions()` is a helper function for \code{\link{extendInputType}}. When 62 | #' defining custom input types, the choices arguments for shiny UI components 63 | #' should equal `surveyOption()`. See examples for more details. 64 | #' 65 | #' @seealso \code{\link{extendInputType}} 66 | #' @seealso \code{\link{surveyID}} 67 | #' @seealso \code{\link{surveyOptions}} 68 | #' @return NA; used for side effects with \code{\link{extendInputType}}. 69 | #' @export 70 | #' 71 | #' @examples 72 | #' 73 | #' extendInputType("inlineRadioButtons", { 74 | #' shiny::radioButtons( 75 | #' inputId = surveyID(), 76 | #' label = surveyLabel(), 77 | #' selected = character(0), 78 | #' choices = surveyOptions(), 79 | #' inline = TRUE 80 | #' ) 81 | #' }) 82 | #' 83 | surveyOptions <- function() { 84 | survey_env$current_question$option 85 | } 86 | 87 | #' Add Custom Input Types for a Survey 88 | #' 89 | #' @param input_type A string of the input type supplied in the data frame of questions. 90 | #' @param extension A shiny input type not natively supported by {shinysurveys}. See the examples section for more information. 91 | #' 92 | #' @return NA; used to register custom input types for use with a shiny survey. 93 | #' @export 94 | #' 95 | #' @seealso \code{\link{surveyID}} 96 | #' @seealso \code{\link{surveyLabel}} 97 | #' @examples 98 | #' 99 | #' # Register a slider input to {shinysurveys} with a custom minimum and maximum value. 100 | #' 101 | #' extendInputType("slider", { 102 | #' shiny::sliderInput( 103 | #' inputId = surveyID(), 104 | #' label = surveyLabel(), 105 | #' min = 1, 106 | #' max = 10, 107 | #' value = 5 108 | #' ) 109 | #' }) 110 | #' 111 | #' # Define a question as normal with the `input_type` set to the custom slider type defined above. 112 | #' slider_question <- data.frame(question = "On a scale from 1-10, 113 | #' how much do you love sushi?", 114 | #' option = NA, 115 | #' input_type = "slider", 116 | #' input_id = "sushi_scale", 117 | #' dependence = NA, 118 | #' dependence_value = NA, 119 | #' required = TRUE) 120 | #' 121 | #' # Watch it in action 122 | #' if (interactive()) { 123 | #' ui <- fluidPage( 124 | #' surveyOutput(df = slider_question, "Sushi Scale Example") 125 | #' ) 126 | #' 127 | #' server <- function(input, output, session) { 128 | #' renderSurvey() 129 | #' } 130 | #' 131 | #' shinyApp(ui, server) 132 | #' 133 | #' } 134 | #' 135 | #' 136 | #' 137 | #' # Register a date input to {shinysurveys}, 138 | #' # limiting possible dates to a twenty-day period. 139 | #' 140 | #' extendInputType("date", { 141 | #' shiny::dateInput( 142 | #' inputId = surveyID(), 143 | #' value = Sys.Date(), 144 | #' label = surveyLabel(), 145 | #' min = Sys.Date()-10, 146 | #' max = Sys.Date()+10 147 | #' ) 148 | #' }) 149 | #' 150 | #' # Define a question as normal with the `input_type` set to 151 | #' # the custom date type defined above. 152 | #' 153 | #' date_question <- data.frame(question = "When do you graduate?", 154 | #' option = NA, 155 | #' input_type = "date", 156 | #' input_id = "grad_date", 157 | #' dependence = NA, 158 | #' dependence_value = NA, 159 | #' required = FALSE) 160 | #' 161 | #' # Watch it in action 162 | #' if (interactive()) { 163 | #' ui <- fluidPage( 164 | #' surveyOutput(df = date_question, "Date Input Extension Example") 165 | #' ) 166 | #' 167 | #' server <- function(input, output, session) { 168 | #' renderSurvey() 169 | #' } 170 | #' 171 | #' shinyApp(ui, server) 172 | #' } 173 | #' 174 | #' 175 | #' # Combine both custom input types: 176 | #' 177 | #' if (interactive()) { 178 | #' ui <- fluidPage( 179 | #' surveyOutput(df = rbind(slider_question, date_question), 180 | #' "Date & Slider Input Extension Example") 181 | #' ) 182 | #' 183 | #' server <- function(input, output, session) { 184 | #' renderSurvey() 185 | #' } 186 | #' 187 | #' shinyApp(ui, server) 188 | #' } 189 | #' 190 | #' 191 | 192 | extendInputType <- function(input_type, extension) { 193 | 194 | if (!input_type %in% survey_env$input_type) { 195 | survey_env$input_type <- c(survey_env$input_type, input_type) 196 | survey_env$input_extension <- c(survey_env$input_extension, list(ext = substitute(extension))) 197 | names(survey_env$input_extension)[which(names(survey_env$input_extension) == "ext")] <- input_type 198 | } else if (input_type %in% survey_env$input_type) { 199 | survey_env$input_extension[[input_type]] <- substitute(extension) 200 | } 201 | 202 | message(paste0("Input Type \"", input_type,"\" registered with {shinysurveys}. If the session restarts, you will need to re-register it.\n", 203 | "To see all registered input extensions, please call `shinysurveys::listInputExtensions()`.")) 204 | } 205 | 206 | #' List all registered survey extensions 207 | #' 208 | #' @return A named list containing the registered input type and their associated functions. 209 | #' @export 210 | #' 211 | #' @examples 212 | #' 213 | #' if (interactive()) { 214 | #' 215 | #' # Register a date input to {shinysurveys}, 216 | #' # limiting possible dates to a twenty-day period. 217 | #' 218 | #' extendInputType("slider", { 219 | #' shiny::sliderInput( 220 | #' inputId = surveyID(), 221 | #' label = surveyLabel(), 222 | #' min = 1, 223 | #' max = 10, 224 | #' value = 5 225 | #' ) 226 | #' }) 227 | #' 228 | #' # Register a slider input to {shinysurveys} 229 | #' # with a custom minimum and maximum value. 230 | #' 231 | #' extendInputType("date", { 232 | #' shiny::dateInput( 233 | #' inputId = surveyID(), 234 | #' value = Sys.Date(), 235 | #' label = surveyLabel(), 236 | #' min = Sys.Date()-10, 237 | #' max = Sys.Date()+10 238 | #' ) 239 | #' }) 240 | #' 241 | #' listInputExtensions() 242 | #' 243 | #' } 244 | #' 245 | listInputExtensions <- function() { 246 | survey_env$input_extension 247 | } 248 | 249 | -------------------------------------------------------------------------------- /tests/testthat/test-surveyOutput-paged_questions.R: -------------------------------------------------------------------------------- 1 | 2 | paged_teaching_r_questions <- data.frame( 3 | stringsAsFactors = FALSE, 4 | question = c("What's your age?", 5 | "Which best describes your gender?", 6 | "Which best describes your gender?","Which best describes your gender?", 7 | "Which best describes your gender?", 8 | "Which best describes your gender?", 9 | "What is the highest level of education you have attained?", 10 | "What is the highest level of education you have attained?", 11 | "What is the highest level of education you have attained?", 12 | "What is the highest level of education you have attained?", 13 | "What is the highest level of education you have attained?", 14 | "What is the highest level of education you have attained?", 15 | "What was your first language?","What was your first language?", 16 | "What was your first language?","What was your first language?", 17 | "What was your first language?","What was your first language?", 18 | "What was your first language?", 19 | "What was your first language?","What was your first language?", 20 | "What was your first language?","What was your first language?", 21 | "What was your first language?","What was your first language?", 22 | "What was your first language?", 23 | "What was your first language?","In what language do you read most often?", 24 | "In what language do you read most often?", 25 | "In what language do you read most often?", 26 | "In what language do you read most often?","In what language do you read most often?", 27 | "In what language do you read most often?", 28 | "In what language do you read most often?", 29 | "In what language do you read most often?", 30 | "In what language do you read most often?","In what language do you read most often?", 31 | "In what language do you read most often?", 32 | "In what language do you read most often?", 33 | "In what language do you read most often?","In what language do you read most often?", 34 | "In what language do you read most often?", 35 | "Have you ever learned to program in R?", 36 | "Have you ever learned to program in R?", 37 | "If yes, how many years have you been using R?", 38 | "Have you ever learned a programming language (other than R)?", 39 | "Have you ever learned a programming language (other than R)?", 40 | "If yes, which language(s) and how many years have you been using each language?", 41 | "Have you ever completed a data analysis?", 42 | "Have you ever completed a data analysis?", 43 | "If yes, approximately how many data analyses have you completed?", 44 | "If yes, approximately how many data analyses have you completed?", 45 | "If yes, approximately how many data analyses have you completed?", 46 | "If yes, approximately how many data analyses have you completed?"), 47 | option = c("25","Female","Male", 48 | "Prefer not to say","Prefer to self describe",NA, 49 | "Did not attend high school","Some high school", 50 | "High school graduate","Some college","College","Graduate Work","Arabic", 51 | "Armenian","Chinese","English","French","Creole", 52 | "German","Greek","Gujarati","Hebrew","Hindi", 53 | "Italian","Japanese","Other",NA,"Arabic","Armenian", 54 | "Chinese","English","French","Creole","German","Greek", 55 | "Gujarati","Hebrew","Hindi","Italian","Japanese", 56 | "Other",NA,"Yes","No","5","Yes","No",NA,"Yes","No", 57 | "0 to 5","5 to 10","10 to 15","15+"), 58 | input_type = c("numeric","mc","mc","mc", 59 | "mc","text","select","select","select","select", 60 | "select","select","select","select","select","select", 61 | "select","select","select","select","select","select", 62 | "select","select","select","select","text","select", 63 | "select","select","select","select","select", 64 | "select","select","select","select","select","select", 65 | "select","select","text","y/n","y/n","numeric","y/n", 66 | "y/n","text","y/n","y/n","mc","mc","mc","mc"), 67 | input_id = c("age","gender","gender", 68 | "gender","gender","self_describe_gender", 69 | "education_attained","education_attained","education_attained", 70 | "education_attained","education_attained","education_attained", 71 | "first_language","first_language","first_language", 72 | "first_language","first_language","first_language", 73 | "first_language","first_language","first_language", 74 | "first_language","first_language","first_language", 75 | "first_language","first_language","first_language_other", 76 | "read_language","read_language","read_language", 77 | "read_language","read_language","read_language","read_language", 78 | "read_language","read_language","read_language", 79 | "read_language","read_language","read_language","read_language", 80 | "read_language_other","learned_r","learned_r", 81 | "years_using_r","learned_programming_not_r", 82 | "learned_programming_not_r","years_programming_not_r", 83 | "completed_data_analysis","completed_data_analysis", 84 | "number_completed_data_analysis","number_completed_data_analysis", 85 | "number_completed_data_analysis","number_completed_data_analysis"), 86 | dependence = c(NA,NA,NA,NA,NA,"gender", 87 | NA,NA,NA,NA,NA,NA,NA,NA,NA,NA,NA,NA,NA,NA,NA, 88 | NA,NA,NA,NA,NA,"first_language",NA,NA,NA,NA, 89 | NA,NA,NA,NA,NA,NA,NA,NA,NA,NA,"read_language", 90 | NA,NA,"learned_r",NA,NA,"learned_programming_not_r", 91 | NA,NA,"completed_data_analysis", 92 | "completed_data_analysis","completed_data_analysis","completed_data_analysis"), 93 | dependence_value = c(NA,NA,NA,NA,NA, 94 | "Prefer to self describe",NA,NA,NA,NA,NA,NA,NA,NA,NA,NA, 95 | NA,NA,NA,NA,NA,NA,NA,NA,NA,NA,"Other",NA,NA, 96 | NA,NA,NA,NA,NA,NA,NA,NA,NA,NA,NA,NA,"Other", 97 | NA,NA,"Yes",NA,NA,"Yes",NA,NA,"Yes","Yes","Yes", 98 | "Yes"), 99 | required = c(TRUE,TRUE,TRUE,TRUE,TRUE, 100 | FALSE,FALSE,FALSE,FALSE,FALSE,FALSE,FALSE,FALSE, 101 | FALSE,FALSE,FALSE,FALSE,FALSE,FALSE,FALSE,FALSE, 102 | FALSE,FALSE,FALSE,FALSE,FALSE,FALSE,FALSE,FALSE, 103 | FALSE,FALSE,FALSE,FALSE,FALSE,FALSE,FALSE,FALSE,FALSE, 104 | FALSE,FALSE,FALSE,FALSE,TRUE,TRUE,FALSE,TRUE, 105 | TRUE,FALSE,TRUE,TRUE,FALSE,FALSE,FALSE,FALSE), 106 | page = c("intro","intro","intro", 107 | "intro","intro","intro","intro","intro","intro","intro", 108 | "intro","intro","mid","mid","mid","mid","mid", 109 | "mid","mid","mid","mid","mid","mid","mid","mid", 110 | "mid","mid","mid","mid","mid","mid","mid","mid", 111 | "mid","mid","mid","mid","mid","mid","mid","mid","mid", 112 | "finale","finale","finale","finale","finale", 113 | "finale","finale","finale","finale","finale","finale", 114 | "finale") 115 | ) 116 | 117 | test_that("surveyOutput() works - paged_questions", { 118 | local_edition(3) 119 | expect_snapshot_output(shiny::fluidPage( 120 | shinysurveys::surveyOutput(df = paged_teaching_r_questions, 121 | survey_title = "Test This MultiPaged Survey") 122 | )) 123 | }) 124 | -------------------------------------------------------------------------------- /R/func_survey-output.R: -------------------------------------------------------------------------------- 1 | #' Generate the UI Code for demographic questions 2 | #' 3 | #' @param df One element (a dataframe) in the list of unique questions. 4 | #' 5 | #' @keywords internal 6 | #' @return UI Code for a Shiny App. 7 | #' 8 | surveyOutput_individual <- function(df) { 9 | 10 | inputType <- base::unique(df$input_type) 11 | 12 | if (length(inputType) != 1) { 13 | if (!"instructions" %in% inputType) { 14 | stop("Please double check your data frame and ensure that the input type for all questions is supported.") 15 | } else if ("instructions" %in% inputType) { 16 | instructions <- df[which(df$input_type == "instructions"), "question", drop = FALSE]$question 17 | instructions <- shiny::tagList( 18 | shiny::div(class = "question-instructions", 19 | instructions) 20 | ) 21 | 22 | inputType <- inputType[which(inputType != "instructions")] 23 | df <- df[which(df$input_type != "instructions"),] 24 | } 25 | } else if (length(inputType == 1)) { 26 | instructions <- NULL 27 | } 28 | 29 | if (grepl("rank_{{", inputType, perl = T)) { 30 | stop('Ranking input types have been superseded by the "matrix" input type.') 31 | } 32 | 33 | survey_env$current_question <- df 34 | 35 | if (inputType == "select") { 36 | output <- 37 | shiny::selectizeInput( 38 | inputId = base::unique(df$input_id), 39 | label = addRequiredUI_internal(df), 40 | choices = df$option, 41 | options = list( 42 | placeholder = '', 43 | onInitialize = I('function() { this.setValue(""); }') 44 | ) 45 | ) 46 | } else if (inputType == "numeric") { 47 | 48 | output <- 49 | numberInput( 50 | inputId = base::unique(df$input_id), 51 | label = addRequiredUI_internal(df), 52 | placeholder = df$option 53 | ) 54 | 55 | } else if (inputType == "mc") { 56 | 57 | output <- 58 | shiny::radioButtons( 59 | inputId = base::unique(df$input_id), 60 | label = addRequiredUI_internal(df), 61 | selected = base::character(0), 62 | choices = df$option 63 | ) 64 | } else if (inputType == "text") { 65 | 66 | output <- 67 | shiny::textInput(inputId = base::unique(df$input_id), 68 | label = addRequiredUI_internal(df), 69 | placeholder = df$option) 70 | 71 | } else if (inputType == "y/n") { 72 | 73 | output <- 74 | shiny::radioButtons( 75 | inputId = base::unique(df$input_id), 76 | label = addRequiredUI_internal(df), 77 | selected = base::character(0), 78 | choices = df$option 79 | ) 80 | 81 | } else if (inputType == "matrix") { 82 | 83 | required_matrix <- ifelse(all(df$required), TRUE, FALSE) 84 | 85 | output <- 86 | radioMatrixInput( 87 | inputId = base::unique(df$input_id), 88 | responseItems = base::unique(df$question), 89 | choices = base::unique(df$option), 90 | selected = NULL, 91 | .required = required_matrix 92 | ) 93 | 94 | } else if (inputType == "instructions") { 95 | 96 | output <- shiny::div( 97 | class = "instructions-only", 98 | shiny::markdown(df$question) 99 | ) 100 | 101 | } else if (inputType %in% survey_env$input_type) { 102 | output <- eval(survey_env$input_extension[[inputType]]) 103 | } else { 104 | stop(paste0("Input type '", inputType, "' from the supplied data frame of questions is not recognized by {shinysurveys}. 105 | Did you mean to register a custom input extension with `extendInputType()`?")) 106 | } 107 | 108 | if (!base::is.na(df$dependence[1])) { 109 | output <- shiny::div(class = "questions dependence", 110 | id = paste0(df$input_id[1], "-question"), 111 | shiny::div(class = "question-input", 112 | instructions, 113 | output)) 114 | } else if (base::is.na(df$dependence[1])) { 115 | output <- shiny::div(class = "questions", 116 | id = paste0(df$input_id[1], "-question"), 117 | shiny::div(class = "question-input", 118 | instructions, 119 | output)) 120 | } 121 | 122 | return(output) 123 | 124 | } 125 | 126 | 127 | #' Generate the UI Code for demographic questions 128 | #' 129 | #' Create the UI code for a Shiny app based on user-supplied questions. 130 | #' 131 | #' @param df A user supplied data frame in the format of teaching_r_questions. 132 | #' @param survey_title (Optional) user supplied title for the survey 133 | #' @param survey_description (Optional) user supplied description for the survey 134 | #' @param theme A valid R color: predefined such as "red" or "blue"; hex colors 135 | #' such as #63B8FF (default). To customize the survey's appearance entirely, supply NULL. 136 | #' @param ... Additional arguments to pass into \link[shiny]{actionButton} used to submit survey responses. 137 | #' 138 | #' @return UI Code for a Shiny App. 139 | #' @export 140 | #' 141 | #' @examples 142 | #' 143 | #' if (interactive()) { 144 | #' 145 | #' library(shiny) 146 | #' library(shinysurveys) 147 | #' 148 | #' df <- data.frame(question = "What is your favorite food?", 149 | #' option = "Your Answer", 150 | #' input_type = "text", 151 | #' input_id = "favorite_food", 152 | #' dependence = NA, 153 | #' dependence_value = NA, 154 | #' required = F) 155 | #' 156 | #' ui <- fluidPage( 157 | #' surveyOutput(df = df, 158 | #' survey_title = "Hello, World!", 159 | #' theme = "#63B8FF") 160 | #' ) 161 | #' 162 | #' server <- function(input, output, session) { 163 | #' renderSurvey() 164 | #' 165 | #' observeEvent(input$submit, { 166 | #' showModal(modalDialog( 167 | #' title = "Congrats, you completed your first shinysurvey!", 168 | #' "You can customize what actions happen when a user finishes a survey using input$submit." 169 | #' )) 170 | #' }) 171 | #' } 172 | #' 173 | #' shinyApp(ui, server) 174 | #' 175 | #' } 176 | 177 | 178 | surveyOutput <- function(df, survey_title, survey_description, theme = "#63B8FF", ...) { 179 | 180 | survey_env$theme <- theme 181 | survey_env$question_df <- df 182 | survey_env$unique_questions <- listUniqueQuestions(df) 183 | if (!missing(survey_title)) { 184 | survey_env$title <- survey_title 185 | } 186 | if (!missing(survey_description)) { 187 | survey_env$description <- survey_description 188 | } 189 | 190 | if ("page" %in% names(df)) { 191 | main_ui <- multipaged_ui(df = df) 192 | } else if (!"page" %in% names(df)) { 193 | main_ui <- shiny::tagList( 194 | check_survey_metadata(survey_title = survey_title, 195 | survey_description = survey_description), 196 | lapply(survey_env$unique_questions, surveyOutput_individual), 197 | shiny::div(class = "survey-buttons", 198 | shiny::actionButton("submit", 199 | "Submit", 200 | ...) 201 | ) 202 | ) 203 | } 204 | 205 | if (!is.null(survey_env$theme)) { 206 | survey_style <- sass::sass(list( 207 | list(color = survey_env$theme), 208 | readLines( 209 | system.file("render_survey.scss", 210 | package = "shinysurveys") 211 | ) 212 | )) 213 | } else if (is.null(survey_env$theme)) { 214 | survey_style <- NULL 215 | } 216 | 217 | 218 | shiny::tagList(shiny::includeScript(system.file("shinysurveys-js.js", 219 | package = "shinysurveys")), 220 | shiny::includeScript(system.file("save_data.js", 221 | package = "shinysurveys")), 222 | shiny::tags$style(shiny::HTML(survey_style)), 223 | shiny::div(class = "survey", 224 | shiny::div(style = "display: none !important;", 225 | shiny::textInput(inputId = "userID", 226 | label = "Enter your username.", 227 | value = "NO_USER_ID")), 228 | main_ui)) 229 | 230 | } 231 | -------------------------------------------------------------------------------- /tests/testthat/test-survey_code.R: -------------------------------------------------------------------------------- 1 | # Setup test questions ---------------------------------------------------- 2 | 3 | ds_questions <- data.frame(question = c("What is your name?", 4 | "Who's your advisor?", 5 | "What are your research interests?", 6 | "What are your long term career goals?", 7 | "What other courses are you taking / other big commitments?", 8 | "How would you rate your current understanding of the topics in this course (data science, exploratory data analysis, graphical data analysis)?", 9 | "How much experience have you already had with R?", 10 | "In general, how much programming experience have you had?"), 11 | option = "Your Answer", 12 | input_type = "text", 13 | input_id = c("name", "advisor", "interests", "goals", "other_courses", "current_understanding", "experience_with_r", "programming_experience"), 14 | dependence = c(NA, "name", NA, NA, NA, NA, NA, NA), 15 | dependence_value = c(NA, "bas", NA, NA, NA, NA, NA, NA), 16 | required = c(T, F, F, F, T, F, F, T)) 17 | 18 | ds_all_required <- transform(ds_questions, required = T) 19 | 20 | ds_no_required <- transform(ds_questions, required = F) 21 | 22 | 23 | ds_plus_matrix <- rbind( 24 | ds_questions, 25 | data.frame( 26 | question = c(rep("I love sushi.", 3), rep("I love chocolate.",3)), 27 | option = rep(c("Disagree", "Neutral", "Agree"), 2), 28 | input_type = rep("matrix", 6), 29 | input_id = "matId", 30 | dependence = NA, 31 | dependence_value = NA, 32 | required = TRUE 33 | ) 34 | ) 35 | 36 | 37 | # Test internal data processing ------------------------------------------- 38 | 39 | test_that("listUniqueQuestions() works", { 40 | listed <- listUniqueQuestions(teaching_r_questions) 41 | expect_equal(length(listed), 14) 42 | 43 | listed_ds <- listUniqueQuestions(ds_questions) 44 | expect_equal(length(listed_ds), 8) 45 | 46 | }) 47 | 48 | test_that("addRequiredUI_internal() correctly adds asterisks to required questions", { 49 | 50 | required <- listUniqueQuestions(ds_all_required)[[1]] 51 | not_required <- listUniqueQuestions(ds_no_required)[[1]] 52 | 53 | span_regex <- '\\*' 54 | 55 | # must convert this to character for checking as it has class shiny.tag.list 56 | expect_match(as.character(addRequiredUI_internal(required)), span_regex) 57 | 58 | no_match <- function() { 59 | expect_match(addRequiredUI_internal(not_required), span_regex) 60 | } 61 | 62 | expect_error(no_match()) 63 | 64 | }) 65 | 66 | # Test Server Functionality -------------------------------------------------------- 67 | 68 | ## Test Required Questions 69 | 70 | test_that("server works when some questions are required and others are not", { 71 | 72 | server <- function(input, output, session) { 73 | 74 | required_vec <- getRequired_internal( 75 | listUniqueQuestions( 76 | ds_questions 77 | ) 78 | ) 79 | 80 | toggle_button <- reactive({checkRequired_internal(input = input, required_inputs_vector = required_vec)}) 81 | 82 | } 83 | 84 | shiny::testServer(server, { 85 | session$setInputs(name = "answer", 86 | advisor = "answer", 87 | interests = "answer", 88 | goals = "answer", 89 | current_understanding = "answer", 90 | experience_with_r = "answer", 91 | `tr-i_love_sushi` = "Agree") 92 | 93 | # expect false because not all required questions have been answered 94 | expect_false(toggle_button()) 95 | 96 | session$setInputs(other_courses = "answer", 97 | programming_experience = "answer", 98 | `tr-i_love_chocolate` = "Agree") 99 | 100 | # expect true because all required questions have been answered 101 | expect_true(toggle_button()) 102 | }) 103 | 104 | }) 105 | 106 | test_that("server works with required matrix questions and others", { 107 | 108 | server <- function(input, output, session) { 109 | 110 | required_vec <- getRequired_internal( 111 | listUniqueQuestions( 112 | ds_plus_matrix 113 | ) 114 | ) 115 | 116 | toggle_button <- reactive({checkRequired_internal(input = input, required_inputs_vector = required_vec)}) 117 | 118 | } 119 | 120 | shiny::testServer(server, { 121 | session$setInputs(name = "answer", 122 | advisor = "answer", 123 | interests = "answer", 124 | goals = "answer", 125 | current_understanding = "answer", 126 | experience_with_r = "answer" 127 | 128 | ) 129 | 130 | # expect false because not all required questions have been answered 131 | expect_false(toggle_button()) 132 | 133 | session$setInputs(other_courses = "answer", 134 | programming_experience = "answer", 135 | matId = "answer") 136 | 137 | # expect true because all required questions have been answered 138 | expect_true(toggle_button()) 139 | }) 140 | 141 | }) 142 | 143 | 144 | 145 | test_that("server works when all questions are required", { 146 | 147 | server <- function(input, output, session) { 148 | 149 | required_vec <- getRequired_internal( 150 | listUniqueQuestions( 151 | ds_all_required 152 | ) 153 | ) 154 | 155 | toggle_button <- reactive({checkRequired_internal(input = input, required_inputs_vector = required_vec)}) 156 | 157 | } 158 | 159 | shiny::testServer(server, { 160 | session$setInputs(name = "answer", 161 | advisor = "answer", 162 | interests = "answer", 163 | goals = "answer", 164 | other_courses = "answer", 165 | current_understanding = "answer", 166 | experience_with_r = "answer", 167 | programming_experience = "answer") 168 | expect_true(toggle_button()) 169 | }) 170 | 171 | }) 172 | 173 | test_that("server works when no questions are required", { 174 | 175 | server <- function(input, output, session) { 176 | 177 | required_vec <- getRequired_internal( 178 | listUniqueQuestions( 179 | ds_no_required 180 | ) 181 | ) 182 | 183 | toggle_button <- reactive({checkRequired_internal(input = input, required_inputs_vector = required_vec)}) 184 | 185 | } 186 | 187 | shiny::testServer(server, { 188 | expect_true(toggle_button()) 189 | }) 190 | 191 | }) 192 | 193 | ## Test Dependency Questions -- just a sample 194 | 195 | test_that("server works with dependency questions - text based", { 196 | server <- function(input, output, session) { 197 | 198 | listed <- listUniqueQuestions(ds_questions) 199 | 200 | show_dependency <- reactive({showDependence(input = input, df = listed[[2]])}) 201 | 202 | } 203 | 204 | shiny::testServer(server, { 205 | session$setInputs(name = "ba") 206 | expect_false(show_dependency()) 207 | session$setInputs(name = "ba s") 208 | expect_false(show_dependency()) 209 | session$setInputs(name = "bas") 210 | expect_true(show_dependency()) 211 | }) 212 | 213 | }) 214 | 215 | 216 | test_that("server works with dependency questions - multiple choice", { 217 | server <- function(input, output, session) { 218 | 219 | listed <- listUniqueQuestions(teaching_r_questions) 220 | 221 | show_dependency <- reactive({showDependence(input = input, df = listed[[3]])}) 222 | 223 | } 224 | 225 | shiny::testServer(server, { 226 | session$setInputs(gender = "") 227 | expect_false(show_dependency()) 228 | session$setInputs(gender = "prefer to self describe") 229 | expect_false(show_dependency()) 230 | session$setInputs(gender = "Prefer to self describe") 231 | expect_true(show_dependency()) 232 | }) 233 | 234 | }) 235 | 236 | 237 | test_that("input type error catch works", { 238 | 239 | no_error <- data.frame(question = "Question about input types", 240 | option = NA, 241 | input_type = "select", 242 | # Note the input IDs are specific for the language option 243 | input_id = "testing-input-error", 244 | dependence = NA, 245 | dependence_value = NA, 246 | required = TRUE) 247 | 248 | error <- no_error 249 | error$input_type <- "unknown-input-type" 250 | 251 | expect_silent( 252 | ui <- shiny::fluidPage( 253 | surveyOutput(no_error) 254 | ) 255 | ) 256 | 257 | expect_error( 258 | ui <- shiny::fluidPage( 259 | surveyOutput(error) 260 | ) 261 | ) 262 | 263 | }) 264 | -------------------------------------------------------------------------------- /vignettes/get-survey-data.Rmd: -------------------------------------------------------------------------------- 1 | --- 2 | title: "Aggregate Responses with `getSurveyData()`" 3 | output: rmarkdown::html_vignette 4 | vignette: > 5 | %\VignetteIndexEntry{Aggregate Responses with `getSurveyData()`} 6 | %\VignetteEngine{knitr::rmarkdown} 7 | %\VignetteEncoding{UTF-8} 8 | --- 9 | 10 | ```{r, include = FALSE} 11 | knitr::opts_chunk$set( 12 | collapse = TRUE, 13 | comment = "#>" 14 | ) 15 | ``` 16 | 17 | ```{r setup, include = FALSE} 18 | library(shinysurveys) 19 | ``` 20 | 21 | # Introduction 22 | 23 | shinysurveys was developed, in large part, to automate data collection and analysis. In this vignette, I demonstrate the use of `getSurveyData()` to easily aggregate survey responses and help you, the designer, more quickly gain insights of the results. The output always follows the same structure, inspired by tidy data, where each row is an observation (question) and each column is a variable. 24 | 25 | The 'subject_id' column can be used for identifying respondents. By default, it utilizes shinysurveys [URL-based user tracking feature](https://shinysurveys.jdtrat.com/articles/surveying-shinysurveys.html#user-tracking).[^1] The 'question_id' and 'question_type' columns correspond to 'input_id' and 'input_type' from the original data frame of questions. The 'response' column is the participant's answer. 26 | 27 | [^1]: Alternative IDs can be supplied with the `custom_id` argument, however. For example, `getSurveyData(custom_id = input$name)` would save 'subject_id' as a participant's name -- "JT" in this case. 28 | 29 | # Basic Example 30 | 31 | As an example, consider the following shiny survey, containing questions about your favorite food and your name. 32 | 33 | A "Submit" button is built into any shiny survey, but -- by default -- no actions are defined. So, when a user completes the survey, the app designer can specify what happens upon submission. In this case, I'll simply print a user's responses.[^2] The code for this is below: 34 | 35 | [^2]: In practice, printing is not the end-goal. I use it here solely to demonstrate how easy it is to access response data. 36 | 37 | ```{r full-simple-app, eval = FALSE} 38 | 39 | # Load packages 40 | library(shiny) 41 | library(shinysurveys) 42 | 43 | # Define questions in the format of a shinysurvey 44 | survey_questions <- data.frame( 45 | question = c("What is your favorite food?", 46 | "What's your name?"), 47 | option = NA, 48 | input_type = "text", 49 | input_id = c("favorite_food", "name"), 50 | dependence = NA, 51 | dependence_value = NA, 52 | required = c(TRUE, FALSE) 53 | ) 54 | 55 | # Define shiny UI 56 | ui <- fluidPage( 57 | surveyOutput(survey_questions, 58 | survey_title = "Hello, World!", 59 | survey_description = "A demo survey") 60 | ) 61 | 62 | # Define shiny server 63 | server <- function(input, output, session) { 64 | renderSurvey() 65 | 66 | observeEvent(input$submit, { 67 | response_data <- getSurveyData() 68 | print(response_data) 69 | }) 70 | 71 | } 72 | 73 | # Run the shiny application 74 | shinyApp(ui, server) 75 | ``` 76 | 77 | In the browser, the survey looks like this: 78 | 79 | ![](graphics/get-survey-data/demo-survey-screenshot.png) 80 | 81 | When I answer the survey and click submit, the following data frame is printed to the console, following the format described in the introduction. 82 | 83 | | subject_id | question_id | question_type | response | 84 | |:----------:|:-------------:|:-------------:|:--------:| 85 | | NO_USER_ID | favorite_food | text | Sushi | 86 | | NO_USER_ID | name | text | JT | 87 | 88 | # Complex Example 89 | 90 | In order to generalize `getSurveyData()`, it has to account for input types that may return multiple values. For example, shiny's `checkboxGroupInput` returns a character vector whose values correspond to the checked boxes. In order to ensure that this, and other custom input extensions,[^3] work with `getSurveyData()`, I collapse responses into a single character vector separated by commas. Consider the following application: 91 | 92 | [^3]: If you are unfamiliar with custom input types, please see [my blog post](https://www.jdtrat.com/blog/extending-shinysurveys/) introducing them or the [documentation](https://shinysurveys.jdtrat.com/articles/custom-input-extensions.html). 93 | 94 | ```{r complex-example, eval = FALSE} 95 | # Load packages 96 | library(shiny) 97 | library(shinysurveys) 98 | 99 | # Register a "check" input type 100 | extendInputType("check", { 101 | shiny::checkboxGroupInput( 102 | inputId = surveyID(), 103 | label = surveyLabel(), 104 | choices = surveyOptions(), 105 | ) 106 | }) 107 | 108 | # Define question in the format of a shinysurvey 109 | ice_cream_question <- data.frame( 110 | question = "Please indicate which of the following are your top three favorite ice cream flavors.", 111 | option = c("Chocolate", "Vanilla", "Strawberry", 112 | "Mint Chocolate Chip", "Rocky Road", "Cookie Batter", 113 | "Hazelnut", "Cookies N' Cream", "Pistachio"), 114 | input_type = "check", 115 | input_id = "favorite_ice_cream", 116 | dependence = NA, 117 | dependence_value = NA, 118 | required = TRUE 119 | ) 120 | 121 | # Define shiny UI 122 | ui <- fluidPage( 123 | surveyOutput(ice_cream_question, 124 | survey_title = "Hello, World!") 125 | ) 126 | 127 | # Define shiny server 128 | server <- function(input, output, session) { 129 | renderSurvey() 130 | 131 | observeEvent(input$submit, { 132 | response_data <- getSurveyData() 133 | print(response_data) 134 | }) 135 | 136 | } 137 | 138 | # Run the shiny application 139 | shinyApp(ui, server) 140 | 141 | ``` 142 | 143 | When I answer the survey and click submit, the following data frame is printed to the console. 144 | 145 | | subject_id | question_id | question_type | response | 146 | |:----------:|:------------------:|:-------------:|:---------------------------------------:| 147 | | NO_USER_ID | favorite_ice_cream | check | Chocolate, Rocky Road, Cookies N' Cream | 148 | 149 | # Dependency Example 150 | 151 | `getSurveyData()` only aggregates data from questions that participants have actually seen. As mentioned in the introduction, this function returns one row per question. This is true by default, however, there are some features specific for dealing with dependency questions. 152 | 153 | Consider the question set built into the package from a recent study by the [D'Agostino McGowan Data Science Lab](https://dmds.lucymcgowan.com/). There are `r length(unique(teaching_r_questions$input_id))` unique questions, but some will only be asked if a specific answer is provided. 154 | 155 | For example, people who answer "Yes" to the question "Have you ever learned to program in R?" will be shown a numeric input question asking how many years they have been using R. If no, the next question -- about a programming language other than R -- will (continue) to be shown. 156 | 157 | Consider the following survey, showing a subset of the built-in questions: 158 | 159 | ![](graphics/get-survey-data/dependency-survey-screenshot.png) 160 | 161 | It can be created with the following code: 162 | 163 | ```{r dependency-survey, eval = FALSE} 164 | 165 | # Load packages 166 | library(shiny) 167 | library(shinysurveys) 168 | 169 | # Define questions in the format of a shinysurvey 170 | dep_questions <- tail(teaching_r_questions, 12) 171 | 172 | # Define shiny UI 173 | ui <- fluidPage( 174 | surveyOutput(dep_questions, 175 | survey_title = "Hello, World!") 176 | ) 177 | 178 | # Define shiny server 179 | server <- function(input, output, session) { 180 | renderSurvey() 181 | 182 | observeEvent(input$submit, { 183 | response_data <- getSurveyData() 184 | print(response_data) 185 | }) 186 | 187 | } 188 | 189 | # Run the shiny application 190 | shinyApp(ui, server) 191 | ``` 192 | 193 | When I answer "No" to all questions and click submit, the following data frame is printed to the console: 194 | 195 | | subject_id | question_id | question_type | response | 196 | |:----------:|:------------------------------:|:-------------:|:---------------:| 197 | | NO_USER_ID | learned_r | y/n | No | 198 | | NO_USER_ID | years_using_r | numeric | HIDDEN-QUESTION | 199 | | NO_USER_ID | learned_programming_not_r | y/n | No | 200 | | NO_USER_ID | years_programming_not_r | text | HIDDEN-QUESTION | 201 | | NO_USER_ID | completed_data_analysis | y/n | No | 202 | | NO_USER_ID | number_completed_data_analysis | mc | HIDDEN-QUESTION | 203 | 204 | This is notable for a few reasons. Firstly, I never saw the questions asking about how long I used R, how long I used another programming language, or how many data analyses I completed. The default behavior is to include all dependency questions and imputing "HIDDEN-QUESTION" for the response value. This will keep the data structure the same for all respondents, controlling for variability in participant responses. The imputed value can be changed with the `dependency_string` argument, e.g. `getSurveyData(dependency_string = "NOT-SEEN")`. 205 | 206 | Dependency questions can also be excluded from the output as follows: `getSurveyData(include_dependencies = FALSE)`. This may result in the output having different number of rows depending on which questions a person answers. For example, if I answered no to all questions and have `include_dependencies = FALSE)`, my data would be: 207 | 208 | | subject_id | question_id | question_type | response | 209 | |:----------:|:-------------------------:|:-------------:|:--------:| 210 | | NO_USER_ID | learned_r | y/n | No | 211 | | NO_USER_ID | learned_programming_not_r | y/n | No | 212 | | NO_USER_ID | completed_data_analysis | y/n | No | 213 | 214 | In contrast, if I answered "Yes" to the first question, then my data would look like this:[^4] 215 | 216 | [^4]: The response for years_using_r is NA because I did not answer it. 217 | 218 | | subject_id | question_id | question_type | response | 219 | |:----------:|:-------------------------:|:-------------:|:--------:| 220 | | NO_USER_ID | learned_r | y/n | No | 221 | | NO_USER_ID | years_using_r | numeric | NA | 222 | | NO_USER_ID | learned_programming_not_r | y/n | No | 223 | | NO_USER_ID | completed_data_analysis | y/n | No | 224 | 225 | # Conclusion 226 | 227 | In this vignette, I highlighted the use of `getSurveyData()` to easily aggregate survey responses. I hope you find this feature as useful as I have! It is especially powerful when implementing data collection and analysis pipelines. As a necessary disclaimer, *please test this on your survey before using it in a deployed application*. Although I have tested `getSurveyData()` in a variety of situations, I have not exhausted all custom input types and you may run into errors. If that happens, please file a [GitHub Issue](https://github.com/jdtrat/shinysurveys/issues) with a minimal app to reproduce the bug. 228 | 229 | Thanks for reading, and happy surveying! 230 | -------------------------------------------------------------------------------- /tests/testthat/_snaps/surveyOutput-ds_questions.md: -------------------------------------------------------------------------------- 1 | # surveyOutput() works - ds_questions 2 | 3 |
4 | 63 | 106 | 262 |
263 |
264 |
265 | 266 | 267 |
268 |
269 |
270 |

Getting To Know You

271 |

Welcome! This is a quick survey for us to become familiar with each other's backgrounds in this class.

272 |
273 |
274 |
275 |
276 | 280 | 281 |
282 |
283 |
284 |
285 |
286 |
287 | 288 | 289 |
290 |
291 |
292 |
293 |
294 |
295 | 296 | 297 |
298 |
299 |
300 |
301 |
302 |
303 | 304 | 305 |
306 |
307 |
308 |
309 |
310 |
311 | 315 | 316 |
317 |
318 |
319 |
320 |
321 |
322 | 323 | 324 |
325 |
326 |
327 |
328 |
329 |
330 | 331 | 332 |
333 |
334 |
335 |
336 |
337 |
338 | 342 | 343 |
344 |
345 |
346 |
347 | 348 |
349 |
350 |
351 | 352 | -------------------------------------------------------------------------------- /vignettes/surveying-shinysurveys.Rmd: -------------------------------------------------------------------------------- 1 | --- 2 | title: "A survey of shinysurveys" 3 | output: rmarkdown::html_vignette 4 | vignette: > 5 | %\VignetteIndexEntry{A survey of shinysurveys} 6 | %\VignetteEngine{knitr::rmarkdown} 7 | %\VignetteEncoding{UTF-8} 8 | --- 9 | 10 | ```{r, include = FALSE} 11 | knitr::opts_chunk$set( 12 | collapse = TRUE, 13 | comment = "#>" 14 | ) 15 | library(tibble) 16 | ``` 17 | 18 | ```{r setup, include = FALSE} 19 | library(shinysurveys) 20 | ``` 21 | 22 | # Introduction 23 | 24 | The ability to easily collect and analyze survey data is incredibly important. Many platforms provide user-friendly methods to do this. [Google Forms](https://www.google.com/forms/about/), [SurveyMonkey](https://www.surveymonkey.com/), and [Qualtrics](https://www.qualtrics.com/core-xm/survey-software/) are all popular options. However, these services don't always integrate easily with existing data analysis and/or research pipelines. Because of R's prevalence in academia and research, {shinysurveys} was developed to streamline the data collection and analysis process. 25 | 26 | In this vignette, I provide an overview of the main features of shinysurveys.[^shinysurveys-1] Aligned with the basic structure of {shiny} applications, consisting of the user-interface and server components, this package has a function for each: `surveyOutput()` and `renderSurvey()`, respectively. The former accepts a data frame of questions that follow a specific format. To illustrate this, I will show a questionnaire from a recent study conducted by the [D'Agostino McGowan Data Science Lab](https://dmds.lucymcgowan.com/) that is built into the `shinysurveys` package.[^shinysurveys-3] The first ten (of 54) rows of this data frame look like: 27 | 28 | [^shinysurveys-1]: I assume familiarity with the basic layout of a Shiny application, as briefly outlined above. For additional information, please check out RStudio's [great resources](https://shiny.rstudio.com/tutorial/). 29 | 30 | [^shinysurveys-3]: In the following code, I use the prefix `shinysurveys::` whenever I'm using a function specific to this package. If you are unfamiliar with this notation, see [[@rpkgs]](https://r-pkgs.org/namespace.html) 31 | 32 | ```{r, echo = FALSE} 33 | shinysurveys::teaching_r_questions[1:10,] 34 | ``` 35 | 36 | This data can be described as a tidy data frame, where each row is a unique observation and each column is a variable. While the full table consists of 54 rows, there are only 11 unique questions: 37 | 38 | ```{r display unique questions, echo = FALSE} 39 | unique(shinysurveys::teaching_r_questions$question) 40 | ``` 41 | 42 | The reason for the discrepancy between the number of rows and unique questions derives from the fact that certain questions can have more than one possible response. For example, the multiple choice question asking about gender has four options: "Female", "Male", "Prefer not to say", or "Prefer to self describe." It thus has four rows, one per each option. 43 | 44 | To create a question in the required format, seven parameters must be supplied. They are described in the package documentation and can be accessed by typing `?shinysurveys::teaching_r_questions` in the R console: 45 | 46 | - *question*: The question to be asked. 47 | - *option*: A possible response to the question. In multiple choice questions, for example, this would be the possible answers. For questions without discrete answers, such as a numeric input, this would be the default option shown on the input. For text inputs, it is the placeholder value. 48 | - *input_type*: What type of response is expected? Currently supported types include `numeric`, `mc` for multiple choice, `text`, `select`,and `y/n` for yes/no questions. 49 | - *input_id*: The input id for Shiny inputs. 50 | - *dependence*: Does this question (row) depend on another? That is, should it only appear if a different question has a specific value? This column contains the input_id of whatever question this one depends upon. 51 | - *dependence_value*: This column contains the specific value that the dependence question must take for this question (row) to be shown. 52 | - *required*: logical TRUE/FALSE signifying if a question is required. 53 | 54 | The next section describes input types native to {shinysurveys}. 55 | 56 | ## Examples 57 | 58 | Below are examples of the currently supported question types. I provide a thorough explanation for the numeric input, but only point out notable differences for other inputs. 59 | 60 | ### Numeric Input 61 | 62 | A good example of a numeric input is the first question: "What's your age?": 63 | 64 | ```{r what is your age preview, echo = FALSE} 65 | subset(teaching_r_questions, input_id == "age") 66 | ``` 67 | 68 | As seen above, this row corresponds to the question "What's your age?". I know to expect a numeric response by looking at the `input_type` column, and the default value is equal to 25 according to the `option` column.[^shinysurveys-4] 69 | 70 | [^shinysurveys-4]: It is important to note that the option column for numeric inputs provides the default value, but for other types -- as I will show -- it provides the possible options for a question. 71 | 72 | I can also tell that there are no dependency questions. This means that no matter what value is entered, no follow-up question will appear. Lastly, I know it is a required question.[^shinysurveys-5] 73 | 74 | [^shinysurveys-5]: Required question functionality will be discussed in more detail in the section [Required Questions](#required_questions). 75 | 76 | ![](graphics/survey-of-shinysurveys/numeric_example.png){style="display: block; margin: 1em auto" width="300"} 77 | 78 | ### Multiple Choice (mc) Input {#multiple_choice} 79 | 80 | An example of this is the question "Which best describes your gender?": 81 | 82 | ```{r what is your gender mc, echo = FALSE} 83 | subset(teaching_r_questions, input_id == "gender" | input_id == "self_describe_gender") 84 | ``` 85 | 86 | Unlike numeric inputs, the `option` column represents each of the possible responses for this question. You may notice that the fifth row of this question has *NA* in the `option` column and "text" in the `input_type` column. I will discuss this in more detail [below](#dependency-questions), but for now, note that this question has a dependent. That is, if a specific option is chosen for this question, a new one will appear below. In this case, a question that accepts text as its input. 87 | 88 | ![](graphics/survey-of-shinysurveys/mc_example.png){style="display: block; margin: 1em auto" width="300"} 89 | 90 | ### Text Input {#text_input} 91 | 92 | Questions that need text-based input should specify "text" in the `input_type` column. As noted in the previous example, the following is a dependent of the question "Which best describes your gender?": 93 | 94 | ```{r what is your gender text, echo = FALSE} 95 | subset(teaching_r_questions, input_id == "self_describe_gender") 96 | ``` 97 | 98 | As previously mentioned, the `option` column for text-based inputs corresponds to a placeholder value. It can be left blank (i.e. NA) or contain a character string. If they are left empty, the text field will display "Placeholder" as seen below. Otherwise, the character string will be displayed. 99 | 100 | ![](graphics/survey-of-shinysurveys/text_input_placeholder.png){.center style="display: block; margin: 1em auto" width="300"} 101 | 102 | ![](graphics/survey-of-shinysurveys/text_input_character_string.png){.center data-latex="" style="display: block; margin: 1em auto" width="290" height="71"} 103 | 104 | ### Select Input 105 | 106 | Select inputs are great when there are many potential, discretely defined, response choices.[^shinysurveys-6] An example is the question "What was your first language?" which contains `r nrow(subset(teaching_r_questions, question == "What was your first language?"))` options: 107 | 108 | [^shinysurveys-6]: As of May 2021, these do not support multiple options selected at once, though I anticipate adding this functionality in the future. 109 | 110 | ```{r show first language options, echo = FALSE} 111 | subset(teaching_r_questions, question == "What was your first language?") 112 | ``` 113 | 114 | ![](graphics/survey-of-shinysurveys/select_input_example.png){style="display: block; margin: 1em auto" width="300"} 115 | 116 | ### Yes or No (y/n) Input 117 | 118 | Yes or no questions are self-explanatory. An example is the question "Have you ever learned to program in R?": 119 | 120 | ```{r learned to program in R, echo = FALSE} 121 | subset(teaching_r_questions, input_id == "learned_r") 122 | ``` 123 | 124 | ![](graphics/survey-of-shinysurveys/yes_no_example.png){style="display: block; margin: 1em auto" width="300"} 125 | 126 | With an understanding of the available input types, I will now discuss how to implement a survey using this package. 127 | 128 | ### Matrix Input 129 | 130 | Survey questions are often presented in a grid. Consider the question: 131 | 132 | *Please indicate whether you agree, disagree, or are neutral about the following items. (1) I love sushi. (2) I love chocolate.* 133 | 134 | ```{r setup-matrix-question, echo = FALSE} 135 | 136 | matrix_question <- data.frame( 137 | question = c(rep("I love sushi.", 3), rep("I love chocolate.",3)), 138 | option = c(rep(c("Disagree", "Neutral", "Agree"), 2)), 139 | input_type = rep("matrix", 6), 140 | input_id = rep("matId", 6), 141 | dependence = NA, 142 | dependence_value = NA, 143 | required = FALSE 144 | ) 145 | ``` 146 | 147 | Using the following data frame, you could ask that question. [^shinysurveys-4] 148 | 149 | [^shinysurveys-4]: Note that you may use multiple matrix questions within a survey. Each item within a matrix question must have the options repeated, and share the same input id/dependence/required values. 150 | 151 | ```{r display-matrix-question, echo = FALSE} 152 | matrix_question 153 | ``` 154 | 155 | In the browser, that would look like this: 156 | 157 | ![](graphics/survey-of-shinysurveys/matrix_example.png) 158 | 159 | ## Implementing Surveys in Shiny 160 | 161 | ### UI Function 162 | 163 | `surveyOutput()` takes in a data frame of the form described above. You may also add a title and description for your survey with the arguments `survey_title` and `survey_description`, though these are optional. It also takes in a `theme` color to style your survey. Typical names such as "red" or "blue" work, as well as hex color codes such as "\#63B8FF" (the default theme). Further documentation can be accessed by typing `?shinysurveys::surveyOutput()` in the console. 164 | 165 | ### Server Function 166 | 167 | `renderSurvey()` must be placed in the server component of a Shiny application. It originally required both the data frame of questions and the theme argument. However, these are now deprecated and hsould only be placed in the `surveyOutput()` function. 168 | 169 | ### Basic Survey 170 | 171 | A minimal example of a survey can be created with this template: 172 | 173 | ```{r run survey, eval = FALSE} 174 | library(shinysurveys) 175 | ui <- shiny::fluidPage( 176 | shinysurveys::surveyOutput(df = shinysurveys::teaching_r_questions, 177 | survey_title = "A minimal title", 178 | survey_description = "A minimal description") 179 | ) 180 | 181 | server <- function(input, output, session) { 182 | shinysurveys::renderSurvey() 183 | } 184 | 185 | shiny::shinyApp(ui = ui, server = server) 186 | ``` 187 | 188 | This creates a functioning survey that looks like this: 189 | 190 | ![](graphics/survey-of-shinysurveys/minimal-survey.png) 191 | 192 | However, when a participant submits their results, nothing happens. By design, {shinysurveys} is minimalist. An extension of this is not imposing any requirements for submission actions, but rather allowing the survey designer to customize them. 193 | 194 | More specifically, the user-interface includes a "submit" button (not shown in the above picture) that requires the programmer to define what happens when it is pressed. Some examples would be saving or displaying user responses, or displaying a message as seen on the [gif here.](https://www.jdtrat.com/project/shinysurveys/shinysurveys-final-demo.gif). 195 | 196 | ## Advanced Features 197 | 198 | ### Dependency Questions {#dependency-questions} 199 | 200 | I use the term question dependencies in reference to the situations where a question should only be shown (i.e. asked) if a specific response is given to a preceding question. The questions included with the {shinysurveys} package contain many dependencies. One example I I mentioned when discussing [multiple choice](#multiple_choice) and [text-based](#text_input) questions is the dependent for "Which best describes your gender?" 201 | 202 | ```{r what is your gender - question dependencies, echo = FALSE} 203 | subset(teaching_r_questions, input_id == "gender" | input_id == "self_describe_gender") 204 | ``` 205 | 206 | Focusing on the columns `dependence` and `dependence_value`, the text-based question will only show if the multiple choice one, with the input id of "gender" takes on the value "Prefer to self describe." That is, a question with non *NA* values in the `dependence` and `dependence_value` columns will only show if the question with the input id from `dependence` takes on the value in `dependence_value`. This can be seen below: 207 | 208 | ![](graphics/survey-of-shinysurveys/dependency_example_1.png){style="display: block; margin: 1em auto" width="300"} 209 | 210 | ![](graphics/survey-of-shinysurveys/dependency_example_2.png){style="display: block; margin: 1em auto" width="300"} 211 | 212 | ### Required Questions {#required_questions} 213 | 214 | Survey designers can define questions that must be answered by adding the value TRUE to the `required` column. If a required question is not answered, the user will not be able to submit their responses. 215 | 216 | ![](graphics/survey-of-shinysurveys/required_submit_disabled.png){style="display: block; margin: 1em auto" width="300"} 217 | 218 | ![](graphics/survey-of-shinysurveys/required_submit_enabled.png){style="display: block; margin: 1em auto" width="300"} 219 | 220 | ### Multiple Pages 221 | 222 | Some people may wish to have survey questions appear on different pages. As of v0.2.0., users can add an additional column `page` to the data frame of questions. The column can either have numeric (e.g. `c(1, 1, 2, 3)` or character (`c("intro", "intro", "middle", "final")`) values. For detailed examples, please visit my [blog post](https://www.jdtrat.com/blog/multi-paged-shinysurvey/) on the matter. 223 | 224 | ### Aggregate Response Data 225 | 226 | As of v0.2.0., users can automatically aggergate response data upon submission with the function `getSurveyData()`. Please see its documentation or dedicated article for more details. 227 | 228 | ### User Tracking 229 | 230 | Built into the survey is the ability to track users based on URL parameters. If you deploy your survey on [shinyapps.io](https://www.shinyapps.io/), or run it locally in a browser, you can add a URL parameter after the backslash as follows: `?user_id=12345`. A live demo can be found here: 231 | 232 | # Conclusion 233 | 234 | {shinysurveys} was developed to integrate behavioral data collection into existing research and/or analysis pipelines in R. In this vignette, I documented the core features of the package. By extending {shiny}, a shinysurvey can make use of the data manipulation and visualization tools in R, facilitating automated data analysis and real-time metrics for participant responses. 235 | --------------------------------------------------------------------------------