├── .Rbuildignore ├── .github ├── .gitignore └── workflows │ ├── check-standard.yaml │ ├── devtools-test.yaml │ ├── lint-project.yaml │ └── pkgdown.yaml ├── .gitignore ├── .lintr ├── DESCRIPTION ├── LICENSE ├── LICENSE.md ├── NAMESPACE ├── R ├── assemble.R ├── browse_surveys.R ├── collectors.R ├── fetch_survey.R ├── get_responses.R ├── import_pipe.R ├── question_parsers.R ├── recipients.R ├── request_utils.R ├── response_parsers.R ├── strip_html.r ├── token_utils.r └── utils.R ├── README.Rmd ├── README.md ├── man ├── browse_surveys.Rd ├── fetch_survey_obj.Rd ├── figures │ └── TNTP-refreshedlogo-final-color-V.jpg ├── get_collectors.Rd ├── get_recipients.Rd ├── get_responses.Rd ├── get_token.Rd ├── parse_survey.Rd ├── pipe.Rd ├── set_token.Rd ├── sm_get.Rd └── strip_html.Rd ├── surveymonkey.Rproj └── tests ├── testthat.R └── testthat ├── api.surveymonkey.com └── v3 │ ├── surveys-7ad99d.json │ ├── surveys-aa605d.json │ └── surveys │ └── 318754279 │ └── details.json ├── api.surveymonkey.net └── v3 │ └── surveys │ └── 318754279 │ ├── collectors-57191d.json │ └── responses │ └── bulk-eda25e.json ├── setup.R ├── test-assemble.R ├── test-browse_surveys.R ├── test-collectors.R ├── test-fetch_survey.R ├── test-parse_responses.R ├── test-recipients.R ├── test-request_utils.R ├── test-standard_request_header.R ├── test-token-utils.R ├── test-utils.R └── test_strip_html.r /.Rbuildignore: -------------------------------------------------------------------------------- 1 | ^inst/$ 2 | ^.*\.Rproj$ 3 | ^\.Rproj\.user$ 4 | README.md 5 | ^.*\.xlsx$ 6 | ^README\.Rmd$ 7 | .github/* 8 | \.lintr 9 | ^\.github$ 10 | ^LICENSE\.md$ 11 | -------------------------------------------------------------------------------- /.github/.gitignore: -------------------------------------------------------------------------------- 1 | *.html 2 | -------------------------------------------------------------------------------- /.github/workflows/check-standard.yaml: -------------------------------------------------------------------------------- 1 | # Workflow derived from https://github.com/r-lib/actions/tree/master/examples 2 | # Need help debugging build failures? Start at https://github.com/r-lib/actions#where-to-find-help 3 | on: 4 | push: 5 | branches: [main] 6 | pull_request: 7 | branches: [main] 8 | 9 | name: R-CMD-check 10 | 11 | jobs: 12 | R-CMD-check: 13 | runs-on: ${{ matrix.config.os }} 14 | 15 | name: ${{ matrix.config.os }} (${{ matrix.config.r }}) 16 | 17 | strategy: 18 | fail-fast: false 19 | matrix: 20 | config: 21 | - {os: macOS-latest, r: 'release'} 22 | - {os: windows-latest, r: 'release'} 23 | - {os: ubuntu-latest, r: 'devel', http-user-agent: 'release'} 24 | - {os: ubuntu-latest, r: 'release'} 25 | - {os: ubuntu-latest, r: 'oldrel-1'} 26 | 27 | env: 28 | GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }} 29 | R_KEEP_PKG_SOURCE: yes 30 | 31 | steps: 32 | - uses: actions/checkout@v2 33 | 34 | - uses: r-lib/actions/setup-pandoc@v1 35 | 36 | - uses: r-lib/actions/setup-r@v1 37 | with: 38 | r-version: ${{ matrix.config.r }} 39 | http-user-agent: ${{ matrix.config.http-user-agent }} 40 | use-public-rspm: true 41 | 42 | - uses: r-lib/actions/setup-r-dependencies@v1 43 | with: 44 | extra-packages: | 45 | testthat, 46 | httptest, 47 | rcmdcheck 48 | 49 | - uses: r-lib/actions/check-r-package@v1 50 | -------------------------------------------------------------------------------- /.github/workflows/devtools-test.yaml: -------------------------------------------------------------------------------- 1 | on: 2 | push: 3 | 4 | name: test-project 5 | 6 | jobs: 7 | test-project: 8 | runs-on: ubuntu-latest 9 | env: 10 | GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }} 11 | steps: 12 | - uses: actions/checkout@v2 13 | 14 | - uses: r-lib/actions/setup-r@v1 15 | with: 16 | use-public-rspm: true 17 | 18 | - name: Install devtools 19 | run: install.packages("devtools") 20 | shell: Rscript {0} 21 | 22 | - name: Install httptest 23 | run: install.packages("httptest") 24 | shell: Rscript {0} 25 | 26 | - name: Install dependencies 27 | run: devtools::install() 28 | shell: Rscript {0} 29 | 30 | - name: test package 31 | run: devtools::test() 32 | shell: Rscript {0} 33 | -------------------------------------------------------------------------------- /.github/workflows/lint-project.yaml: -------------------------------------------------------------------------------- 1 | # Workflow derived from https://github.com/r-lib/actions/tree/master/examples 2 | # Need help debugging build failures? Start at https://github.com/r-lib/actions#where-to-find-help 3 | on: 4 | push: 5 | 6 | name: lint-project 7 | 8 | jobs: 9 | lint-project: 10 | runs-on: ubuntu-latest 11 | env: 12 | GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }} 13 | steps: 14 | - uses: actions/checkout@v2 15 | 16 | - uses: r-lib/actions/setup-r@v1 17 | with: 18 | use-public-rspm: true 19 | 20 | - name: Install lintr 21 | run: install.packages("lintr") 22 | shell: Rscript {0} 23 | 24 | - name: Lint package 25 | run: lintr::lint_package() 26 | shell: Rscript {0} 27 | -------------------------------------------------------------------------------- /.github/workflows/pkgdown.yaml: -------------------------------------------------------------------------------- 1 | # Workflow derived from https://github.com/r-lib/actions/tree/master/examples 2 | # Need help debugging build failures? Start at https://github.com/r-lib/actions#where-to-find-help 3 | on: 4 | push: 5 | branches: [main] 6 | workflow_dispatch: 7 | 8 | name: pkgdown 9 | 10 | jobs: 11 | pkgdown: 12 | runs-on: ubuntu-latest 13 | env: 14 | GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }} 15 | steps: 16 | - uses: actions/checkout@v2 17 | 18 | - uses: r-lib/actions/setup-pandoc@v1 19 | 20 | - uses: r-lib/actions/setup-r@v1 21 | with: 22 | use-public-rspm: true 23 | 24 | - uses: r-lib/actions/setup-r-dependencies@v1 25 | with: 26 | extra-packages: pkgdown 27 | needs: website 28 | 29 | - name: Deploy package 30 | run: | 31 | git config --local user.name "$GITHUB_ACTOR" 32 | git config --local user.email "$GITHUB_ACTOR@users.noreply.github.com" 33 | Rscript -e 'pkgdown::deploy_to_branch(new_process = FALSE)' 34 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | # History files 2 | .Rhistory 3 | .Rapp.history 4 | 5 | # Session Data files 6 | .RData 7 | 8 | # Example code in package build process 9 | *-Ex.R 10 | 11 | # Output files from R CMD build 12 | /*.tar.gz 13 | 14 | # Output files from R CMD check 15 | /*.Rcheck/ 16 | 17 | # RStudio files 18 | .Rproj.user/ 19 | 20 | # produced vignettes 21 | vignettes/*.html 22 | vignettes/*.pdf 23 | 24 | # OAuth2 token, see https://github.com/hadley/httr/releases/tag/v0.3 25 | .httr-oauth 26 | 27 | # knitr and R markdown default cache directories 28 | /*_cache/ 29 | /cache/ 30 | 31 | # Temporary files created by R markdown 32 | *.utf8.md 33 | *.knit.md 34 | 35 | # Raw data I used for comparison 36 | *.xlsx 37 | -------------------------------------------------------------------------------- /.lintr: -------------------------------------------------------------------------------- 1 | linters: with_defaults( 2 | assignment_linter = NULL, 3 | commented_code_linter = NULL, 4 | line_length_linter(100), 5 | cyclocomp_linter(complexity_limit = 25) 6 | ) 7 | 8 | -------------------------------------------------------------------------------- /DESCRIPTION: -------------------------------------------------------------------------------- 1 | Package: surveymonkey 2 | Title: Fetch survey results from the SurveyMonkey API and turn them into tidy data.frames 3 | Version: 0.1.0.9000 4 | Authors@R: c( 5 | person("Matt", "Roumaya", role = c("aut", "cre"), email = "matthewroumaya@gmail.com"), 6 | person("Sam", "Firke", role = c("aut"), email = "samuel.firke@gmail.com"), 7 | person("Thomas J.", "Leeper", role = c("aut"), email = "thosjleeper@gmail.com", comment = c(ORCID = "0000-0003-4097-6326")), 8 | person("Dustin", "Pashouwer", role = "ctb", email = "dpashouwer@gmail.com")) 9 | Description: Provides access to the SurveyMonkey API for fetching survey results. 10 | Depends: R (>= 3.5.0) 11 | Imports: 12 | assertthat, 13 | dplyr (>= 0.7.0), 14 | tidyr (>= 1.0.0), 15 | purrr, 16 | httr, 17 | tibble, 18 | magrittr, 19 | tidyselect, 20 | rlang 21 | Suggests: 22 | httptest, 23 | testthat, 24 | withr 25 | License: MIT + file LICENSE 26 | Encoding: UTF-8 27 | LazyData: true 28 | RoxygenNote: 7.1.2 29 | URL: https://github.com/mattroumaya/surveymonkey 30 | BugReports: https://github.com/mattroumaya/surveymonkey/issues 31 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | YEAR: 2022 2 | COPYRIGHT HOLDER: surveymonkey authors 3 | -------------------------------------------------------------------------------- /LICENSE.md: -------------------------------------------------------------------------------- 1 | # MIT License 2 | 3 | Copyright (c) 2022 surveymonkey authors 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 | -------------------------------------------------------------------------------- /NAMESPACE: -------------------------------------------------------------------------------- 1 | # Generated by roxygen2: do not edit by hand 2 | 3 | export("%>%") 4 | export(browse_surveys) 5 | export(fetch_survey_obj) 6 | export(get_collectors) 7 | export(get_recipients) 8 | export(get_responses) 9 | export(get_token) 10 | export(parse_survey) 11 | export(set_token) 12 | export(sm_get) 13 | export(strip_html) 14 | importFrom(magrittr,"%>%") 15 | importFrom(rlang,.data) 16 | importFrom(utils,packageDescription) 17 | -------------------------------------------------------------------------------- /R/assemble.R: -------------------------------------------------------------------------------- 1 | #' Take a survey object and parses it into a tidy data.frame. 2 | #' 3 | #' @param surv_obj a survey, the result of a call to \code{fetch_survey_obj}. 4 | #' @param oauth_token Your OAuth 2.0 token. By default, retrieved from 5 | #' \code{get_token()}. 6 | #' @param ... additional arguments to pass on to \code{get_responses}. See the documentation 7 | #' \code{?get_responses} where these arguments are listed. 8 | #' 9 | #' @param fix_duplicates character if 'error', the default detection of duplicate data will result 10 | #' in an error being raised, otherwise allow the function to return. If 'keep' duplicate results 11 | #' will be retained, if 'drop' duplicates will be removed from the results. 12 | #' @return a data.frame (technically a \code{tibble}) with clean responses, one line per respondent. 13 | #' @importFrom rlang .data 14 | #' @export 15 | parse_survey <- function( 16 | surv_obj, oauth_token = get_token(), ..., 17 | fix_duplicates = c("error", "drop", "keep") 18 | ) { 19 | . <- NULL 20 | if (surv_obj$response_count == 0) { 21 | warning("No responses were returned for this survey. Has anyone responded yet?") 22 | return(data.frame(survey_id = as.numeric(surv_obj$id))) 23 | } 24 | 25 | respondents <- get_responses(surv_obj$id, oauth_token = oauth_token, ...) 26 | 27 | # Save response status to join later 28 | vals <- c("id", "response_status") 29 | response_status_list <- lapply(respondents, "[", vals) 30 | status <- do.call(rbind.data.frame, response_status_list) 31 | 32 | responses <- respondents %>% 33 | parse_respondent_list() 34 | 35 | question_combos <- parse_all_questions(surv_obj) 36 | 37 | # this join order matters 38 | # - putting q_combos on left yields the right ordering of columns in final result 39 | # the joining variables vary depending on question types present, 40 | # so can't hard-code. Thus squash message 41 | x <- suppressMessages(dplyr::full_join(question_combos, responses)) 42 | 43 | # ref: issue #74 44 | # assertion stops function from returning anything in the case of duplicates 45 | # to deal with this add parameter fix_duplicate where default behaviour is to error, but 46 | # can be set to allow the function to continue and return. 47 | fix_duplicates <- match.arg(fix_duplicates) 48 | if (fix_duplicates == "error") { 49 | x <- duplicate_error(x) 50 | } else if (fix_duplicates == "keep") { 51 | x <- duplicate_keep(x) 52 | } else { 53 | x <- duplicate_drop(x) 54 | } 55 | 56 | 57 | 58 | # questions with only simple answer types might not have some referenced columns, #46 59 | add_if_not_present <- c(choice_id = NA_character_, choice_position = NA_integer_) 60 | x <- x %>% 61 | tibble::add_column(!!!add_if_not_present[!names(add_if_not_present) %in% names(.)]) 62 | 63 | # 'type' and 'required' are created when question_type == 'demographic' 64 | # Drop them because it causes issues with duplicated rows per respondent_id 65 | # Reference Issue #27, Issue #62 66 | x$type <- NULL 67 | x$required <- NULL 68 | 69 | # Issue #73 - API added choice_metadata for certain question types. 70 | # Need to investigate further, but as of 11/2021, the addition is 71 | # preventing parse_survey() from working. 72 | x$choice_metadata <- NULL 73 | 74 | # Issue #57 - Star Ranking 75 | # - If rating labels are not used, choice_text appears blank. 76 | # - Need to recode so that choice_text is choice_position 77 | x <- x %>% 78 | dplyr::mutate(choice_text = dplyr::case_when( 79 | .data$choice_text == "" & 80 | .data$question_type == "matrix" & 81 | .data$question_subtype == "rating" ~ 82 | as.character(.data$choice_position), 83 | TRUE ~ .data$choice_text 84 | )) 85 | 86 | 87 | # If question type = Multiple Choice, include choice text + ID in the combined new columns 88 | 89 | x$q_unique_id <- apply( 90 | x %>% 91 | dplyr::select(.data$question_id, .data$row_id, .data$col_id, .data$other_id), 92 | 1, 93 | function(x) paste(stats::na.omit(x), collapse = "_") 94 | ) 95 | x$q_unique_id[ 96 | x$question_type == "multiple_choice" | x$question_subtype == "multi" & is.na(x$other_id) 97 | ] <- paste( 98 | x$q_unique_id[ 99 | x$question_type == "multiple_choice" | 100 | x$question_subtype == "multi" & is.na(x$other_id) 101 | ], 102 | x$choice_id[ 103 | x$question_type == "multiple_choice" | x$question_subtype == "multi" & is.na(x$other_id) 104 | ], 105 | sep = "_" 106 | ) 107 | 108 | x$combined_q_heading <- apply( 109 | x %>% 110 | dplyr::select(.data$heading, .data$row_text, .data$col_text, .data$other_text) %>% 111 | dplyr::mutate(row_text = ifelse(.data$row_text == "", NA, .data$row_text)), 112 | 1, 113 | function(x) paste(stats::na.omit(x), collapse = " - ") 114 | ) 115 | 116 | x <- x %>% 117 | dplyr::mutate( 118 | combined_q_heading = dplyr::case_when( 119 | .data$question_type == "multiple_choice" & 120 | is.na(.data$other_text) ~ 121 | paste(.data$combined_q_heading, .data$choice_text, sep = " - "), 122 | .data$question_type != "open_ended" & 123 | .data$question_subtype == "multi" & 124 | is.na(.data$other_text) ~ 125 | paste(.data$combined_q_heading, .data$choice_text, sep = " - "), 126 | TRUE ~ .data$combined_q_heading 127 | ) 128 | ) 129 | 130 | # combine open-response text and choice text into a single field to populate the eventual table 131 | x$answer <- dplyr::coalesce(x$response_text, x$choice_text) 132 | 133 | assertthat::assert_that( 134 | sum(!is.na(x$answer)) == (sum(!is.na(x$response_text)) + sum(!is.na(x$choice_text))), 135 | msg = paste0( 136 | "Uh oh, we failed to account for a combination of open-response text - ", 137 | file_bug_report_msg() 138 | ) 139 | ) 140 | 141 | static_vars <- setdiff(names(x), c( 142 | "heading", "question_id", "question_type", "question_subtype", 143 | "choice_position", "choice_text", "quiz_options", "choice_id", 144 | "other_id", "other_text", "row_text", "row_id", "description", 145 | "col_text", "response_text", "col_id", "q_unique_id", 146 | "combined_q_heading", "answer" 147 | )) 148 | 149 | final_x <- x %>% 150 | dplyr::select( 151 | tidyselect::all_of(static_vars), 152 | .data$combined_q_heading, .data$answer, .data$q_unique_id 153 | ) 154 | 155 | 156 | qid_text_crosswalk <- final_x %>% 157 | dplyr::distinct(.data$q_unique_id, .data$combined_q_heading) %>% 158 | dplyr::mutate(unique_text = de_duplicate_names(.data$combined_q_heading)) 159 | 160 | # did a full_join above to make sure that all questions [q_unique_ids] 161 | # are present in result even if no one answered them 162 | # but that means the spread will fail b/c there's more than one response 163 | # per q_unique_id for is.na(response_id) 164 | # Adjust for that to spread, then filter that out after spread 165 | final_x_real <- final_x %>% 166 | dplyr::filter(!is.na(.data$response_id)) 167 | 168 | final_x_dummy <- final_x %>% 169 | dplyr::filter(is.na(.data$response_id)) %>% 170 | dplyr::distinct(.data$q_unique_id) 171 | 172 | final_x <- dplyr::bind_rows(final_x_real, final_x_dummy) 173 | 174 | # spread wide 175 | # get column order to reset to after spread makes alphabetical 176 | col_names <- c( 177 | names(final_x)[!(names(final_x) %in% c("combined_q_heading", "answer", "q_unique_id"))], 178 | qid_text_crosswalk$unique_text 179 | ) 180 | 181 | out <- final_x %>% 182 | dplyr::select(-.data$combined_q_heading) %>% 183 | dplyr::mutate( 184 | # to spread unrepresented levels 185 | q_unique_id = factor(.data$q_unique_id, levels = qid_text_crosswalk$q_unique_id)) %>% 186 | tidyr::pivot_wider(names_from = .data$q_unique_id, values_from = .data$answer) %>% 187 | dplyr::filter(!is.na(.data$response_id)) 188 | 189 | # Takes spread-out results data.frame and turns multiple choice cols into factors. GH issue #12 190 | # Doing this within the main function so it can see crosswalk 191 | 192 | master_qs <- x %>% 193 | dplyr::distinct( 194 | .data$q_unique_id, .data$choice_id, 195 | .data$question_id, .data$choice_position, .data$choice_text 196 | ) 197 | 198 | # set a vector as a factor, if it has answer choices associated with its question id 199 | set_factor_levels <- function(vec, q_id) { 200 | 201 | # fetch possible answer choices given a question's text 202 | get_factor_levels <- function(q_id) { 203 | master_qs %>% 204 | dplyr::filter(.data$q_unique_id == q_id, !is.na(.data$choice_id)) %>% 205 | # appears to always come from API in order but don't want to assume 206 | dplyr::arrange(.data$choice_position) %>% 207 | dplyr::pull(.data$choice_text) %>% 208 | unique() # in case they loaded the same value twice as answer choices, #48 209 | } 210 | 211 | name_set <- get_factor_levels(q_id) 212 | if (length(name_set) == 0) { 213 | return(vec) 214 | } else { 215 | factor(vec, levels = name_set) 216 | } 217 | } 218 | out <- purrr::map2_dfc(out, names(out), set_factor_levels) 219 | 220 | # reset to text names instead of numbers 221 | # and then re-order to correct columns 222 | names(out)[(length(static_vars) + 1):length(names(out))] <- qid_text_crosswalk$unique_text[match( 223 | names(out)[(length(static_vars) + 1):length(names(out))], 224 | qid_text_crosswalk$q_unique_id 225 | )] 226 | out <- out[, col_names] 227 | out <- out %>% 228 | dplyr::arrange(dplyr::desc(.data$response_id)) %>% 229 | dplyr::rename(respondent_id = .data$response_id) 230 | 231 | # Join response status 232 | out <- out %>% 233 | dplyr::left_join(., status, by = c("respondent_id" = "id")) %>% 234 | dplyr::select( 235 | .data$survey_id, .data$collector_id, .data$respondent_id, 236 | .data$date_created, .data$date_modified, .data$response_status, 237 | tidyselect::everything() 238 | ) 239 | out 240 | } 241 | 242 | # Helper function for de-duplicating identical Q names 243 | # Input: the vector of names 244 | # Adapted from janitor::make_clean_names() 245 | de_duplicate_names <- function(x) { 246 | dupe_count <- vapply(seq_along(x), function(i) { 247 | sum(x[i] == x[1:i]) 248 | }, integer(1)) 249 | x[dupe_count > 1] <- paste( 250 | x[dupe_count > 1], dupe_count[dupe_count > 1], 251 | sep = "_" 252 | ) 253 | x 254 | } 255 | 256 | 257 | # does a data frame contain duplicate rows 258 | # @param x a data.frame 259 | # @return logical, TRUE if there are any duplicates in the data.frame 260 | contains_duplicates <- function(x) { 261 | sum(find_duplicates(x)) > 0 262 | } 263 | 264 | # @param x a data.frame 265 | # @return a logical vector of the duplicated rows 266 | find_duplicates <- function(x) { 267 | duplicated(dplyr::select_if(x, is.atomic)) 268 | } 269 | 270 | # @param x a data.frame 271 | duplicate_drop <- function(x) { 272 | ix_dupes <- find_duplicates(x) 273 | n_dupes <- sum(ix_dupes) 274 | if (n_dupes > 0) { 275 | warning( 276 | "There are ", n_dupes, " duplicate responses, duplicates are dropped in 277 | the results. Set fix_duplicates = 'keep' to retain them." 278 | ) 279 | } 280 | x[!ix_dupes, ] 281 | } 282 | 283 | # @param x a data.frame 284 | duplicate_keep <- function(x) { 285 | if (contains_duplicates(x)) { 286 | n_dupes <- sum(find_duplicates(x)) 287 | warning( 288 | "There are ", n_dupes, " duplicate responses, duplicates are retained in 289 | the results. Set fix_duplicates = 'drop' to remove them." 290 | ) 291 | } 292 | x 293 | } 294 | 295 | # Deal with duplicate data by throwing an error 296 | duplicate_error <- function(x) { 297 | # There should not be duplicate rows here, but putting this here in case of oddities like #27 298 | assertthat::assert_that(!contains_duplicates(x), 299 | msg = paste0( 300 | "There are duplicated rows in the responses.\n", 301 | "To proceed and retain duplicates, re-run this function with fix_duplicates = 'keep'\n", 302 | "To proceed with dropped duplicates, re-run with fix_duplicates = 'drop'\n", 303 | "If this is unexpected - ", 304 | file_bug_report_msg() 305 | ) 306 | ) 307 | x 308 | } 309 | -------------------------------------------------------------------------------- /R/browse_surveys.R: -------------------------------------------------------------------------------- 1 | #' browse_surveys 2 | #' 3 | #' Get the list of the user's surveys. 4 | #' 5 | #' This function calls the SurveyMonkey API using the current oauth token and returns 6 | #' a list of surveys filtered by the parameters entered. 7 | #' 8 | #' @param per_page Integer number to set the number of surveys to return per page. 9 | #' Maximum value is 1000 surveys per page; try that if your survey is not on the first 100, 10 | #' to reduce API calls. 11 | #' @param page Integer number to select which page of resources to return. By default is 1. 12 | #' @param sort_by String used to sort returned survey list: 13 | #' ‘title’, 'date_modified’, or 'num_responses’. By default, date_modified. 14 | #' @param sort_order String used to set the sort order for returned surveys: 15 | #' 'ASC’ or 'DESC’. By default, DESC. 16 | #' @param start_modified_at Date string used to select surveys last modified after this date. 17 | #' By default is NULL. 18 | #' @param end_modified_at Date string used to select surveys modified before this date. 19 | #' By default is NULL. 20 | #' @param title String used to select survey by survey title. By default is NULL. 21 | #' @param include Character vector as a comma separated string used to filter survey list: 22 | #' 'response_count’, 'date_created’, 'date_modified’, 'language’, 23 | #' 'question_count’, 'analyze_url’, 'preview’. 24 | #' By default is NULL. Use \code{browse_surveys('everything')} to pull all fields. 25 | #' @param folder_id Specify the id of a folder to only return surveys in it. 26 | #' @param oauth_token Your OAuth 2.0 token. 27 | #' By default, retrieved from \code{get_token()}. 28 | #' @return A list of objects of class \code{sm_survey}. 29 | #' @references SurveyMonkey API V3 at \url{https://developer.surveymonkey.com/api/v3/#surveys} 30 | #' @importFrom rlang .data 31 | #' @export 32 | browse_surveys <- function(per_page = 100, 33 | page = NULL, 34 | sort_by = NULL, 35 | sort_order = NULL, 36 | start_modified_at = NULL, 37 | end_modified_at = NULL, 38 | title = NULL, 39 | include = NULL, 40 | folder_id = NULL, 41 | oauth_token = get_token()) { 42 | 43 | u <- "https://api.surveymonkey.com/v3/surveys?" 44 | h <- standard_request_header(oauth_token) 45 | 46 | start_modified_at <- format_date(start_modified_at) 47 | end_modified_at <- format_date(end_modified_at) 48 | 49 | b <- list( 50 | page = page, 51 | per_page = per_page, 52 | sort_by = sort_by, 53 | sort_order = sort_order, 54 | start_modified_at = start_modified_at, 55 | end_modified_at = end_modified_at, 56 | title = title, 57 | include = include, 58 | folder_id = folder_id 59 | ) 60 | nulls <- sapply(b, is.null) 61 | if (all(nulls)) { 62 | b <- NULL 63 | } else { 64 | b <- b[!nulls] 65 | } 66 | 67 | if (!is.null(b$include)) { 68 | b$include <- paste(b$include, collapse = ",") 69 | 70 | if (b$include == "everything") { 71 | b$include <- paste(c( 72 | "response_count", 73 | "date_created", 74 | "date_modified", 75 | "language", 76 | "question_count", 77 | "analyze_url", 78 | "preview" 79 | ), 80 | collapse = "," 81 | ) 82 | } 83 | } 84 | 85 | if (!is.null(b)) { 86 | parsed_content <- sm_get(url = u, query = b, config = h) 87 | sl <- dplyr::bind_rows(parsed_content$data) 88 | dplyr::select( 89 | sl, 90 | .data$title, .data$id, url = .data$href, .data$nickname, 91 | tidyselect::everything() 92 | ) 93 | } else { 94 | stop("all query inputs are NULL. see ?browse_surveys for input details.") 95 | } 96 | } 97 | -------------------------------------------------------------------------------- /R/collectors.R: -------------------------------------------------------------------------------- 1 | #' get_collectors 2 | #' 3 | #' Get collectors for a SurveyMonkey survey 4 | #' 5 | #' @param survey_id The id of the survey whose collectors you want, 6 | #' find it with \code{\link{browse_surveys}}. 7 | #' @param page Integer number to select which page of resources to return. By default is 1. 8 | #' @param per_page Number of resources to return per page. 9 | #' @param all_pages Return all pages of respondents? 10 | #' Default is TRUE, which will fetch all responses (and cause n/100 calls to the API). 11 | #' @param oauth_token Your OAuth 2.0 token. 12 | #' By default, retrieved from \code{get_token()}. 13 | #' @param sort_by Column to sort by. Can be one of: id, date_modified, type, status, name. 14 | #' @param sort_order Sort data by the value in `sort_by`. Can be one of: ASC, DESC. 15 | #' @param name Nickname of collector to search against 16 | #' @param start_date Collectors must be created after this date. Date string in format YYYY-MM-DDTHH:MM:SS (no offset) 17 | #' @param end_date Collectors must be created before this date. Date string in format YYYY-MM-DDTHH:MM:SS (no offset) 18 | #' @param include Specify additional fields to return per collector. Can be one or more of: type, status, response_count, date_created, date_modified, url. Optionally, specify "everything" to return all possible fields. 19 | #' 20 | #' @return a data.frame (technically a \code{tibble}) with each collector and its information. 21 | #' 22 | #' @importFrom rlang .data 23 | #' 24 | #' @export 25 | 26 | get_collectors <- function(survey_id, 27 | page = 1, 28 | per_page = NULL, 29 | sort_by = NULL, 30 | sort_order = NULL, 31 | name = NULL, 32 | start_date = NULL, 33 | end_date = NULL, 34 | include = NULL, 35 | all_pages = TRUE, 36 | oauth_token = get_token()) { 37 | if (!is.null(include)){ 38 | include <- paste(include, collapse = ",") 39 | } 40 | 41 | if (!is.null(include) & "everything" %in% tolower(include)) { 42 | include <- "type,status,response_count,date_created,date_modified,url" 43 | } 44 | 45 | u <- paste("https://api.surveymonkey.net/v3/surveys/", survey_id, "/collectors/", sep = "") 46 | h <- standard_request_header(oauth_token) 47 | b <- list(page = page, 48 | per_page = per_page, 49 | sort_by = sort_by, 50 | sort_order = sort_order, 51 | name = name, 52 | start_date = start_date, 53 | end_date = end_date, 54 | include = include) 55 | nulls <- sapply(b, is.null) 56 | if (all(nulls)) { 57 | b <- NULL 58 | } else { 59 | b <- b[!nulls] 60 | } 61 | 62 | if(!is.null(b)){ 63 | parsed_content <- sm_get(url = u, query = b, config = h) 64 | 65 | collectors <- parsed_content$data 66 | 67 | collectors %>% 68 | dplyr::bind_rows() %>% 69 | dplyr::mutate(id = as.numeric(.data$id)) %>% 70 | return() 71 | } else { 72 | stop("all query inputs are NULL. see ?get_collectors for input details.") 73 | } 74 | } 75 | -------------------------------------------------------------------------------- /R/fetch_survey.R: -------------------------------------------------------------------------------- 1 | # Returns the details of a survey, to cut down on API calls 2 | 3 | #' Title 4 | #' 5 | #' @param id ID number of survey to be fetched. 6 | #' @param oauth_token Your OAuth 2.0 token. 7 | #' By default, retrieved from \code{get_token()}. 8 | #' 9 | #' @return a survey object, which is a nested list containing info about the survey. 10 | #' @export 11 | #' 12 | #' @examples 13 | #' # not run: 14 | #' # fetch_survey_obj(123456789) 15 | fetch_survey_obj <- function(id, 16 | oauth_token = get_token()) { 17 | if (missing(id)) { 18 | stop("specify an id") 19 | } 20 | 21 | u <- "https://api.surveymonkey.com/v3/surveys?" 22 | h <- standard_request_header(oauth_token) 23 | 24 | p <- list("v3", survey = "surveys", id = id, details = "details") 25 | 26 | parsed_content <- sm_get(url = u, query = NULL, config = h, path = p) 27 | 28 | parsed_content 29 | } 30 | -------------------------------------------------------------------------------- /R/get_responses.R: -------------------------------------------------------------------------------- 1 | #' get_responses 2 | #' 3 | #' Get responses for a SurveyMonkey survey 4 | #' 5 | #' @param id The survey's ID, can be found with \code{browse_survey()}. 6 | #' @param page Integer number to select which page of resources to return. By default is 1. 7 | #' @param all_pages return all pages of respondents? 8 | #' Default is TRUE, which will fetch all responses (and cause n/100 calls to the API). 9 | #' @param per_page Integer number to set the number of surveys to return per page. 10 | #' By default, is 100 surveys per page (appears to be the maximum allowed by the API). 11 | #' @param start_created_at Date string used to select surveys created after this date. 12 | #' By default is NULL. 13 | #' @param end_created_at Date string used to select surveys modified before this date. 14 | #' By default is NULL. 15 | #' @param start_modified_at Date string used to select surveys last modified after this date. 16 | #' By default is NULL. 17 | #' @param end_modified_at Date string used to select surveys modified before this date. 18 | #' By default is NULL. 19 | #' @param sort_order String used to set the sort order for returned surveys: 20 | #' 'ASC’ or 'DESC’. By default, DESC. 21 | #' @param sort_by String value of field used to sort returned survey list: 22 | #' ‘title’, 'date_modified’, or 'num_responses’. By default, date_modified. 23 | #' @param oauth_token Your OAuth 2.0 token. 24 | #' By default, retrieved from \code{get_token()}. 25 | #' @return A list of object of class {sm_response} 26 | #' @references SurveyMonkey API V3 at 27 | #' \url{https://developer.surveymonkey.com/api/v3/#survey-responses} 28 | #' @export get_responses 29 | # 30 | # get a set of bulk responses (this will get 100 responses with the following structure: 31 | # $per_page : int = total number of responses per page 32 | # $total : int = number of survey responses 33 | # $data[[x]] : list = list with an entry for each individual survey response 34 | # $total_time : int = time spent on the survey 35 | # $href : chr = api url for survey response 36 | # $custom_variables : list = custom variables for respondents 37 | # $ip_address : chr = IP address for respondent 38 | # $id : chr = id of survey response 39 | # $logic_path : list 40 | # $date_modified : chr = date survey response last modified 41 | # $response_status : chr = status of response {completed, partial, etc...} 42 | # $custom_value : chr = ? 43 | # $analyze_url : chr = web browsable url to view responses 44 | # $pages : list = list with data for questions and answers on each survey page 45 | # $id : chr = id 46 | # $ questions : list 47 | # $ id : chr = id 48 | # $ answers : list 49 | # $ choice_id : chr = id of answer choice 50 | # $page_path : list = ? 51 | # $recipient_id : chr = id of survey recipient 52 | # $collector_id : chr = id of survey collector 53 | # $date_created : chr = date the survey response was started 54 | # $survey_id : chr = id of the survey 55 | # $collection_mode : chr = ? 56 | # $edit_url : chr = web browsable url to modify responses 57 | # $metadata : list = list with additional information about respondent 58 | # $contact : list 59 | # $contact$first_name : list 60 | # $contact$first_name$type : chr = type for first_name$value variable 61 | # $contact$first_name$value : chr = respondent first name 62 | # $contact$last_name : list 63 | # $contact$last_name$type : chr = type for last_name$value variable 64 | # $contact$lasy_name$value : chr = respondent last name 65 | # $contact$email : list 66 | # $contact$email$type : chr = type for email variable 67 | # $contact$email$value : chr = respondent email address 68 | # $page : int = page of responses 69 | # $links : list = urls for the previous ($last), current ($self) and next ($next) response pages 70 | # ) 71 | 72 | 73 | 74 | get_responses <- function(id, 75 | page = 1, 76 | all_pages = TRUE, 77 | per_page = 100, 78 | start_created_at = NULL, 79 | end_created_at = NULL, 80 | start_modified_at = NULL, 81 | end_modified_at = NULL, 82 | sort_order = "DESC", 83 | sort_by = "date_modified", 84 | oauth_token = get_token()) { 85 | 86 | u <- paste("https://api.surveymonkey.net/v3/surveys/", id, "/responses/bulk?", sep = "") 87 | h <- standard_request_header(oauth_token) 88 | 89 | start_created_at <- format_date(start_created_at) 90 | end_created_at <- format_date(end_created_at) 91 | start_modified_at <- format_date(start_modified_at) 92 | end_modified_at <- format_date(end_modified_at) 93 | 94 | b <- list( 95 | page = page, 96 | per_page = per_page, 97 | start_created_at = start_created_at, 98 | end_created_at = end_created_at, 99 | start_modified_at = start_modified_at, 100 | end_modified_at = end_modified_at, 101 | sort_order = sort_order, 102 | sort_by = sort_by 103 | ) 104 | nulls <- sapply(b, is.null) 105 | if (all(nulls)) { 106 | b <- NULL 107 | } else { 108 | b <- b[!nulls] 109 | } 110 | 111 | parsed_content <- sm_get(url = u, query = b, config = h) 112 | 113 | responses <- parsed_content$data 114 | 115 | # recursively get all responses if all_pages = TRUE 116 | if (all_pages == TRUE & (!is.null(parsed_content$links[["next"]]))) { 117 | rnext <- get_responses(id, 118 | page = page + 1, 119 | all_pages, 120 | per_page, 121 | start_created_at, 122 | end_created_at, 123 | start_modified_at, 124 | end_modified_at, 125 | sort_order, 126 | sort_by, 127 | oauth_token = oauth_token 128 | ) 129 | responses <- c(responses, rnext) 130 | } 131 | responses 132 | } 133 | -------------------------------------------------------------------------------- /R/import_pipe.R: -------------------------------------------------------------------------------- 1 | # Copied from tidyr/R/utils.R, to export the magrittr pipe 2 | 3 | #' Pipe operator 4 | #' 5 | #' @description Exported from the magrittr package. To learn more, run \code{?magrittr::`\%>\%`}. 6 | #' 7 | #' @name %>% 8 | #' @rdname pipe 9 | #' @keywords internal 10 | #' @export 11 | #' @importFrom magrittr %>% 12 | #' @usage lhs \%>\% rhs 13 | NULL 14 | -------------------------------------------------------------------------------- /R/question_parsers.R: -------------------------------------------------------------------------------- 1 | parse_page_of_questions <- function(page) { 2 | purrr::map_df(page$questions, parse_question_info) 3 | } 4 | 5 | #' @importFrom rlang .data 6 | parse_all_questions <- function(surv_obj) { 7 | out_q <- purrr::map_df(surv_obj$pages, parse_page_of_questions) %>% 8 | dplyr::filter(!.data$question_type %in% "presentation") 9 | 10 | # Add columns required later if they weren't present, e.g., no "Other" options offered 11 | # code adapted from https://stackoverflow.com/a/45858044 12 | cols_to_require <- c("col_text", "other_text", "choice_text", "row_text") 13 | add <- cols_to_require[!cols_to_require %in% names(out_q)] 14 | if (length(add) != 0) out_q[add] <- NA_character_ 15 | 16 | # remove "weight" and "description" columns if present, they appear to come from some ranking 17 | # matrix questions and don't have a place in a CSV, given that choice text will appear. 18 | out_q$description <- NULL 19 | out_q$weight <- NULL 20 | out_q 21 | } 22 | 23 | 24 | #' @importFrom rlang .data 25 | # New function per #21 to grab all Q+A info at once 26 | parse_question_info <- function(ques) { 27 | 28 | # Fixes issue 65 - this was caused by an image/presentation type not having a value for 'heading' 29 | if (is.null(ques$headings[[1]]$heading)) { 30 | ques$headings[[1]]$heading <- NA_character_ 31 | } 32 | 33 | # get top-level info 34 | q_info <- tibble::tibble( 35 | heading = ques$headings[[1]]$heading, 36 | question_id = ques$id, 37 | question_type = ques$family, 38 | question_subtype = ques$subtype 39 | ) 40 | 41 | cols <- parse_cols(ques) 42 | rows <- parse_rows(ques) 43 | rows$position <- NULL # in the way right now so removing if exists 44 | other <- parse_other(ques) 45 | 46 | # choices live in cols if cols exists, so pull them out - not positive about this. 47 | if (!is.null(cols)) { 48 | choices <- cols %>% 49 | dplyr::select( 50 | .data$choice_id, .data$choice_text, 51 | choice_position = .data$position, .data$col_id 52 | ) 53 | cols <- cols %>% 54 | dplyr::select(-.data$choice_id, -.data$choice_text, -.data$position) %>% 55 | dplyr::distinct(.keep_all = TRUE) 56 | } else { # otherwise get choices from the other place they live 57 | choices <- parse_choices(ques) 58 | } 59 | 60 | # join them 61 | # then will join with responses on unique ID (Q/row/col) & choice_id 62 | out <- q_info 63 | if (!is.null(rows)) { 64 | out <- merge(out, rows) 65 | } 66 | if (!is.null(cols)) { 67 | out <- merge(out, cols) 68 | } 69 | if (!is.null(choices)) { 70 | out <- merge(out, choices) 71 | } 72 | if (!is.null(other)) { 73 | out <- dplyr::bind_rows(out, other) %>% 74 | tidyr::fill(.data$heading:.data$question_subtype) 75 | } 76 | 77 | tibble::as_tibble(out) 78 | } 79 | 80 | ## These functions below are called by parse_question_info 81 | 82 | #' @importFrom rlang .data 83 | # Takes one col, returns data.frame 84 | parse_cols <- function(ques) { 85 | #' @importFrom rlang .data 86 | get_single_col_info <- function(col) { 87 | dplyr::bind_rows(col$choices) %>% 88 | dplyr::rename(choice_id = .data$id, choice_text = .data$text) %>% 89 | dplyr::mutate( 90 | col_id = col$id, 91 | col_text = col$text 92 | ) %>% 93 | dplyr::select(-.data$visible, -.data$is_na) 94 | } 95 | if (!is.null(ques$answers$cols)) { 96 | cols <- purrr::map_df(ques$answers$cols, get_single_col_info) 97 | } else { 98 | cols <- NULL 99 | } 100 | cols 101 | } 102 | 103 | #' @importFrom rlang .data 104 | parse_rows <- function(question) { 105 | if (!is.null(question$answers$rows)) { 106 | rows <- dplyr::bind_rows(question$answers$rows) %>% 107 | dplyr::rename(row_id = .data$id, row_text = .data$text) %>% 108 | dplyr::select(-.data$visible) 109 | } else { 110 | rows <- NULL 111 | } 112 | rows 113 | } 114 | 115 | #' @importFrom rlang .data 116 | parse_choices <- function(question) { 117 | if (!is.null(question$answers$choices)) { 118 | choices <- dplyr::bind_rows(question$answers$choices) %>% 119 | dplyr::rename( 120 | choice_id = .data$id, choice_text = .data$text, 121 | choice_position = .data$position 122 | ) %>% 123 | dplyr::select(-.data$visible) 124 | choices$is_na <- NULL # won't always exist, remove if it does 125 | } else { 126 | choices <- NULL 127 | } 128 | choices 129 | } 130 | 131 | #' @importFrom rlang .data 132 | parse_other <- function(question) { 133 | if (!is.null(question$answers$other)) { 134 | other <- dplyr::bind_rows(question$answers$other) %>% 135 | dplyr::rename(other_id = .data$id, other_text = .data$text) %>% 136 | # don't think we'll need columns besides these 137 | dplyr::select(.data$other_id, .data$other_text) 138 | } else { 139 | other <- NULL 140 | } 141 | other 142 | } 143 | -------------------------------------------------------------------------------- /R/recipients.R: -------------------------------------------------------------------------------- 1 | #' get_recipients 2 | #' 3 | #' Get recipients for a SurveyMonkey collector. Only valid when recipients are contacted via SurveyMonkey 4 | #' (e.g., sending a survey invitation from SurveyMonkey). 5 | #' @param collector_id the collector whose responses you want, 6 | #' find this value with \code{\link{get_collectors}}. 7 | #' @param page Integer to select which page of resources to return. By default is 1. 8 | #' @param per_page How many recipients per page? Default is 50, which appears to be the maximum. 9 | #' @param all_pages return all pages of respondents? 10 | #' Default is TRUE, which will fetch all responses (and cause n/50 calls to the API). 11 | #' @param oauth_token Your OAuth 2.0 token. 12 | #' By default, retrieved from \code{get_token()}. 13 | #' @return a data.frame (technically a \code{tibble}) with each collector and its information. 14 | #' @importFrom rlang .data 15 | #' @export 16 | #' 17 | ## TODO: incorporate the rest of the args from the API 18 | get_recipients <- function(collector_id, 19 | page = 1, 20 | per_page = 50, 21 | all_pages = TRUE, 22 | oauth_token = get_token()) { 23 | 24 | u <- paste("https://api.surveymonkey.net/v3/collectors/", collector_id, "/recipients/", sep = "") 25 | h <- standard_request_header(oauth_token) 26 | 27 | b <- list( 28 | page = page, 29 | include = c("survey_link") 30 | ) 31 | nulls <- sapply(b, is.null) 32 | if (all(nulls)) { 33 | b <- NULL 34 | } else { 35 | b <- b[!nulls] 36 | } 37 | 38 | parsed_content <- sm_get(url = u, query = b, config = h) 39 | 40 | recipients <- parsed_content$data 41 | 42 | # recursively get all recipients if all_pages = TRUE 43 | if (all_pages == TRUE & (!is.null(parsed_content$links[["next"]]))) { 44 | rnext <- get_recipients(collector_id, 45 | page = page + 1, 46 | per_page = per_page, 47 | all_pages = all_pages 48 | ) 49 | recipients <- c(recipients, rnext) 50 | } 51 | 52 | recipients %>% 53 | dplyr::bind_rows() %>% 54 | dplyr::mutate(id = as.numeric(.data$id)) %>% 55 | return() 56 | } 57 | -------------------------------------------------------------------------------- /R/request_utils.R: -------------------------------------------------------------------------------- 1 | standard_request_header = function(token) { 2 | token = get_bearer_token(token) 3 | httr::add_headers( 4 | Authorization = token, 5 | "Content-Type" = "application/json" 6 | ) 7 | } 8 | 9 | #' Get request for survey monkey API 10 | #' 11 | #' Will always set the mattroumaya/surveymonkey repo as the user agent 12 | #' 13 | #' @param url character, url to send request to 14 | #' @param query character, components of the url to change for request arguments, 15 | #' see also \code{?httr::modify_url}, \link[httr]{modify_url} 16 | #' @param config see \code{?httr::config}, \link[httr]{config}, for full details. 17 | #' Additional configuration settings such as http additional headers. 18 | #' @param ... additional argument passed to \code{httr::GET} \link[httr]{GET}. 19 | #' @export 20 | sm_get = function(url, query, config, ...) { 21 | out = httr::GET( 22 | url, 23 | config = config, 24 | query = query, 25 | httr::user_agent("http://github.com/mattroumaya/surveymonkey"), 26 | ... 27 | ) 28 | 29 | httr::stop_for_status(out) 30 | 31 | remaining_request_message(out) 32 | reset_time_message(out) 33 | 34 | httr::content(out, as = "parsed") 35 | } 36 | 37 | remaining_request_message = function(response) { 38 | if(length(response$headers$`x-ratelimit-app-global-day-remaining`>0)) { 39 | message(paste0( 40 | "You have ", 41 | response$headers$`x-ratelimit-app-global-day-remaining`, 42 | " requests left today before you hit the limit" 43 | )) 44 | } else { 45 | warning("Could not determine API request limit") 46 | } 47 | } 48 | 49 | reset_time_message = function(response, frequency = 20) { 50 | if(length(response$headers$`x-ratelimit-app-global-day-remaining`>0)) { 51 | if (as.numeric(response$headers$`x-ratelimit-app-global-day-remaining`) %% frequency == 0) { 52 | message(paste0( 53 | "Your daily request limit will reset in ", 54 | response$headers$`X-Ratelimit-App-Global-Day-Reset`, 55 | " seconds" 56 | )) 57 | } 58 | } else { 59 | warning("Could not determine API request limit") 60 | } 61 | } 62 | -------------------------------------------------------------------------------- /R/response_parsers.R: -------------------------------------------------------------------------------- 1 | parse_single_answer <- function(answer) { 2 | # remove length-zero items as an initial fix to #38; 3 | if (!is.null(answer$tag_data)) { 4 | answer$tag_data <- NULL 5 | } 6 | 7 | dplyr::bind_rows(answer) 8 | } 9 | 10 | parse_answers <- function(question) { 11 | out_a <- purrr::map_df(question$answers, parse_single_answer) %>% 12 | dplyr::mutate(question_id = question$id) 13 | 14 | out_a 15 | } 16 | 17 | parse_page <- function(page) { 18 | purrr::map_df(page$questions, parse_answers) 19 | } 20 | 21 | parse_response <- function(response) { 22 | . <- NULL 23 | out <- purrr::map_df(response$pages, parse_page) %>% 24 | dplyr::mutate( 25 | response_id = response$id, 26 | collector_id = response$collector_id, 27 | survey_id = response$survey_id, 28 | date_created = as.POSIXct(response$date_created, tz = "UTC", format = "%Y-%m-%dT%H:%M:%OS"), 29 | date_modified = as.POSIXct(response$date_modified, tz = "UTC", format = "%Y-%m-%dT%H:%M:%OS"), 30 | recipient_id = dplyr::if_else( 31 | response$recipient_id == "", 32 | NA_character_, 33 | response$recipient_id 34 | ) 35 | ) 36 | 37 | if (length(response$ip_address) > 0 & response$ip_address != "") { 38 | out$ip_address <- response$ip_address 39 | } 40 | if (length(response$custom_variables) > 0) { 41 | out <- merge(out, dplyr::bind_rows(response$custom_variables)) 42 | } 43 | if (length(response$metadata) > 0 & sum(vapply(response$metadata, length, 1)) > 0) { 44 | metdata_vars <- unlist(response$metadata) 45 | metdata_vars <- metdata_vars[grepl(".value$", names(metdata_vars))] 46 | metdata_vars_df <- dplyr::bind_rows(metdata_vars) 47 | names(metdata_vars_df) <- names(metdata_vars_df) %>% 48 | gsub("^[A-z]+\\.", "", .) %>% 49 | gsub(".value$", "", .) 50 | out <- merge(out, metdata_vars_df) 51 | } 52 | out 53 | } 54 | 55 | #' @importFrom rlang .data 56 | parse_respondent_list <- function(respondents) { 57 | out_resps <- purrr::map_df(respondents, parse_response) 58 | if (!"other_id" %in% names(out_resps)) { 59 | out_resps$other_id <- NA_character_ 60 | } 61 | if (!"text" %in% names(out_resps)) { 62 | out_resps$text <- NA_character_ 63 | } 64 | if (!"row_id" %in% names(out_resps)) { 65 | out_resps$row_id <- NA_character_ 66 | } 67 | if (!"col_id" %in% names(out_resps)) { 68 | out_resps$col_id <- NA_character_ 69 | } 70 | 71 | out_resps <- out_resps %>% 72 | dplyr::rename(response_text = .data$text) %>% 73 | dplyr::select( 74 | .data$survey_id, .data$collector_id, .data$recipient_id, .data$response_id, 75 | tidyselect::everything() 76 | ) %>% 77 | dplyr::mutate(survey_id = as.numeric(.data$survey_id)) 78 | 79 | if (all(is.na(out_resps$recipient_id))) { 80 | out_resps$recipient_id <- NULL 81 | } 82 | 83 | out_resps 84 | } 85 | -------------------------------------------------------------------------------- /R/strip_html.r: -------------------------------------------------------------------------------- 1 | #' @title strip_html 2 | #' 3 | #' @description 4 | #' Remove all values between "<>", which are typically HTML tags. 5 | #' 6 | #' @param dat a data.frame. 7 | #' @param ignore a character vector containing values to ignore while stripping HTML tags. 8 | #' For instance, if you have and in your column names, 9 | #' add ignore = c("keep me", "me too"). 10 | #' @param trim_space logical, if TRUE trim extra white space 11 | #' 12 | #' 13 | #' @return a data.frame object. 14 | #' 15 | #' @examples 16 | #' \dontrun{ 17 | #' fetch_survey_obj(1234567890) %>% 18 | #' parse_survey() %>% 19 | #' strip_html() 20 | #' } 21 | #' 22 | #' @export 23 | strip_html <- function(dat, 24 | ignore = NULL, 25 | trim_space = TRUE) { 26 | regex_escape <- function(string) { 27 | gsub("([][{}()+*^$|\\\\?.])", "\\\\\\1", string) 28 | } 29 | 30 | if (is.null(ignore)) { 31 | check_ignore <- "" 32 | names(dat) <- gsub("(<[^>]*>)", "", names(dat)) 33 | } else { 34 | check_ignore <- paste(ignore, collapse = "|") 35 | } 36 | 37 | if (!is.null(ignore) & !any(grepl(check_ignore, names(dat)))) { 38 | warning("None of your ignored values were found. All text between <> will be removed.") 39 | } 40 | 41 | if (!is.null(ignore)) { 42 | names(dat) <- gsub(paste0( 43 | "<(?!(?:", 44 | paste( 45 | regex_escape(ignore), 46 | collapse = "|" 47 | ), 48 | ")>)[^>]*>" 49 | ), "", names(dat), perl = TRUE) 50 | } 51 | 52 | if (trim_space == TRUE) { 53 | names(dat) <- trimws(gsub("\\s+", " ", names(dat))) 54 | } 55 | 56 | return(dat) 57 | } 58 | -------------------------------------------------------------------------------- /R/token_utils.r: -------------------------------------------------------------------------------- 1 | #' Set Survey Monkey Oauth Token 2 | #' 3 | #' Sets the option 'sm_oauth_token' for the survey monkey API. 4 | #' Token will be used for authorization headers for requests. 5 | #' 6 | #' @param oauth_token Your survey monkey OAuth 2.0 token. 7 | #' @export 8 | set_token = function(oauth_token) { 9 | options("sm_oauth_token" = oauth_token) 10 | } 11 | 12 | #' Retrieve set Survey Monkey OAuth Token 13 | #' 14 | #' Retrieves the currently set survey monkey oauth token 15 | #' @export 16 | get_token = function() { 17 | getOption("sm_oauth_token") 18 | } 19 | 20 | 21 | get_bearer_token = function(oauth_token = NULL) { 22 | if (is.null(oauth_token)) { 23 | stop( 24 | "Must specify 'oauth_token'. 25 | See https://github.com/mattroumaya/surveymonkey#authentication for more info." 26 | ) 27 | } 28 | paste("bearer", oauth_token) 29 | } 30 | -------------------------------------------------------------------------------- /R/utils.R: -------------------------------------------------------------------------------- 1 | # Generate a suggestion to submit a bug report at a specific URL 2 | # This is a function so that it can be easily changed if the repo URL changes 3 | 4 | #' @importFrom utils packageDescription 5 | file_bug_report_msg <- function() { 6 | paste("file a bug report at", packageDescription("surveymonkey")$BugReports) 7 | } 8 | 9 | format_date = function(date) { 10 | if (inherits(date, "POSIXct") | inherits(date, "Date")) { 11 | date <- format(date, "%Y-%m-%d %H:%M:%S", tz = "UTC") 12 | } 13 | date 14 | } 15 | -------------------------------------------------------------------------------- /README.Rmd: -------------------------------------------------------------------------------- 1 | --- 2 | output: 3 | github_document 4 | --- 5 | 6 | 7 | 8 | ```{r, include = FALSE} 9 | knitr::opts_chunk$set( 10 | collapse = TRUE, 11 | comment = "#>", 12 | fig.path = "man/figures/README-", 13 | out.width = "100%" 14 | ) 15 | ``` 16 | # surveymonkey :clipboard: :monkey: 17 | 18 | 19 | [![codecov.io](https://codecov.io/github/mattroumaya/surveymonkey/coverage.svg?branch=master)](https://codecov.io/github/mattroumaya/surveymonkey?branch=master) 20 | [![lifecycle](https://img.shields.io/badge/lifecycle-experimental-orange.svg)](https://www.tidyverse.org/lifecycle/#experimental) 21 | [![R build status](https://github.com/mattroumaya/surveymonkey/workflows/R-CMD-check/badge.svg)](https://github.com/mattroumaya/surveymonkey) 22 | 23 | 24 | This package provides access from R to the SurveyMonkey API. You can browse your surveys, pick one to fetch, and then, most importantly, parse the fetched JSON result into a tidy data.frame. 25 | 26 | ### Why this is useful 27 | 28 | Compared to downloading .csv files manually: 29 | 30 | - No fussing with the web browser or logging in 31 | - Column names are handled appropriately - not split over two rows 32 | - The columns are factors when appropriate, with the levels ordered based on the sequence the answers appear in the survey. 33 | - And they have knowledge of all choices that were offered on the survey, even if they're missing from the data because no one selected them. These values would be absent from a .csv download. 34 | 35 | #### Project status 36 | 37 | **What's working:** 38 | 39 | - All responses are pulled. 40 | - All metadata like custom variables and response start/end timestamps. 41 | - All substantive question types should be currently implemented. 42 | - Collector and recipient information can be retrieved. 43 | 44 | This is confirmed to work for paid plans at the Advantage and Premier levels. As of March 2022, it appears that standard & basic (free) plans are granted API access with some limitations. Please feel free to open an issue or submit a PR to update documentation if permissions change, or if you have specific insight about API access based on type of account. 45 | 46 | 47 | **What's missing:** Some uncommon question types may not yet be accounted for. E.g., image or upload question types are untested. 48 | 49 | If you have a use case for something that isn't currently pulled through, please open an issue describing your situation & question type. 50 | 51 | ### Authors 52 | 53 | The [first version of this package](https://github.com/cloudyr/Rmonkey) was written by Thomas Leeper. It worked with version 2 of the SurveyMonkey API. 54 | 55 | After SurveyMonkey's change to v3 of their API broke the package, it was rewritten by employees of [TNTP](https://tntp.org), a nonprofit company working to end the injustice of educational inequality. 56 | 57 | Matt Roumaya took over from TNTP as the de facto maintainer in 2021 and, in 2022, became the official maintainer of the package, keeping it going into another stage of its life. 58 | 59 | 60 | ## Installation 61 | 62 | This package is not yet on CRAN. Install from GitHub with: 63 | 64 | ``` r 65 | # install.packages("devtools") 66 | devtools::install_github("mattroumaya/surveymonkey") 67 | ``` 68 | 69 | ## Usage 70 | 71 | ### Authentication 72 | 73 | *Have an opinion about OAuth procedures? If you can improve this guidance, please open an issue with your suggestions.* 74 | 75 | #### Get your OAuth token 76 | 77 | You'll need an OAuth token, and for that you'll need to set up an app. 78 | 79 | Log in to SurveyMonkey in your browser, then navigate to https://developer.surveymonkey.com/apps. Create an app. It should be private, and you should enable the relevant scopes: View Surveys, View Collectors, View Contacts, View Responses, View Response Details. (That should do it, but if you get a 403 error when you try to browse surveys, try enabling other relevant scopes). You don't need to click "deploy", as long as the setting selected have been updated you're set. 80 | 81 | Now look at the settings page for your app and take note of the "Access Token" field, which should contain a very long character string. 82 | 83 | #### Add your OAuth token to your .Rprofile 84 | 85 | Add the SurveyMonkey account's OAuth token to your .Rprofile file. To open and edit that file, run `usethis::edit_r_profile()`, then add a line like this: 86 | `options(sm_oauth_token = "kmda332fkdlakfld8am7ml3dafka-dafknalkfmalkfad-THIS IS NOT THE REAL KEY THOUGH")`. 87 | 88 | Except use the OAuth token listed on your app's settings page, obtained in the previous step. 89 | 90 | Restart R for this change to take effect. 91 | 92 | If this is all set up successfully, the token will print when you run `getOption("sm_oauth_token")`. Guard this token: don't share it and don't commit it in any repository. 93 | 94 | *Developer's note: That's how a user can get a single account's OAuth token. It might be preferable if users could authenticate from within R. If someone has guidance for how users should obtain their OAuth token more generally, please submit a pull request or comment in an issue.* 95 | 96 | 97 | ### Browsing your surveys 98 | 99 | You'll need the ID number of the survey you wish to fetch. Find it by browsing your surveys like this: 100 | ```{r, eval = FALSE} 101 | surveys <- browse_surveys(200) # see your most recent 200 surveys 102 | ``` 103 | Then run `View(surveys)` and start typing the name of the survey you want into the search window at the top right of the RStudio data.frame viewer. That will get you the survey's ID number. Copy it. 104 | 105 | ### Fetching a survey 106 | 107 | Get the survey data like this: 108 | ```{r, eval=FALSE } 109 | a_survey_obj <- fetch_survey_obj(123456789) # your survey's ID goes here 110 | ``` 111 | 112 | This returns a list of data about the survey. It's useful for developers to explore, but not so much for most users. Keep going to the next step. 113 | 114 | ### Parsing the survey into a data.frame 115 | 116 | This is the actual good part. 117 | ```{r, eval = FALSE} 118 | survey_df <- parse_survey(a_survey_obj) 119 | ``` 120 | 121 | That will give you a tidy data.frame with all of your responses. 122 | 123 | In the future you can run it all as one command: 124 | 125 | ```{r, eval = FALSE} 126 | survey_df <- 123456789 %>% 127 | fetch_survey_obj %>% 128 | parse_survey 129 | ``` 130 | 131 | ### Retrieving recipient and collector data 132 | 133 | This is handy for tracking who has completed a survey and managing reminder messages. Or retrieving a 134 | recipient's unique survey link, if you're sending invitation through an email collector. 135 | 136 | Get a survey's collector information, including collector IDs: 137 | ```{r, eval = FALSE} 138 | collectors <- get_collectors(123456789) 139 | ``` 140 | 141 | Then fetch a collector's recipient info: 142 | ```{r, eval = FALSE} 143 | recipients <- get_recipients(234567890) # use a collector ID retrieved in the previous step 144 | ``` 145 | 146 | ### Removing HTML tags from column names 147 | 148 | If your question text has bold font or other formatting, an HTML tag will likely carry through. You can remove any text between "<" and ">" with `strip_html()`. 149 | 150 | ```{r, eval = FALSE} 151 | survey_df <- 123456789 %>% 152 | fetch_survey_obj %>% 153 | parse_survey %>% 154 | strip_html 155 | ``` 156 | 157 | 158 | ## API considerations 159 | Your account will likely be limited to 500 hits per day to the API. This package will print reminders of how many calls you have left in the day. The main thing to keep an eye on is respondent counts; as only 100 responses can be fetched per API call, a survey with X respondents will make at least X/100 calls to the API. 160 | 161 | 162 | # Contact 163 | 164 | Something may not work, because this is an in-development package. Or you may have an idea for something that hasn't been implemented yet. In either case, please create an issue in the GitHub issue tracker! 165 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | # surveymonkey :clipboard: :monkey: 5 | 6 | 7 | 8 | [![codecov.io](https://codecov.io/github/mattroumaya/surveymonkey/coverage.svg?branch=master)](https://codecov.io/github/mattroumaya/surveymonkey?branch=master) 9 | [![lifecycle](https://img.shields.io/badge/lifecycle-experimental-orange.svg)](https://www.tidyverse.org/lifecycle/#experimental) 10 | [![R build 11 | status](https://github.com/mattroumaya/surveymonkey/workflows/R-CMD-check/badge.svg)](https://github.com/mattroumaya/surveymonkey) 12 | 13 | 14 | This package provides access from R to the SurveyMonkey API. You can 15 | browse your surveys, pick one to fetch, and then, most importantly, 16 | parse the fetched JSON result into a tidy data.frame. 17 | 18 | ### Why this is useful 19 | 20 | Compared to downloading .csv files manually: 21 | 22 | - No fussing with the web browser or logging in 23 | - Column names are handled appropriately - not split over two rows 24 | - The columns are factors when appropriate, with the levels ordered 25 | based on the sequence the answers appear in the survey. 26 | - And they have knowledge of all choices that were offered on the 27 | survey, even if they’re missing from the data because no one 28 | selected them. These values would be absent from a .csv 29 | download. 30 | 31 | #### Project status 32 | 33 | **What’s working:** 34 | 35 | - All responses are pulled. 36 | - All metadata like custom variables and response start/end 37 | timestamps. 38 | - All substantive question types should be currently implemented. 39 | - Collector and recipient information can be retrieved. 40 | 41 | This is confirmed to work for paid plans at the Advantage and Premier 42 | levels. As of March 2022, it appears that standard & basic (free) plans 43 | are granted API access with some limitations. Please feel free to open 44 | an issue or submit a PR to update documentation if permissions change, 45 | or if you have specific insight about API access based on type of 46 | account. 47 | 48 | **What’s missing:** Some uncommon question types may not yet be 49 | accounted for. E.g., image or upload question types are untested. 50 | 51 | If you have a use case for something that isn’t currently pulled 52 | through, please open an issue describing your situation & question type. 53 | 54 | ### Authors 55 | 56 | The [first version of this package](https://github.com/cloudyr/Rmonkey) 57 | was written by Thomas Leeper. It worked with version 2 of the 58 | SurveyMonkey API. 59 | 60 | After SurveyMonkey’s change to v3 of their API broke the package, it was 61 | rewritten by employees of [TNTP](https://tntp.org), a nonprofit company 62 | working to end the injustice of educational inequality. 63 | 64 | Matt Roumaya took over from TNTP as the de facto maintainer in 2021 and, 65 | in 2022, became the official maintainer of the package, keeping it going 66 | into another stage of its life. 67 | 68 | ## Installation 69 | 70 | This package is not yet on CRAN. Install from GitHub with: 71 | 72 | ``` r 73 | # install.packages("devtools") 74 | devtools::install_github("mattroumaya/surveymonkey") 75 | ``` 76 | 77 | ## Usage 78 | 79 | ### Authentication 80 | 81 | *Have an opinion about OAuth procedures? If you can improve this 82 | guidance, please open an issue with your suggestions.* 83 | 84 | #### Get your OAuth token 85 | 86 | You’ll need an OAuth token, and for that you’ll need to set up an app. 87 | 88 | Log in to SurveyMonkey in your browser, then navigate to 89 | . Create an app. It should be 90 | private, and you should enable the relevant scopes: View Surveys, View 91 | Collectors, View Contacts, View Responses, View Response Details. (That 92 | should do it, but if you get a 403 error when you try to browse surveys, 93 | try enabling other relevant scopes). You don’t need to click “deploy”, 94 | as long as the setting selected have been updated you’re set. 95 | 96 | Now look at the settings page for your app and take note of the “Access 97 | Token” field, which should contain a very long character string. 98 | 99 | #### Add your OAuth token to your .Rprofile 100 | 101 | Add the SurveyMonkey account’s OAuth token to your .Rprofile file. To 102 | open and edit that file, run `usethis::edit_r_profile()`, then add a 103 | line like this: 104 | `options(sm_oauth_token = "kmda332fkdlakfld8am7ml3dafka-dafknalkfmalkfad-THIS IS NOT THE REAL KEY THOUGH")`. 105 | 106 | Except use the OAuth token listed on your app’s settings page, obtained 107 | in the previous step. 108 | 109 | Restart R for this change to take effect. 110 | 111 | If this is all set up successfully, the token will print when you run 112 | `getOption("sm_oauth_token")`. Guard this token: don’t share it and 113 | don’t commit it in any repository. 114 | 115 | *Developer’s note: That’s how a user can get a single account’s OAuth 116 | token. It might be preferable if users could authenticate from within R. 117 | If someone has guidance for how users should obtain their OAuth token 118 | more generally, please submit a pull request or comment in an issue.* 119 | 120 | ### Browsing your surveys 121 | 122 | You’ll need the ID number of the survey you wish to fetch. Find it by 123 | browsing your surveys like this: 124 | 125 | ``` r 126 | surveys <- browse_surveys(200) # see your most recent 200 surveys 127 | ``` 128 | 129 | Then run `View(surveys)` and start typing the name of the survey you 130 | want into the search window at the top right of the RStudio data.frame 131 | viewer. That will get you the survey’s ID number. Copy it. 132 | 133 | ### Fetching a survey 134 | 135 | Get the survey data like this: 136 | 137 | ``` r 138 | a_survey_obj <- fetch_survey_obj(123456789) # your survey's ID goes here 139 | ``` 140 | 141 | This returns a list of data about the survey. It’s useful for developers 142 | to explore, but not so much for most users. Keep going to the next step. 143 | 144 | ### Parsing the survey into a data.frame 145 | 146 | This is the actual good part. 147 | 148 | ``` r 149 | survey_df <- parse_survey(a_survey_obj) 150 | ``` 151 | 152 | That will give you a tidy data.frame with all of your responses. 153 | 154 | In the future you can run it all as one command: 155 | 156 | ``` r 157 | survey_df <- 123456789 %>% 158 | fetch_survey_obj %>% 159 | parse_survey 160 | ``` 161 | 162 | ### Retrieving recipient and collector data 163 | 164 | This is handy for tracking who has completed a survey and managing 165 | reminder messages. Or retrieving a recipient’s unique survey link, if 166 | you’re sending invitation through an email collector. 167 | 168 | Get a survey’s collector information, including collector IDs: 169 | 170 | ``` r 171 | collectors <- get_collectors(123456789) 172 | ``` 173 | 174 | Then fetch a collector’s recipient info: 175 | 176 | ``` r 177 | recipients <- get_recipients(234567890) # use a collector ID retrieved in the previous step 178 | ``` 179 | 180 | ### Removing HTML tags from column names 181 | 182 | If your question text has bold font or other formatting, an HTML tag 183 | will likely carry through. You can remove any text between “<” and 184 | “>” with `strip_html()`. 185 | 186 | ``` r 187 | survey_df <- 123456789 %>% 188 | fetch_survey_obj %>% 189 | parse_survey %>% 190 | strip_html 191 | ``` 192 | 193 | ## API considerations 194 | 195 | Your account will likely be limited to 500 hits per day to the API. This 196 | package will print reminders of how many calls you have left in the day. 197 | The main thing to keep an eye on is respondent counts; as only 100 198 | responses can be fetched per API call, a survey with X respondents will 199 | make at least X/100 calls to the API. 200 | 201 | # Contact 202 | 203 | Something may not work, because this is an in-development package. Or 204 | you may have an idea for something that hasn’t been implemented yet. In 205 | either case, please create an issue in the GitHub issue tracker! 206 | -------------------------------------------------------------------------------- /man/browse_surveys.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/browse_surveys.R 3 | \name{browse_surveys} 4 | \alias{browse_surveys} 5 | \title{browse_surveys} 6 | \usage{ 7 | browse_surveys( 8 | per_page = 100, 9 | page = NULL, 10 | sort_by = NULL, 11 | sort_order = NULL, 12 | start_modified_at = NULL, 13 | end_modified_at = NULL, 14 | title = NULL, 15 | include = NULL, 16 | folder_id = NULL, 17 | oauth_token = get_token() 18 | ) 19 | } 20 | \arguments{ 21 | \item{per_page}{Integer number to set the number of surveys to return per page. 22 | Maximum value is 1000 surveys per page; try that if your survey is not on the first 100, 23 | to reduce API calls.} 24 | 25 | \item{page}{Integer number to select which page of resources to return. By default is 1.} 26 | 27 | \item{sort_by}{String used to sort returned survey list: 28 | ‘title’, 'date_modified’, or 'num_responses’. By default, date_modified.} 29 | 30 | \item{sort_order}{String used to set the sort order for returned surveys: 31 | 'ASC’ or 'DESC’. By default, DESC.} 32 | 33 | \item{start_modified_at}{Date string used to select surveys last modified after this date. 34 | By default is NULL.} 35 | 36 | \item{end_modified_at}{Date string used to select surveys modified before this date. 37 | By default is NULL.} 38 | 39 | \item{title}{String used to select survey by survey title. By default is NULL.} 40 | 41 | \item{include}{Character vector as a comma separated string used to filter survey list: 42 | 'response_count’, 'date_created’, 'date_modified’, 'language’, 43 | 'question_count’, 'analyze_url’, 'preview’. 44 | By default is NULL. Use \code{browse_surveys('everything')} to pull all fields.} 45 | 46 | \item{folder_id}{Specify the id of a folder to only return surveys in it.} 47 | 48 | \item{oauth_token}{Your OAuth 2.0 token. 49 | By default, retrieved from \code{get_token()}.} 50 | } 51 | \value{ 52 | A list of objects of class \code{sm_survey}. 53 | } 54 | \description{ 55 | Get the list of the user's surveys. 56 | } 57 | \details{ 58 | This function calls the SurveyMonkey API using the current oauth token and returns 59 | a list of surveys filtered by the parameters entered. 60 | } 61 | \references{ 62 | SurveyMonkey API V3 at \url{https://developer.surveymonkey.com/api/v3/#surveys} 63 | } 64 | -------------------------------------------------------------------------------- /man/fetch_survey_obj.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/fetch_survey.R 3 | \name{fetch_survey_obj} 4 | \alias{fetch_survey_obj} 5 | \title{Title} 6 | \usage{ 7 | fetch_survey_obj(id, oauth_token = get_token()) 8 | } 9 | \arguments{ 10 | \item{id}{ID number of survey to be fetched.} 11 | 12 | \item{oauth_token}{Your OAuth 2.0 token. 13 | By default, retrieved from \code{get_token()}.} 14 | } 15 | \value{ 16 | a survey object, which is a nested list containing info about the survey. 17 | } 18 | \description{ 19 | Title 20 | } 21 | \examples{ 22 | # not run: 23 | # fetch_survey_obj(123456789) 24 | } 25 | -------------------------------------------------------------------------------- /man/figures/TNTP-refreshedlogo-final-color-V.jpg: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/mattroumaya/surveymonkey/f752e8793641183ae7427b55c95edcd92719dfa0/man/figures/TNTP-refreshedlogo-final-color-V.jpg -------------------------------------------------------------------------------- /man/get_collectors.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/collectors.R 3 | \name{get_collectors} 4 | \alias{get_collectors} 5 | \title{get_collectors} 6 | \usage{ 7 | get_collectors( 8 | survey_id, 9 | page = 1, 10 | per_page = NULL, 11 | sort_by = NULL, 12 | sort_order = NULL, 13 | name = NULL, 14 | start_date = NULL, 15 | end_date = NULL, 16 | include = NULL, 17 | all_pages = TRUE, 18 | oauth_token = get_token() 19 | ) 20 | } 21 | \arguments{ 22 | \item{survey_id}{The id of the survey whose collectors you want, 23 | find it with \code{\link{browse_surveys}}.} 24 | 25 | \item{page}{Integer number to select which page of resources to return. By default is 1.} 26 | 27 | \item{per_page}{Number of resources to return per page.} 28 | 29 | \item{sort_by}{Column to sort by. Can be one of: id, date_modified, type, status, name.} 30 | 31 | \item{sort_order}{Sort data by the value in `sort_by`. Can be one of: ASC, DESC.} 32 | 33 | \item{name}{Nickname of collector to search against} 34 | 35 | \item{start_date}{Collectors must be created after this date. Date string in format YYYY-MM-DDTHH:MM:SS (no offset)} 36 | 37 | \item{end_date}{Collectors must be created before this date. Date string in format YYYY-MM-DDTHH:MM:SS (no offset)} 38 | 39 | \item{include}{Specify additional fields to return per collector. Can be one or more of: type, status, response_count, date_created, date_modified, url. Optionally, specify "everything" to return all possible fields.} 40 | 41 | \item{all_pages}{Return all pages of respondents? 42 | Default is TRUE, which will fetch all responses (and cause n/100 calls to the API).} 43 | 44 | \item{oauth_token}{Your OAuth 2.0 token. 45 | By default, retrieved from \code{get_token()}.} 46 | } 47 | \value{ 48 | a data.frame (technically a \code{tibble}) with each collector and its information. 49 | } 50 | \description{ 51 | Get collectors for a SurveyMonkey survey 52 | } 53 | -------------------------------------------------------------------------------- /man/get_recipients.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/recipients.R 3 | \name{get_recipients} 4 | \alias{get_recipients} 5 | \title{get_recipients} 6 | \usage{ 7 | get_recipients( 8 | collector_id, 9 | page = 1, 10 | per_page = 50, 11 | all_pages = TRUE, 12 | oauth_token = get_token() 13 | ) 14 | } 15 | \arguments{ 16 | \item{collector_id}{the collector whose responses you want, 17 | find this value with \code{\link{get_collectors}}.} 18 | 19 | \item{page}{Integer to select which page of resources to return. By default is 1.} 20 | 21 | \item{per_page}{How many recipients per page? Default is 50, which appears to be the maximum.} 22 | 23 | \item{all_pages}{return all pages of respondents? 24 | Default is TRUE, which will fetch all responses (and cause n/50 calls to the API).} 25 | 26 | \item{oauth_token}{Your OAuth 2.0 token. 27 | By default, retrieved from \code{get_token()}.} 28 | } 29 | \value{ 30 | a data.frame (technically a \code{tibble}) with each collector and its information. 31 | } 32 | \description{ 33 | Get recipients for a SurveyMonkey collector. Only valid when recipients are contacted via SurveyMonkey 34 | (e.g., sending a survey invitation from SurveyMonkey). 35 | } 36 | -------------------------------------------------------------------------------- /man/get_responses.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/get_responses.R 3 | \name{get_responses} 4 | \alias{get_responses} 5 | \title{get_responses} 6 | \usage{ 7 | get_responses( 8 | id, 9 | page = 1, 10 | all_pages = TRUE, 11 | per_page = 100, 12 | start_created_at = NULL, 13 | end_created_at = NULL, 14 | start_modified_at = NULL, 15 | end_modified_at = NULL, 16 | sort_order = "DESC", 17 | sort_by = "date_modified", 18 | oauth_token = get_token() 19 | ) 20 | } 21 | \arguments{ 22 | \item{id}{The survey's ID, can be found with \code{browse_survey()}.} 23 | 24 | \item{page}{Integer number to select which page of resources to return. By default is 1.} 25 | 26 | \item{all_pages}{return all pages of respondents? 27 | Default is TRUE, which will fetch all responses (and cause n/100 calls to the API).} 28 | 29 | \item{per_page}{Integer number to set the number of surveys to return per page. 30 | By default, is 100 surveys per page (appears to be the maximum allowed by the API).} 31 | 32 | \item{start_created_at}{Date string used to select surveys created after this date. 33 | By default is NULL.} 34 | 35 | \item{end_created_at}{Date string used to select surveys modified before this date. 36 | By default is NULL.} 37 | 38 | \item{start_modified_at}{Date string used to select surveys last modified after this date. 39 | By default is NULL.} 40 | 41 | \item{end_modified_at}{Date string used to select surveys modified before this date. 42 | By default is NULL.} 43 | 44 | \item{sort_order}{String used to set the sort order for returned surveys: 45 | 'ASC’ or 'DESC’. By default, DESC.} 46 | 47 | \item{sort_by}{String value of field used to sort returned survey list: 48 | ‘title’, 'date_modified’, or 'num_responses’. By default, date_modified.} 49 | 50 | \item{oauth_token}{Your OAuth 2.0 token. 51 | By default, retrieved from \code{get_token()}.} 52 | } 53 | \value{ 54 | A list of object of class {sm_response} 55 | } 56 | \description{ 57 | Get responses for a SurveyMonkey survey 58 | } 59 | \references{ 60 | SurveyMonkey API V3 at 61 | \url{https://developer.surveymonkey.com/api/v3/#survey-responses} 62 | } 63 | -------------------------------------------------------------------------------- /man/get_token.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/token_utils.r 3 | \name{get_token} 4 | \alias{get_token} 5 | \title{Retrieve set Survey Monkey OAuth Token} 6 | \usage{ 7 | get_token() 8 | } 9 | \description{ 10 | Retrieves the currently set survey monkey oauth token 11 | } 12 | -------------------------------------------------------------------------------- /man/parse_survey.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/assemble.R 3 | \name{parse_survey} 4 | \alias{parse_survey} 5 | \title{Take a survey object and parses it into a tidy data.frame.} 6 | \usage{ 7 | parse_survey( 8 | surv_obj, 9 | oauth_token = get_token(), 10 | ..., 11 | fix_duplicates = c("error", "drop", "keep") 12 | ) 13 | } 14 | \arguments{ 15 | \item{surv_obj}{a survey, the result of a call to \code{fetch_survey_obj}.} 16 | 17 | \item{oauth_token}{Your OAuth 2.0 token. By default, retrieved from 18 | \code{get_token()}.} 19 | 20 | \item{...}{additional arguments to pass on to \code{get_responses}. See the documentation 21 | \code{?get_responses} where these arguments are listed.} 22 | 23 | \item{fix_duplicates}{character if 'error', the default detection of duplicate data will result 24 | in an error being raised, otherwise allow the function to return. If 'keep' duplicate results 25 | will be retained, if 'drop' duplicates will be removed from the results.} 26 | } 27 | \value{ 28 | a data.frame (technically a \code{tibble}) with clean responses, one line per respondent. 29 | } 30 | \description{ 31 | Take a survey object and parses it into a tidy data.frame. 32 | } 33 | -------------------------------------------------------------------------------- /man/pipe.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/import_pipe.R 3 | \name{\%>\%} 4 | \alias{\%>\%} 5 | \title{Pipe operator} 6 | \usage{ 7 | lhs \%>\% rhs 8 | } 9 | \description{ 10 | Exported from the magrittr package. To learn more, run \code{?magrittr::`\%>\%`}. 11 | } 12 | \keyword{internal} 13 | -------------------------------------------------------------------------------- /man/set_token.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/token_utils.r 3 | \name{set_token} 4 | \alias{set_token} 5 | \title{Set Survey Monkey Oauth Token} 6 | \usage{ 7 | set_token(oauth_token) 8 | } 9 | \arguments{ 10 | \item{oauth_token}{Your survey monkey OAuth 2.0 token.} 11 | } 12 | \description{ 13 | Sets the option 'sm_oauth_token' for the survey monkey API. 14 | Token will be used for authorization headers for requests. 15 | } 16 | -------------------------------------------------------------------------------- /man/sm_get.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/request_utils.R 3 | \name{sm_get} 4 | \alias{sm_get} 5 | \title{Get request for survey monkey API} 6 | \usage{ 7 | sm_get(url, query, config, ...) 8 | } 9 | \arguments{ 10 | \item{url}{character, url to send request to} 11 | 12 | \item{query}{character, components of the url to change for request arguments, 13 | see also \code{?httr::modify_url}, \link[httr]{modify_url}} 14 | 15 | \item{config}{see \code{?httr::config}, \link[httr]{config}, for full details. 16 | Additional configuration settings such as http additional headers.} 17 | 18 | \item{...}{additional argument passed to \code{httr::GET} \link[httr]{GET}.} 19 | } 20 | \description{ 21 | Will always set the mattroumaya/surveymonkey repo as the user agent 22 | } 23 | -------------------------------------------------------------------------------- /man/strip_html.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/strip_html.r 3 | \name{strip_html} 4 | \alias{strip_html} 5 | \title{strip_html} 6 | \usage{ 7 | strip_html(dat, ignore = NULL, trim_space = TRUE) 8 | } 9 | \arguments{ 10 | \item{dat}{a data.frame.} 11 | 12 | \item{ignore}{a character vector containing values to ignore while stripping HTML tags. 13 | For instance, if you have and in your column names, 14 | add ignore = c("keep me", "me too").} 15 | 16 | \item{trim_space}{logical, if TRUE trim extra white space} 17 | } 18 | \value{ 19 | a data.frame object. 20 | } 21 | \description{ 22 | Remove all values between "<>", which are typically HTML tags. 23 | } 24 | \examples{ 25 | \dontrun{ 26 | fetch_survey_obj(1234567890) \%>\% 27 | parse_survey() \%>\% 28 | strip_html() 29 | } 30 | 31 | } 32 | -------------------------------------------------------------------------------- /surveymonkey.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 | 18 | BuildType: Package 19 | PackageUseDevtools: Yes 20 | PackageInstallArgs: --no-multiarch --with-keep.source 21 | PackageRoxygenize: rd,collate,namespace 22 | -------------------------------------------------------------------------------- /tests/testthat.R: -------------------------------------------------------------------------------- 1 | library(testthat) 2 | library(surveymonkey) 3 | 4 | test_check("surveymonkey") 5 | -------------------------------------------------------------------------------- /tests/testthat/api.surveymonkey.com/v3/surveys-7ad99d.json: -------------------------------------------------------------------------------- 1 | { 2 | "data": [ 3 | { 4 | "id": "318754279", 5 | "title": "my survey", 6 | "nickname": "", 7 | "href": "https://api.surveymonkey.com/v3/surveys/318754279" 8 | }, 9 | { 10 | "id": "318736637", 11 | "title": "dev", 12 | "nickname": "", 13 | "href": "https://api.surveymonkey.com/v3/surveys/318736637" 14 | } 15 | ], 16 | "per_page": 100, 17 | "page": 1, 18 | "total": 2, 19 | "links": { 20 | "self": "https://api.surveymonkey.com/v3/surveys?page=1&per_page=100" 21 | } 22 | } 23 | -------------------------------------------------------------------------------- /tests/testthat/api.surveymonkey.com/v3/surveys-aa605d.json: -------------------------------------------------------------------------------- 1 | { 2 | "data": [ 3 | { 4 | "id": "318754279", 5 | "title": "my survey", 6 | "nickname": "", 7 | "href": "https://api.surveymonkey.com/v3/surveys/318754279", 8 | "response_count": 2, 9 | "date_created": "2022-03-05T17:45:00", 10 | "date_modified": "2022-03-05T18:06:00", 11 | "language": "en", 12 | "question_count": 2, 13 | "analyze_url": "https://www.surveymonkey.com/analyze/_2BQeR_2F0Logad6PkWJKGK_2FFp9px3Jk2YhgMVv88hLQ8Og_3D", 14 | "preview": "https://www.surveymonkey.com/r/Preview/?sm=iXpXtqZORGoZcfzJx7WT4Lub5_2F0o0qUuxZDY_2B2JfK0Uc5DBQolfLKlkk8_2BBUv_2BaV" 15 | }, 16 | { 17 | "id": "318736637", 18 | "title": "dev", 19 | "nickname": "", 20 | "href": "https://api.surveymonkey.com/v3/surveys/318736637", 21 | "response_count": 2, 22 | "date_created": "2022-03-04T21:08:00", 23 | "date_modified": "2022-03-04T21:10:00", 24 | "language": "en", 25 | "question_count": 1, 26 | "analyze_url": "https://www.surveymonkey.com/analyze/ThEZlcwJyPX83iYlMY32xYkv_2FISotZWsCOrALZbiZlI_3D", 27 | "preview": "https://www.surveymonkey.com/r/Preview/?sm=E64F8DnehmVY3nrH1c1DFljyVjRLBkxIviYPLS_2Ba_2B0WTaIh01OiCT782x_2FIngr7O" 28 | } 29 | ], 30 | "per_page": 100, 31 | "page": 1, 32 | "total": 2, 33 | "links": { 34 | "self": "https://api.surveymonkey.com/v3/surveys?page=1&per_page=100" 35 | } 36 | } 37 | -------------------------------------------------------------------------------- /tests/testthat/api.surveymonkey.com/v3/surveys/318754279/details.json: -------------------------------------------------------------------------------- 1 | { 2 | "title": "my survey", 3 | "nickname": "", 4 | "language": "en", 5 | "folder_id": "0", 6 | "category": "", 7 | "question_count": 2, 8 | "page_count": 1, 9 | "response_count": 2, 10 | "date_created": "2022-03-05T17:45:00", 11 | "date_modified": "2022-03-05T18:06:00", 12 | "id": "318754279", 13 | "buttons_text": { 14 | "next_button": "Next", 15 | "prev_button": "Prev", 16 | "done_button": "Done", 17 | "exit_button": "" 18 | }, 19 | "is_owner": true, 20 | "footer": true, 21 | "custom_variables": { 22 | 23 | }, 24 | "href": "https://api.surveymonkey.com/v3/surveys/318754279", 25 | "analyze_url": "https://www.surveymonkey.com/analyze/_2BQeR_2F0Logad6PkWJKGK_2FFp9px3Jk2YhgMVv88hLQ8Og_3D", 26 | "edit_url": "https://www.surveymonkey.com/create/?sm=_2BQeR_2F0Logad6PkWJKGK_2FFp9px3Jk2YhgMVv88hLQ8Og_3D", 27 | "collect_url": "https://www.surveymonkey.com/collect/list?sm=_2BQeR_2F0Logad6PkWJKGK_2FFp9px3Jk2YhgMVv88hLQ8Og_3D", 28 | "summary_url": "https://www.surveymonkey.com/summary/_2BQeR_2F0Logad6PkWJKGK_2FFp9px3Jk2YhgMVv88hLQ8Og_3D", 29 | "preview": "https://www.surveymonkey.com/r/Preview/?sm=iXpXtqZORGoZcfzJx7WT4Lub5_2F0o0qUuxZDY_2B2JfK0Uc5DBQolfLKlkk8_2BBUv_2BaV", 30 | "pages": [ 31 | { 32 | "title": "", 33 | "description": "", 34 | "position": 1, 35 | "question_count": 2, 36 | "id": "192605455", 37 | "href": "https://api.surveymonkey.com/v3/surveys/318754279/pages/192605455", 38 | "questions": [ 39 | { 40 | "id": "769893650", 41 | "position": 1, 42 | "visible": true, 43 | "family": "single_choice", 44 | "subtype": "vertical_two_col", 45 | "layout": null, 46 | "sorting": null, 47 | "required": null, 48 | "validation": null, 49 | "forced_ranking": false, 50 | "headings": [ 51 | { 52 | "heading": "How many pets do you have?" 53 | } 54 | ], 55 | "href": "https://api.surveymonkey.com/v3/surveys/318754279/pages/192605455/questions/769893650", 56 | "answers": { 57 | "choices": [ 58 | { 59 | "position": 1, 60 | "visible": true, 61 | "text": "0", 62 | "quiz_options": { 63 | "score": 0 64 | }, 65 | "id": "5096103932" 66 | }, 67 | { 68 | "position": 2, 69 | "visible": true, 70 | "text": "1", 71 | "quiz_options": { 72 | "score": 0 73 | }, 74 | "id": "5096103933" 75 | }, 76 | { 77 | "position": 3, 78 | "visible": true, 79 | "text": "2", 80 | "quiz_options": { 81 | "score": 0 82 | }, 83 | "id": "5096103934" 84 | }, 85 | { 86 | "position": 4, 87 | "visible": true, 88 | "text": "3", 89 | "quiz_options": { 90 | "score": 0 91 | }, 92 | "id": "5096103935" 93 | }, 94 | { 95 | "position": 5, 96 | "visible": true, 97 | "text": "4 or more", 98 | "quiz_options": { 99 | "score": 0 100 | }, 101 | "id": "5096103936" 102 | } 103 | ] 104 | } 105 | }, 106 | { 107 | "id": "769893903", 108 | "position": 2, 109 | "visible": true, 110 | "family": "open_ended", 111 | "subtype": "single", 112 | "layout": null, 113 | "sorting": null, 114 | "required": null, 115 | "validation": null, 116 | "forced_ranking": false, 117 | "headings": [ 118 | { 119 | "heading": "What are the names of your pets?" 120 | } 121 | ], 122 | "href": "https://api.surveymonkey.com/v3/surveys/318754279/pages/192605455/questions/769893903" 123 | } 124 | ] 125 | } 126 | ] 127 | } 128 | -------------------------------------------------------------------------------- /tests/testthat/api.surveymonkey.net/v3/surveys/318754279/collectors-57191d.json: -------------------------------------------------------------------------------- 1 | { 2 | "data": [ 3 | { 4 | "name": "Web Link 2", 5 | "id": "415838011", 6 | "href": "https://api.surveymonkey.net/v3/collectors/415838011", 7 | "type": "weblink" 8 | }, 9 | { 10 | "name": "Web Link 1", 11 | "id": "415837773", 12 | "href": "https://api.surveymonkey.net/v3/collectors/415837773", 13 | "type": "weblink" 14 | } 15 | ], 16 | "per_page": 50, 17 | "page": 1, 18 | "total": 2, 19 | "links": { 20 | "self": "https://api.surveymonkey.com/v3/surveys/318754279/collectors/?page=1&per_page=50" 21 | } 22 | } 23 | -------------------------------------------------------------------------------- /tests/testthat/api.surveymonkey.net/v3/surveys/318754279/responses/bulk-eda25e.json: -------------------------------------------------------------------------------- 1 | { 2 | "data": [ 3 | { 4 | "id": "13376313674", 5 | "recipient_id": "", 6 | "collection_mode": "default", 7 | "response_status": "completed", 8 | "custom_value": "", 9 | "first_name": "", 10 | "last_name": "", 11 | "email_address": "", 12 | "ip_address": "100.34.161.38", 13 | "logic_path": { 14 | 15 | }, 16 | "metadata": { 17 | "contact": { 18 | 19 | } 20 | }, 21 | "page_path": [ 22 | 23 | ], 24 | "collector_id": "415838011", 25 | "survey_id": "318754279", 26 | "custom_variables": { 27 | 28 | }, 29 | "edit_url": "https://www.surveymonkey.com/r/?sm=ECx3693tA_2BOfTco4nH5JwmZr52ghrXUcivE6NfIqyj_2Bvj4hfLr0QoK0496cMcX3v", 30 | "analyze_url": "https://www.surveymonkey.com/analyze/browse/_2BQeR_2F0Logad6PkWJKGK_2FFp9px3Jk2YhgMVv88hLQ8Og_3D?respondent_id=13376313674", 31 | "total_time": 10, 32 | "date_modified": "2022-03-05T18:05:57+00:00", 33 | "date_created": "2022-03-05T18:05:46+00:00", 34 | "href": "https://api.surveymonkey.net/v3/surveys/318754279/responses/13376313674", 35 | "pages": [ 36 | { 37 | "id": "192605455", 38 | "questions": [ 39 | { 40 | "id": "769893650", 41 | "answers": [ 42 | { 43 | "choice_id": "5096103935" 44 | } 45 | ] 46 | }, 47 | { 48 | "id": "769893903", 49 | "answers": [ 50 | { 51 | "tag_data": [ 52 | 53 | ], 54 | "text": "Donut, Mango, Phil" 55 | } 56 | ] 57 | } 58 | ] 59 | } 60 | ] 61 | }, 62 | { 63 | "id": "13376299051", 64 | "recipient_id": "", 65 | "collection_mode": "default", 66 | "response_status": "completed", 67 | "custom_value": "", 68 | "first_name": "", 69 | "last_name": "", 70 | "email_address": "", 71 | "ip_address": "100.34.161.38", 72 | "logic_path": { 73 | 74 | }, 75 | "metadata": { 76 | "contact": { 77 | 78 | } 79 | }, 80 | "page_path": [ 81 | 82 | ], 83 | "collector_id": "415837773", 84 | "survey_id": "318754279", 85 | "custom_variables": { 86 | 87 | }, 88 | "edit_url": "https://www.surveymonkey.com/r/?sm=PTDXjcbz3xCbvjT3OsvFvTBTTtg98SUIhERK8ZXMBX_2BKFejBojnLKRtOEUkNJlaN", 89 | "analyze_url": "https://www.surveymonkey.com/analyze/browse/_2BQeR_2F0Logad6PkWJKGK_2FFp9px3Jk2YhgMVv88hLQ8Og_3D?respondent_id=13376299051", 90 | "total_time": 12, 91 | "date_modified": "2022-03-05T17:53:02+00:00", 92 | "date_created": "2022-03-05T17:52:49+00:00", 93 | "href": "https://api.surveymonkey.net/v3/surveys/318754279/responses/13376299051", 94 | "pages": [ 95 | { 96 | "id": "192605455", 97 | "questions": [ 98 | { 99 | "id": "769893650", 100 | "answers": [ 101 | { 102 | "choice_id": "5096103935" 103 | } 104 | ] 105 | }, 106 | { 107 | "id": "769893903", 108 | "answers": [ 109 | { 110 | "tag_data": [ 111 | 112 | ], 113 | "text": "Phil, Mango, Donut" 114 | } 115 | ] 116 | } 117 | ] 118 | } 119 | ] 120 | } 121 | ], 122 | "per_page": 10, 123 | "page": 1, 124 | "total": 2, 125 | "links": { 126 | "self": "https://api.surveymonkey.com/v3/surveys/318754279/responses/bulk?page=1&per_page=10" 127 | } 128 | } 129 | -------------------------------------------------------------------------------- /tests/testthat/setup.R: -------------------------------------------------------------------------------- 1 | library(httptest) 2 | 3 | 4 | -------------------------------------------------------------------------------- /tests/testthat/test-assemble.R: -------------------------------------------------------------------------------- 1 | with_mock_api({ 2 | test_that("survey data is returned as expected", { 3 | survey <- fetch_survey_obj(318754279, oauth_token = "temp") %>% suppressWarnings() 4 | survey <- parse_survey(survey, oauth_token = "temp") %>% suppressWarnings() 5 | expect_equal(names(survey), c("survey_id", "collector_id", "respondent_id", "date_created", 6 | "date_modified", "response_status", "ip_address", "How many pets do you have?", 7 | "What are the names of your pets?")) 8 | expect_true("data.frame" %in% class(survey)) 9 | expect_type(survey$survey_id, "double") 10 | expect_type(survey$collector_id, "character") 11 | expect_type(survey$respondent_id, "character") 12 | expect_true("POSIXct" %in% class(survey$date_created)) 13 | expect_true("POSIXct" %in% class(survey$date_modified)) 14 | expect_type(survey$response_status, "character") 15 | expect_type(survey$ip_address, "character") 16 | expect_true(is.factor(survey$`How many pets do you have?`)) 17 | expect_true(is.character(survey$`What are the names of your pets?`)) 18 | expect_true(!all(is.na(survey))) 19 | }) 20 | }) 21 | 22 | with_mock_api({ 23 | test_that("response count == 0 shows a warning", { 24 | oauth <- "temp" 25 | survey <- fetch_survey_obj(318754279, oauth_token = oauth) %>% suppressWarnings() 26 | survey$response_count <- 0 27 | expect_warning( parse_survey(survey, oauth_token = "temp")) 28 | 29 | }) 30 | }) 31 | 32 | 33 | no_dupes <- cars[1, ] 34 | dupes <- rbind(no_dupes, no_dupes) 35 | 36 | test_that("detect duplication", { 37 | expect_true(contains_duplicates(dupes)) 38 | expect_false(contains_duplicates(no_dupes)) 39 | }) 40 | 41 | test_that("keep duplication", { 42 | expect_warning(res <- duplicate_keep(dupes)) 43 | expect_identical(res, dupes) 44 | expect_warning(res <- duplicate_keep(no_dupes), NA) # expect no warning 45 | expect_identical(res, no_dupes) 46 | }) 47 | 48 | test_that("drop duplication", { 49 | expect_warning(res <- duplicate_drop(dupes)) 50 | expect_identical(res, no_dupes) 51 | expect_warning(res <- duplicate_keep(no_dupes), NA) # expect no warning 52 | expect_identical(res, no_dupes) 53 | }) 54 | 55 | test_that("error on duplicates", { 56 | expect_error(duplicate_error(dupes)) 57 | expect_error(duplicate_error(no_dupes), NA) # expect no error 58 | }) 59 | 60 | -------------------------------------------------------------------------------- /tests/testthat/test-browse_surveys.R: -------------------------------------------------------------------------------- 1 | test_that("there is an error message when no token exists", { 2 | expect_error(browse_surveys(include = 'everything', oauth_token = "foo")) 3 | }) 4 | 5 | with_mock_api({ 6 | surveys <- browse_surveys(oauth_token = "temp") %>% suppressWarnings() 7 | 8 | test_that("browse surveys works as intended", { 9 | expect_equal(names(surveys), c("title", "id", "url", "nickname")) 10 | expect_equal(surveys$title, c("my survey", "dev")) 11 | expect_true("data.frame" %in% class(surveys)) 12 | }) 13 | 14 | }) 15 | 16 | with_mock_api({ 17 | surveys <- browse_surveys(oauth_token = "temp", include = "everything") %>% suppressWarnings() 18 | 19 | test_that("include = everything returns all fields", { 20 | expect_equal(names(surveys), c("title", "id", "url", "nickname", "response_count", "date_created", 21 | "date_modified", "language", "question_count", "analyze_url", 22 | "preview")) 23 | }) 24 | }) 25 | 26 | with_mock_api({ 27 | test_that("all NULL values are stopped", { 28 | expect_error(browse_surveys(oauth_token = "temp", 29 | page = NULL, 30 | per_page = NULL, 31 | sort_by = NULL, 32 | sort_order = NULL, 33 | start_modified_at = NULL, 34 | end_modified_at = NULL, 35 | title = NULL, 36 | include = NULL, 37 | folder_id = NULL)) 38 | }) 39 | }) 40 | 41 | 42 | 43 | -------------------------------------------------------------------------------- /tests/testthat/test-collectors.R: -------------------------------------------------------------------------------- 1 | with_mock_api({ 2 | collector <- get_collectors(survey_id = 318754279, oauth_token = "temp") %>% suppressWarnings() 3 | test_that("get_collectors works as intended", { 4 | expect_equal(names(collector), c("name", "id", "href", "type")) 5 | expect_equal(collector$name, c("Web Link 2", "Web Link 1")) 6 | expect_equal(collector$id, c(415838011, 415837773)) 7 | expect_equal(collector$href[1], "https://api.surveymonkey.net/v3/collectors/415838011") 8 | expect_type(collector$name, "character") 9 | expect_type(collector$id, "double") 10 | expect_type(collector$href, "character") 11 | expect_type(collector$type, "character") 12 | expect_true("data.frame" %in% class(collector)) 13 | }) 14 | }) 15 | 16 | with_mock_api({ 17 | test_that("all NULL values are stopped", { 18 | expect_error(get_collectors(survey_id = 318754279, 19 | oauth_token = "temp", 20 | page = NULL, 21 | all_pages = NULL, 22 | verbose = FALSE)) 23 | }) 24 | }) 25 | -------------------------------------------------------------------------------- /tests/testthat/test-fetch_survey.R: -------------------------------------------------------------------------------- 1 | with_mock_api({ 2 | data <- fetch_survey_obj(318754279, oauth_token = "temp") %>% suppressWarnings() 3 | test_that("fetch_survey_obj works as intended", { 4 | expect_equal(data$title, "my survey") 5 | expect_equal(data$language, "en") 6 | expect_equal(data$folder_id, "0") 7 | expect_equal(data$question_count, 2) 8 | expect_equal(data$page_count, 1) 9 | expect_equal(data$response_count, 2) 10 | expect_type(data, "list") 11 | }) 12 | 13 | test_that("fetch_survey_obj fails without id", { 14 | expect_error(fetch_survey_obj(oauth_token = "temp")) 15 | }) 16 | 17 | test_that("fetch_survey_obj fails without oauth", { 18 | expect_error(fetch_survey_obj(318754279, oauth_token = NULL)) 19 | }) 20 | }) 21 | 22 | 23 | -------------------------------------------------------------------------------- /tests/testthat/test-parse_responses.R: -------------------------------------------------------------------------------- 1 | with_mock_api({ 2 | 3 | test_that("all pages works as intended", { 4 | responses <- get_responses(318754279, oauth_token = "temp", all_pages = TRUE) %>% suppressWarnings() 5 | parsed <- parse_respondent_list(responses) 6 | expect_true("data.frame" %in% class(parsed)) 7 | 8 | }) 9 | }) 10 | 11 | -------------------------------------------------------------------------------- /tests/testthat/test-recipients.R: -------------------------------------------------------------------------------- 1 | with_mock_api({ 2 | 3 | test_that("retrieving recipients fails when none available", { 4 | 5 | collector <- get_collectors(318754279, oauth_token = "temp") %>% suppressWarnings() 6 | expect_error(get_recipients(collector$id[1])) 7 | 8 | }) 9 | 10 | }) 11 | -------------------------------------------------------------------------------- /tests/testthat/test-request_utils.R: -------------------------------------------------------------------------------- 1 | test_that("standard request header", { 2 | expect_error(standard_request_header(NULL)) 3 | expected = c( 4 | Authorization = "bearer 1234", 5 | "Content-Type" = "application/json" 6 | ) 7 | test_token = "1234" 8 | h = standard_request_header(test_token) 9 | expect_s3_class(h, "request") 10 | expect_true(all(expected %in% h$headers)) 11 | }) 12 | 13 | test_that("response messages", { 14 | fake_response1 = list( 15 | headers = list( 16 | # note this is different to documented name 17 | `x-ratelimit-app-global-day-remaining` = 21, 18 | `X-Ratelimit-App-Global-Day-Reset` = 3600 19 | ) 20 | ) 21 | fake_response2 = list( 22 | headers = list( 23 | # note this is different to documented name 24 | `x-ratelimit-app-global-day-remaining` = 20, 25 | `X-Ratelimit-App-Global-Day-Reset` = 3600 26 | ) 27 | ) 28 | expect_message( 29 | remaining_request_message(fake_response1), 30 | "You have 21 requests left today before you hit the limit" 31 | ) 32 | expect_null( 33 | reset_time_message(fake_response1) 34 | ) 35 | expect_message( 36 | reset_time_message(fake_response1, 7), 37 | "Your daily request limit will reset in 3600 seconds" 38 | ) 39 | expect_message( 40 | reset_time_message(fake_response2), 41 | "Your daily request limit will reset in 3600 seconds" 42 | ) 43 | }) 44 | 45 | # TODO: add test for full sm_get 46 | # needs a test request set with associated key 47 | -------------------------------------------------------------------------------- /tests/testthat/test-standard_request_header.R: -------------------------------------------------------------------------------- 1 | test_that("standard request header is created as expected", { 2 | header <- standard_request_header(token = "abcX123") 3 | 4 | expect_equal(header$headers[[1]], "bearer abcX123") 5 | expect_equal(header$headers[[2]], "application/json") 6 | }) 7 | 8 | test_that("standard request header requires token", { 9 | expect_error(standard_request_header()) 10 | }) 11 | 12 | -------------------------------------------------------------------------------- /tests/testthat/test-token-utils.R: -------------------------------------------------------------------------------- 1 | 2 | withr::local_options() 3 | 4 | test_that("get_token returns NULL with no option set", { 5 | expect_null(get_token()) 6 | }) 7 | 8 | test_that("setting the token works", { 9 | val = "5678" 10 | set_token(val) 11 | expect_equal(getOption("sm_oauth_token"), val) 12 | }) 13 | 14 | test_that("can retrieve token", { 15 | withr::with_options( 16 | list(sm_oauth_token = "1234"), { 17 | expect_equal(get_token(), "1234") 18 | } 19 | ) 20 | }) 21 | 22 | test_that("get bearer token", { 23 | expect_error(get_bearer_token()) 24 | expect_equal(get_bearer_token("test"), "bearer test") 25 | }) 26 | -------------------------------------------------------------------------------- /tests/testthat/test-utils.R: -------------------------------------------------------------------------------- 1 | test_that("format_date() works", { 2 | src = as.Date("2022-01-09") 3 | posix_src = as.POSIXct(src) 4 | char_src = "2022-01-09 00:00:00" 5 | expected = "2022-01-09 00:00:00" 6 | expect_type(format_date(src), "character") 7 | expect_type(format_date(posix_src), "character") 8 | expect_type(format_date(char_src), "character") 9 | expect_equal(format_date(src), expected) 10 | expect_equal(format_date(posix_src), expected) 11 | expect_equal(format_date(char_src), expected) 12 | }) 13 | -------------------------------------------------------------------------------- /tests/testthat/test_strip_html.r: -------------------------------------------------------------------------------- 1 | library(testthat) 2 | 3 | test_that("all <> and values between are removed", { 4 | cols <- c("What is your favorite color?", "Keep value") 5 | 6 | expect_equal( 7 | mtcars %>% 8 | dplyr::select( 9 | "What is your favorite color?" = .data$mpg, 10 | "Keep value" = .data$cyl 11 | ) %>% 12 | strip_html() %>% 13 | colnames(.), 14 | cols 15 | ) 16 | }) 17 | 18 | 19 | test_that("ignore values are kept", { 20 | cols <- c("What is your favorite color?", "Keep value") 21 | 22 | expect_equal( 23 | mtcars %>% 24 | dplyr::select( 25 | "What is your favorite color?" = .data$mpg, 26 | "Keep value" = .data$cyl 27 | ) %>% 28 | strip_html(ignore = "this") %>% 29 | colnames(.), 30 | cols 31 | ) 32 | }) 33 | 34 | test_that("warning when values are not found", { 35 | expect_warning(mtcars %>% 36 | dplyr::select( 37 | "What is your favorite color?" = .data$mpg, 38 | "Keep value" = .data$cyl 39 | ) %>% 40 | strip_html(ignore = "not_in_these_columns_satan!") %>% 41 | colnames(.), 42 | paste0("None of your ignored values were found. All text between <> will be removed."), 43 | fixed = TRUE 44 | ) 45 | }) 46 | 47 | 48 | test_that("trim_space == TRUE is working correctly", { 49 | cols <- c("What is your favorite color?", "Keep value") 50 | 51 | expect_equal( 52 | mtcars %>% 53 | dplyr::select( 54 | "What is your favorite color?" = .data$mpg, 55 | "Keep value" = .data$cyl 56 | ) %>% 57 | strip_html(trim_space = TRUE) %>% 58 | colnames(.), 59 | cols 60 | ) 61 | }) 62 | 63 | test_that("trim_space == FALSE is working correctly", { 64 | cols <- c("What is your favorite color?", "Keep value") 65 | 66 | expect_equal( 67 | mtcars %>% 68 | dplyr::select( 69 | "What is your favorite color?" = .data$mpg, 70 | "Keep value" = .data$cyl 71 | ) %>% 72 | strip_html(trim_space = FALSE) %>% 73 | colnames(.), 74 | cols 75 | ) 76 | }) 77 | 78 | test_that("trim_space == TRUE removes whitespace when removed text is at the end of column name", { 79 | col <- "remove this" 80 | 81 | expect_equal( 82 | tibble::tibble("remove this " = c(1, 2, 3)) %>% 83 | strip_html(trim_space = TRUE) %>% 84 | colnames(.), 85 | col 86 | ) 87 | }) 88 | 89 | test_that( 90 | "trim_space == TRUE removes whitespace when 91 | removed text is at the beginning of column name", { 92 | col <- "to remove" 93 | 94 | expect_equal( 95 | tibble::tibble(" to remove" = c(1, 2, 3)) %>% 96 | strip_html(trim_space = TRUE) %>% 97 | colnames(.), 98 | col 99 | ) 100 | }) 101 | --------------------------------------------------------------------------------