├── .Rbuildignore ├── .gitattributes ├── .github ├── .gitignore └── workflows │ ├── R-CMD-check.yaml │ └── pkgdown.yaml ├── .gitignore ├── .travis.yml ├── CRAN-RELEASE ├── CRAN-SUBMISSION ├── DESCRIPTION ├── NAMESPACE ├── NEWS ├── R ├── cleandata.R ├── dplyr_verbs.R ├── encoding.R ├── extract.R ├── merge.R ├── opentext.R ├── pattern.R ├── plots.R ├── questions.R ├── strings.R ├── surveydata-deprecated.R ├── surveydata-package.R ├── surveydata.R ├── tools.R └── varlabels.R ├── README.Rmd ├── README.md ├── _pkgdown.yml ├── cran-comments.md ├── data └── membersurvey.rda ├── inst ├── WORDLIST ├── examples │ ├── example-asSurveydata.R │ ├── example-dplyr-verbs.R │ ├── example-extract.R │ ├── example-pattern.R │ ├── example-plots.R │ ├── example-questions.R │ └── example-varlabels.R └── vignette_child │ ├── child.Rmd │ └── child.html ├── man ├── as.data.frame.surveydata.Rd ├── as.surveydata.Rd ├── as_opentext_datatable.Rd ├── cbind.surveydata.Rd ├── dplyr-surveydata.Rd ├── dropout.Rd ├── encToInt.Rd ├── extract.Rd ├── fix_common_encoding_problems.Rd ├── fix_levels_01.Rd ├── has_dont_know.Rd ├── intToEnc.Rd ├── is.surveydata.Rd ├── lapply_names.Rd ├── leveltest.Rd ├── membersurvey.Rd ├── merge.Rd ├── merge_varlabels.Rd ├── names.Rd ├── pattern.Rd ├── print_opentext.Rd ├── question_order.Rd ├── question_text.Rd ├── question_text_common.Rd ├── question_text_unique.Rd ├── questions.Rd ├── remove_all_dont_know.Rd ├── remove_dont_know.Rd ├── rm.attrs.Rd ├── rm.pattern.Rd ├── split_common_unique.Rd ├── strCommonUnique.Rd ├── survey_plot_question.Rd ├── survey_plot_satisfaction.Rd ├── survey_plot_title.Rd ├── survey_plot_yes_no.Rd ├── surveydata-deprecated.Rd ├── surveydata-package.Rd ├── varlabels.Rd └── which.q.Rd ├── revdep ├── .gitignore ├── README.md ├── cran.md ├── email.yml ├── failures.md └── problems.md ├── tests ├── spelling.R ├── testthat.R └── testthat │ ├── 2010.sav │ ├── gss.rda │ ├── helper.R │ ├── notest-9-gss.R │ ├── test-01-essentials.R │ ├── test-01-surveydata.R │ ├── test-02-whichq.R │ ├── test-03-extract.R │ ├── test-03-replace.R │ ├── test-03-strings.R │ ├── test-04-merge.R │ ├── test-05-questions.R │ ├── test-06-encoding.R │ ├── test-08-tools.R │ ├── test-09-dplyr-verbs.R │ ├── test-10-cleandata.R │ ├── test-11-encoding.R │ ├── test-12-plots.R │ └── test-13-opentext.R └── vignettes ├── surveydata.R ├── surveydata.Rmd └── surveydata.html /.Rbuildignore: -------------------------------------------------------------------------------- 1 | ^README\.Rmd$ 2 | ^Meta$ 3 | ^doc$ 4 | ^CRAN-RELEASE$ 5 | README.Rmd 6 | README.md 7 | .travis.yml 8 | ^.*\.Rproj$ 9 | ^\.Rproj\.user$ 10 | cran-comments.md 11 | ^docs$ 12 | _pkgdown.yml 13 | ^\.travis\.yml$ 14 | ^\.github$ 15 | ^CRAN-SUBMISSION$ 16 | ^revdep$ 17 | -------------------------------------------------------------------------------- /.gitattributes: -------------------------------------------------------------------------------- 1 | *.html linguist-documentation=true 2 | -------------------------------------------------------------------------------- /.github/.gitignore: -------------------------------------------------------------------------------- 1 | *.html 2 | -------------------------------------------------------------------------------- /.github/workflows/R-CMD-check.yaml: -------------------------------------------------------------------------------- 1 | # Workflow derived from https://github.com/r-lib/actions/tree/v2/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, master] 6 | pull_request: 7 | branches: [main, master] 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@v3 33 | 34 | - uses: r-lib/actions/setup-pandoc@v2 35 | 36 | - uses: r-lib/actions/setup-r@v2 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@v2 43 | with: 44 | extra-packages: any::rcmdcheck 45 | needs: check 46 | 47 | - uses: r-lib/actions/check-r-package@v2 48 | with: 49 | upload-snapshots: true 50 | -------------------------------------------------------------------------------- /.github/workflows/pkgdown.yaml: -------------------------------------------------------------------------------- 1 | # Workflow derived from https://github.com/r-lib/actions/tree/v2/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, master] 6 | pull_request: 7 | branches: [main, master] 8 | release: 9 | types: [published] 10 | workflow_dispatch: 11 | 12 | name: pkgdown 13 | 14 | jobs: 15 | pkgdown: 16 | runs-on: ubuntu-latest 17 | # Only restrict concurrency for non-PR jobs 18 | concurrency: 19 | group: pkgdown-${{ github.event_name != 'pull_request' || github.run_id }} 20 | env: 21 | GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }} 22 | steps: 23 | - uses: actions/checkout@v3 24 | 25 | - uses: r-lib/actions/setup-pandoc@v2 26 | 27 | - uses: r-lib/actions/setup-r@v2 28 | with: 29 | use-public-rspm: true 30 | 31 | - uses: r-lib/actions/setup-r-dependencies@v2 32 | with: 33 | extra-packages: any::pkgdown, local::. 34 | needs: website 35 | 36 | - name: Build site 37 | run: pkgdown::build_site_github_pages(new_process = FALSE, install = FALSE) 38 | shell: Rscript {0} 39 | 40 | - name: Deploy to GitHub pages 🚀 41 | if: github.event_name != 'pull_request' 42 | uses: JamesIves/github-pages-deploy-action@v4.4.1 43 | with: 44 | clean: false 45 | branch: gh-pages 46 | folder: docs 47 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | Meta 2 | doc 3 | .Rproj.user 4 | .Rhistory 5 | .RData 6 | .Ruserdata 7 | *.Rproj 8 | docs/ 9 | -------------------------------------------------------------------------------- /.travis.yml: -------------------------------------------------------------------------------- 1 | # R for travis: see documentation at https://docs.travis-ci.com/user/languages/r 2 | 3 | language: r 4 | cache: packages 5 | 6 | r: 7 | - oldrel 8 | - release 9 | - devel 10 | -------------------------------------------------------------------------------- /CRAN-RELEASE: -------------------------------------------------------------------------------- 1 | This package was submitted to CRAN on 2020-09-15. 2 | Once it is accepted, delete this file and tag the release (commit ff3be3b). 3 | -------------------------------------------------------------------------------- /CRAN-SUBMISSION: -------------------------------------------------------------------------------- 1 | Version: 0.2.7 2 | Date: 2023-03-12 17:23:43 UTC 3 | SHA: 1dd3ef708899f73e0877f014afe7963d368b0324 4 | -------------------------------------------------------------------------------- /DESCRIPTION: -------------------------------------------------------------------------------- 1 | Package: surveydata 2 | Version: 0.2.7 3 | License: GPL-2|GPL-3 4 | Title: Tools to Work with Survey Data 5 | LazyData: true 6 | LazyLoad: true 7 | Copyright: Andrie de Vries 8 | Authors@R: c( 9 | person("Andrie", "de Vries", role=c("aut", "cre", "cph"), 10 | email="apdevries@gmail.com"), 11 | person("Evan", "Odell", role=c("ctb")) 12 | ) 13 | Description: Data obtained from surveys contains information not only about the 14 | survey responses, but also the survey metadata, e.g. the original survey 15 | questions and the answer options. The 'surveydata' package makes it easy to 16 | keep track of this metadata, and to easily extract columns with 17 | specific questions. 18 | URL: https://github.com/andrie/surveydata, https://andrie.github.io/surveydata/ 19 | BugReports: https://github.com/andrie/surveydata/issues 20 | ByteCompile: yes 21 | Depends: 22 | R (>= 3.0.0) 23 | Imports: 24 | dplyr, 25 | rlang, 26 | magrittr, 27 | purrr, 28 | ggplot2, 29 | scales, 30 | tidyr, 31 | DT, 32 | assertthat 33 | Suggests: 34 | testthat, 35 | knitr, 36 | rmarkdown, 37 | withr, 38 | covr, 39 | rprojroot, 40 | spelling 41 | RoxygenNote: 7.2.3 42 | Roxygen: list(markdown = TRUE) 43 | VignetteBuilder: knitr 44 | Encoding: UTF-8 45 | Language: en-GB 46 | Config/testthat/edition: 3 47 | -------------------------------------------------------------------------------- /NAMESPACE: -------------------------------------------------------------------------------- 1 | # Generated by roxygen2: do not edit by hand 2 | 3 | S3method("$<-",surveydata) 4 | S3method("[",surveydata) 5 | S3method("[<-",surveydata) 6 | S3method("names<-",surveydata) 7 | S3method(arrange,surveydata) 8 | S3method(as.data.frame,surveydata) 9 | S3method(as.tbl,surveydata) 10 | S3method(as_tibble,surveydata) 11 | S3method(cbind,surveydata) 12 | S3method(filter,surveydata) 13 | S3method(merge,surveydata) 14 | S3method(mutate,surveydata) 15 | S3method(select,surveydata) 16 | S3method(slice,surveydata) 17 | S3method(summarise,surveydata) 18 | S3method(summarize,surveydata) 19 | export("pattern<-") 20 | export("varlabels<-") 21 | export(as.surveydata) 22 | export(as_opentext_datatable) 23 | export(dropout) 24 | export(encToInt) 25 | export(filter) 26 | export(fixCommonEncodingProblems) 27 | export(fixLevels01) 28 | export(fixLevels01R) 29 | export(fixLevels01SPSS) 30 | export(fix_common_encoding_problems) 31 | export(fix_levels_01) 32 | export(fix_levels_01_r) 33 | export(fix_levels_01_spss) 34 | export(hasDK) 35 | export(has_dont_know) 36 | export(intToEnc) 37 | export(is.surveydata) 38 | export(lapplyNames) 39 | export(lapply_names) 40 | export(leveltestR) 41 | export(leveltestSPSS) 42 | export(leveltest_r) 43 | export(leveltest_spss) 44 | export(pattern) 45 | export(print_opentext) 46 | export(qOrder) 47 | export(qText) 48 | export(qTextCommon) 49 | export(qTextUnique) 50 | export(question_order) 51 | export(question_text) 52 | export(question_text_common) 53 | export(question_text_unique) 54 | export(questions) 55 | export(removeAllDK) 56 | export(removeDK) 57 | export(remove_all_dont_know) 58 | export(remove_dont_know) 59 | export(strCommonUnique) 60 | export(survey_plot_question) 61 | export(survey_plot_satisfaction) 62 | export(survey_plot_title) 63 | export(survey_plot_yes_no) 64 | export(un_surveydata) 65 | export(varlabels) 66 | export(which.q) 67 | import(dplyr) 68 | import(ggplot2) 69 | import(rlang) 70 | importFrom(DT,datatable) 71 | importFrom(assertthat,assert_that) 72 | importFrom(dplyr,arrange) 73 | importFrom(dplyr,filter) 74 | importFrom(dplyr,if_else) 75 | importFrom(dplyr,mutate) 76 | importFrom(dplyr,slice) 77 | importFrom(dplyr,tibble) 78 | importFrom(magrittr,'%>%') 79 | importFrom(purrr,map) 80 | importFrom(purrr,map_chr) 81 | importFrom(purrr,map_dbl) 82 | importFrom(purrr,map_df) 83 | importFrom(scales,percent) 84 | importFrom(stats,complete.cases) 85 | importFrom(stats,na.omit) 86 | importFrom(stats,setNames) 87 | importFrom(tidyr,gather) 88 | importFrom(utils,head) 89 | importFrom(utils,localeToCharset) 90 | importFrom(utils,tail) 91 | -------------------------------------------------------------------------------- /NEWS: -------------------------------------------------------------------------------- 1 | surveydata 0.2.7 2 | ----------------- 3 | 4 | * No functional changes. 5 | 6 | surveydata 0.2.6 7 | ----------------- 8 | 9 | Changes: 10 | 11 | * Deprecate `as.tbl()` because `tibble` no longer exports this. Use `as_tibble()` instead. 12 | * Changes to test suite to comply with `testthat_3.0.0` 13 | 14 | 15 | surveydata 0.2.5 16 | ----------------- 17 | 18 | Changes: 19 | 20 | * Minor change in example to pass R CMD check 21 | 22 | 23 | surveydata 0.2.4 24 | ----------------- 25 | 26 | Changes: 27 | 28 | * No new functionality 29 | * Removed dependency on `stringr` #8, contributed by [Evan Odell](https://github.com/evanodell) 30 | * Removed dependency on `plyr` 31 | * More documentation improvements and cleanup of `pkgdown` 32 | * Minor changes to documentation in response to stricter R CMD check warnings 33 | 34 | 35 | 36 | surveydata 0.2.3 (2019-01-19) 37 | ----------------- 38 | 39 | 40 | Changes: 41 | 42 | * No new functionality 43 | * Internal changes to comply with `dplyr_0.1.2` 44 | * Documentation improvements, including spell check and improved `pkgdown` 45 | 46 | 47 | 48 | 49 | surveydata 0.2.2 (2018-12-06) 50 | ----------------- 51 | 52 | 53 | New functionality: 54 | 55 | * Add `print_opentext()` 56 | 57 | Other changes: 58 | 59 | * Fix some package `Imports:` problems. 60 | 61 | 62 | surveydata 0.2.1 (2018-01-17) 63 | ----------------- 64 | 65 | Breaking changes: 66 | 67 | * Most of the functions now have `snake_case` names that are more descriptive, e.g. `qText()` is now `question_text()`. 68 | * The `question_text()` function now returns all text if the question number is empty. 69 | 70 | 71 | New functionality: 72 | 73 | * New set of plotting functions 74 | 75 | Other changes: 76 | 77 | * Package documentation built with `pkgdown` 78 | 79 | 80 | surveydata 0.2.0 (2017-07-19) 81 | ----------------- 82 | 83 | Changes: 84 | 85 | * Supports `dplyr` verbs, including `mutate()`, `filter()`, `arrange()` and `select()` 86 | * Updated vignette 87 | 88 | 89 | surveydata 0.1-14 (2013-10-25) 90 | ----------------- 91 | 92 | Changes: 93 | 94 | * Added `README.md` to `.Rbuildignore` to comply with CRAN 95 | 96 | 97 | surveydata 0.1-12 (2013-01-05) 98 | ----------------- 99 | 100 | Changes: 101 | 102 | * When `drop=TRUE`, `[.surveydata` simplifies the results and returns a vector, similar to `[.data.frame` 103 | 104 | 105 | surveydata 0.1-10 (2012-12-27) 106 | ----------------- 107 | 108 | Changes: 109 | 110 | * Removed `XLConnect` functions for survey translation, and included in separate `surveytranslate` package. 111 | * Added vignette. 112 | * First submission to CRAN. 113 | 114 | 115 | surveydata 0.1-09 (2012-12-27) 116 | ----------------- 117 | 118 | Changes: 119 | 120 | * No functional changes. 121 | * Complete overhaul and review of documentation, to get package ready for first release to CRAN. 122 | 123 | 124 | surveydata 0.1-08 (17/8/2012) 125 | ----------------- 126 | 127 | Changes: 128 | 129 | * Added `writeQuestionExcel()` and `readQuestionExcel()` for exporting and importing questions for easy translation or recoding. 130 | * Added `dropout()` to calculate where respondents drop out from survey. 131 | 132 | 133 | surveydata 0.1-07 (13/7/2012) 134 | ----------------- 135 | 136 | Changes: 137 | * Bug fixes in `[.surveydata` 138 | * Added warning in `as.surveydata()` if names and varlabel names don't match. 139 | 140 | surveydata 0.1-06 (9/7/2012) 141 | ----------------- 142 | 143 | Changes: 144 | 145 | * Added method for `[<-.surveydata` 146 | 147 | 148 | surveydata 0.1-05 (29/6/2012) 149 | ----------------- 150 | 151 | Changes: 152 | 153 | * Documentation improvements and small issue fixes. 154 | * `[.surveydata` now uses `drop=FALSE` by default. 155 | 156 | 157 | surveydata 0.1-04 (13/5/2012) 158 | ----------------- 159 | 160 | New features: 161 | 162 | * Modified pattern search to have sep and exclude, rather than a regex (as.surveydata, which.q. etc.). 163 | * Merged surveyortools package: encoding and cleandata. 164 | 165 | surveydata 0.1-03 (31/10/2011) 166 | ----------------- 167 | 168 | New features: 169 | 170 | * Now imports packages rather than declaring dependencies.. 171 | 172 | 173 | surveydata 0.1-00 174 | ----------------- 175 | 176 | New features: 177 | 178 | * First alpha release. 179 | * `varlabels` and `varlabels<-` to read and modify `variable.labels` attribute. 180 | * `pattern` and `pattern<-` to set regex pattern that defines unique questions. 181 | * `qText` returns question text using regex patterns. 182 | * extracts subsets with regex patterns using, for example `surveydata[, "Q1"]`. -------------------------------------------------------------------------------- /R/cleandata.R: -------------------------------------------------------------------------------- 1 | # Functions to perform data cleanup 2 | 3 | 4 | # 5 | # surveydata/R/cleandata.R by Andrie de Vries Copyright (C) 2011-2017 6 | # 7 | # This program is free software; you can redistribute it and/or modify 8 | # it under the terms of the GNU General Public License as published by 9 | # the Free Software Foundation; either version 2 or 3 of the License 10 | # (at your option). 11 | # 12 | # This program is distributed in the hope that it will be useful, 13 | # but WITHOUT ANY WARRANTY; without even the implied warranty of 14 | # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 15 | # GNU General Public License for more details. 16 | # 17 | # A copy of the GNU General Public License is available at 18 | # http://www.r-project.org/Licenses/ 19 | # 20 | 21 | 22 | # quickdf function modified from `plyr` 23 | quickdf <- function(list) { 24 | rows <- unique(unlist(lapply(list, NROW))) 25 | stopifnot(length(rows) == 1) 26 | class(list) <- "data.frame" 27 | attr(list, "row.names") <- c(NA_integer_, -rows) 28 | list 29 | } 30 | 31 | 32 | # don't know -------------------------------------------------------------- 33 | 34 | 35 | #' Tests whether levels contain "Don't know". 36 | #' 37 | #' Returns TRUE if x contains any instances of dk 38 | #' 39 | #' @param x Character vector or factor 40 | #' @param dk Character vector, containing search terms, e.g. `c("Don't know", "Don't Know")` 41 | #' @return TRUE or FALSE 42 | #' @export 43 | #' @family Functions to clean data 44 | #' @keywords "clean data" 45 | has_dont_know <- function(x, dk = "Don't Know") { 46 | l <- if (is.factor(x)) levels(x) else unique(x) 47 | any(l %in% dk) 48 | } 49 | 50 | 51 | #' Removes "Don't know" from levels and replaces with NA. 52 | #' 53 | #' Tests the levels of x contain any instances of "Don't know". If so, replaces these levels with `NA` 54 | #' 55 | #' @inherit has_dont_know 56 | #' @return A factor with "Dont know" removed 57 | #' @export 58 | #' @family Functions to clean data 59 | #' @keywords "clean data" 60 | remove_dont_know <- function(x, dk = "Don't Know") { 61 | if (has_dont_know(x, dk)) { 62 | if (is.factor(x)) { 63 | l <- levels(x) 64 | l[which(levels(x) %in% dk)] <- NA 65 | x <- factor(x, levels = l) 66 | } else { 67 | pattern <- paste("^(", paste(dk, collapse = "|"), ").?$", sep = "") 68 | x <- gsub(pattern, "", x) 69 | } 70 | } 71 | x 72 | } 73 | 74 | 75 | 76 | #' Removes "Do not know" and other similar words from factor levels in data frame. 77 | #' 78 | #' Removes "Do not know" and other similar words from factor levels in data frame 79 | #' 80 | #' @param x List or data frame 81 | #' @param dk Character vector, containing search terms, e.g. `c("Do not know", "DK")`. These terms will be replaced by `NA`. If `NULL`, defaults to `c("I don't know", "Don't Know", "Don't know", "Dont know" , "DK")` 82 | #' @param message If TRUE, displays message with the number of instances that were removed. 83 | #' 84 | #' @seealso [hasDK()] and [removeDK()] 85 | #' @return A data frame 86 | #' @export 87 | #' @family Functions to clean data 88 | #' @keywords "clean data" 89 | remove_all_dont_know <- function(x, dk = NULL, message = TRUE) { 90 | if (is.null(dk)) { 91 | dk <- c("I don't know", "Don't Know", "Don't know", "Dont know", "DK") 92 | } 93 | newx <- lapply(x, remove_dont_know, dk) 94 | n1 <- sum(as.numeric(lapply(x, has_dont_know, dk))) 95 | n2 <- sum(as.numeric(lapply(newx, has_dont_know, dk))) 96 | dk <- paste(dk, collapse = ", ") 97 | removed_count <- n1 - n2 98 | if (removed_count > 0 && message) { 99 | message(paste("Removed", removed_count, "instances of levels that equal [", dk, "]")) 100 | } 101 | ret <- quickdf(newx) 102 | attributes(ret) <- attributes(x) 103 | class(ret) <- class(x) 104 | ret 105 | } 106 | 107 | 108 | 109 | # leveltest --------------------------------------------------------------- 110 | 111 | 112 | #' Fix level formatting of all question with Yes/No type answers. 113 | #' 114 | #' @param x surveydata object 115 | #' @export 116 | #' @family Functions to clean data 117 | #' @keywords "clean data" 118 | #' @name leveltest 119 | leveltest_spss <- function(x) { 120 | ret <- FALSE 121 | if (inherits(x, "numeric")) { 122 | if (!is.null(attributes(x)$value.labels)) { 123 | if (all(attributes(x)$value.labels == c(1, 0))) { 124 | ret <- TRUE 125 | } 126 | } 127 | } 128 | ret 129 | } 130 | 131 | 132 | #' @export 133 | #' @rdname leveltest 134 | leveltest_r <- function(x) { 135 | ret <- FALSE 136 | if (inherits(x, "factor")) { 137 | if (length(levels(x)) == 2) { 138 | if (all(levels(x) == c("Yes", "Not selected"))) { 139 | ret <- TRUE 140 | } 141 | } 142 | } 143 | ret 144 | } 145 | 146 | 147 | 148 | # fix levels -------------------------------------------------------------- 149 | 150 | 151 | #' Fix level formatting of all question with Yes/No type answers. 152 | #' 153 | #' @param dat surveydata object 154 | #' @export 155 | #' @family Functions to clean data 156 | #' @keywords "clean data" 157 | #' @rdname fix_levels_01 158 | fix_levels_01_spss <- function(dat) { 159 | ret <- lapply(dat, function(x) { 160 | if (leveltest_spss(x)) { 161 | x <- factor(x) 162 | levels(x) <- c("No", "Yes") 163 | x 164 | } else { 165 | x 166 | } 167 | }) 168 | ret <- quickdf(ret) 169 | attributes(ret)$variable.labels <- varlabels(dat) 170 | ret 171 | } 172 | 173 | 174 | #' @export 175 | #' @rdname fix_levels_01 176 | fix_levels_01_r <- function(dat) { 177 | stopifnot(is.surveydata(dat)) 178 | ret <- lapply(dat, function(x) { 179 | if (leveltest_r(x)) { 180 | levels(x) <- c("Yes", "No") 181 | x 182 | } else { 183 | x 184 | } 185 | }) 186 | ret <- (ret) 187 | pattern(ret) <- pattern(dat) 188 | varlabels(ret) <- varlabels(dat) 189 | as.surveydata(ret) 190 | } 191 | 192 | 193 | 194 | #' @param origin Either `R` or `SPSS` 195 | #' @export 196 | fix_levels_01 <- function(dat, origin = c("R", "SPSS")) { 197 | origin <- match.arg(origin) 198 | switch(origin, 199 | "R" = fix_levels_01_r(dat), 200 | "SPSS" = fix_levels_01_spss(dat) 201 | ) 202 | } 203 | 204 | 205 | 206 | # other ------------------------------------------------------------------- 207 | 208 | 209 | #' Changes vector to ordered factor, adding NA levels if applicable. 210 | #' 211 | #' @param x character vector 212 | #' @export 213 | #' @family Tools 214 | question_order <- function(x) { 215 | # factor(x, level=levels(x), labels=levels(x), ordered=TRUE) 216 | if (any(is.na(x))) { 217 | addNA(ordered(x)) 218 | } else { 219 | ordered(x) 220 | } 221 | } 222 | 223 | 224 | #' Applies function only to named elements of a list. 225 | #' 226 | #' This is useful to clean only some columns in a list (or `data.frame` or `surveydata` object). This is a simple wrapper around [lapply()] where only the named elements are changed. 227 | #' @param x list 228 | #' @param names character vector identifying which elements of the list to apply FUN 229 | #' @param FUN function to apply. 230 | #' @param ... additional arguments passed to `FUN` 231 | #' @export 232 | #' @family Tools 233 | lapply_names <- function(x, names, FUN, ...) { 234 | oldClass <- class(x) 235 | index <- match(names, names(x)) 236 | if (any(is.na(index))) { 237 | stop(paste("Names not found:", paste(names[is.na(index)], collapse = ", "))) 238 | } 239 | x <- unclass(x) 240 | x[index] <- lapply(x[index], FUN, ...) 241 | class(x) <- oldClass 242 | x 243 | } 244 | -------------------------------------------------------------------------------- /R/dplyr_verbs.R: -------------------------------------------------------------------------------- 1 | common_verb <- function(z, var_labels) { 2 | same <- intersect(names(z), names(var_labels)) 3 | new_labels <- var_labels[same] 4 | diff <- setdiff(names(z), names(var_labels)) 5 | if (length(diff) > 0) { 6 | new_labels[diff] <- setNames(diff, diff) 7 | } 8 | nz <- names(z) 9 | new_labels <- new_labels[nz] 10 | varlabels(z) <- new_labels 11 | as.surveydata(z) 12 | 13 | } 14 | 15 | verb.surveydata <- function(.data, ...) { 16 | var_labels <- varlabels(.data) 17 | z <- NextMethod(.data) 18 | common_verb(z, var_labels) 19 | } 20 | 21 | 22 | 23 | 24 | #' Methods to support dplyr verbs. 25 | #' 26 | #' The `surveydata` package exposes functionality to support some of the `dplyr` verbs, e.g. [dplyr::filter()]. The computation is performed by `dplyr`, and the resulting object is of class `surveydata` (as well as the `dplyr` result). 27 | #' 28 | #' @name dplyr-surveydata 29 | #' @param .data `surveydata` object or `tbl` passed to `dplyr` verb 30 | #' @param ... passed to dplyr verb 31 | #' @keywords internal 32 | #' 33 | #' @importFrom stats setNames 34 | #' @example inst/examples/example-dplyr-verbs.R 35 | NULL 36 | 37 | #' @export 38 | #' @rdname dplyr-surveydata 39 | mutate.surveydata <- verb.surveydata 40 | 41 | 42 | #' @export 43 | #' @rdname dplyr-surveydata 44 | as_tibble.surveydata <- function(x, ..., .name_repair, rownames) { 45 | var_labels <- varlabels(.data) 46 | z <- NextMethod(.data) 47 | common_verb(z, var_labels) 48 | } 49 | # as_tibble.surveydata <- verb.surveydata 50 | 51 | #' @export 52 | #' @rdname dplyr-surveydata 53 | as.tbl.surveydata <- function(x, ...) { 54 | .Deprecated("as_tibble") 55 | as_tibble(x) 56 | } 57 | 58 | 59 | #' @export 60 | #' @rdname dplyr-surveydata 61 | select.surveydata <- verb.surveydata 62 | 63 | 64 | #' @method filter surveydata 65 | #' @export 66 | filter.surveydata <- verb.surveydata 67 | 68 | #' @importFrom dplyr filter 69 | #' @export filter 70 | #' @rdname dplyr-surveydata 71 | #' @name filter 72 | #' @keywords internal 73 | NULL 74 | 75 | #' @export 76 | #' @rdname dplyr-surveydata 77 | arrange.surveydata <- verb.surveydata 78 | 79 | 80 | #' @export 81 | #' @rdname dplyr-surveydata 82 | summarise.surveydata <- verb.surveydata 83 | 84 | #' @export 85 | #' @rdname dplyr-surveydata 86 | summarize.surveydata <- verb.surveydata 87 | 88 | 89 | 90 | #' @export 91 | #' @rdname dplyr-surveydata 92 | slice.surveydata <- verb.surveydata 93 | -------------------------------------------------------------------------------- /R/encoding.R: -------------------------------------------------------------------------------- 1 | # 2 | # surveydata/R/encoding.R by Andrie de Vries Copyright (C) 2011-2017 3 | # 4 | # This program is free software; you can redistribute it and/or modify 5 | # it under the terms of the GNU General Public License as published by 6 | # the Free Software Foundation; either version 2 or 3 of the License 7 | # (at your option). 8 | # 9 | # This program is distributed in the hope that it will be useful, 10 | # but WITHOUT ANY WARRANTY; without even the implied warranty of 11 | # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 12 | # GNU General Public License for more details. 13 | # 14 | # A copy of the GNU General Public License is available at 15 | # http://www.r-project.org/Licenses/ 16 | # 17 | 18 | 19 | #' Converts a character vector to an integer vector. 20 | #' 21 | #' Conversion of character vector to integer vector. The encoding of the character vector can be specified but defaults to the current locale. 22 | #' 23 | #' @param x Character vector 24 | #' @param encoding A character string describing the encoding of x. Defaults to the current locale. See also [iconvlist()] 25 | #' @return An integer vector 26 | #' @seealso [iconv()] 27 | #' @examples 28 | #' encToInt("\xfa") 29 | #' @export 30 | #' @family Functions to clean data 31 | #' @keywords encoding 32 | encToInt <- function(x, encoding = localeToCharset()) { 33 | utf8ToInt(iconv(x, from = encoding[1], to = "UTF-8")) 34 | } 35 | 36 | #' Converts an integer vector to a character vector. 37 | #' 38 | #' Conversion of integer vector to character vector. The encoding of the character vector can be specified but defaults to the current locale. 39 | #' 40 | #' @param x Integer vector 41 | #' @inheritParams encToInt 42 | #' @return A character vector 43 | #' @seealso [iconv()] 44 | #' @examples 45 | #' intToEnc(8212) 46 | #' @export 47 | #' @family Functions to clean data 48 | #' @keywords encoding 49 | intToEnc <- function(x, encoding = localeToCharset()) { 50 | iconv(intToUtf8(x), from = "UTF-8", to = encoding[1]) 51 | } 52 | 53 | #' Fix common encoding problems when working with web imported data. 54 | #' 55 | #' This function tries to resolve typical encoding problems when importing web data on Windows. 56 | #' Typical problems occur with pound and emdash (-), especially when these originated in MS-Word. 57 | #' 58 | #' @param x A character vector 59 | #' @inheritParams encToInt 60 | #' @export 61 | #' @family Functions to clean data 62 | #' @keywords encoding 63 | fix_common_encoding_problems <- function(x, encoding = localeToCharset()) { 64 | # Define character constants that need to be replaced 65 | 66 | ps <- list( 67 | c(intToEnc(194, encoding = encoding), ""), 68 | c(intToEnc(128, encoding = encoding), ""), 69 | c(intToEnc(226, encoding = encoding), "-"), 70 | c(intToEnc(147, encoding = encoding), ""), 71 | c("^Missing$", "NA") 72 | ) 73 | # Now perform the actual processing 74 | for (pt in ps) { 75 | x <- gsub(pt[1], pt[2], x, useBytes = TRUE) 76 | } 77 | x 78 | } 79 | -------------------------------------------------------------------------------- /R/extract.R: -------------------------------------------------------------------------------- 1 | # Subsetting code for surveydata objects 2 | 3 | # 4 | # surveydata/R/extract.R by Andrie de Vries Copyright (C) 2011-2017 5 | # 6 | # This program is free software; you can redistribute it and/or modify 7 | # it under the terms of the GNU General Public License as published by 8 | # the Free Software Foundation; either version 2 or 3 of the License 9 | # (at your option). 10 | # 11 | # This program is distributed in the hope that it will be useful, 12 | # but WITHOUT ANY WARRANTY; without even the implied warranty of 13 | # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 14 | # GNU General Public License for more details. 15 | # 16 | # A copy of the GNU General Public License is available at 17 | # http://www.r-project.org/Licenses/ 18 | # 19 | 20 | 21 | #' Extract or replace subsets of surveydata, ensuring that the varlabels stay synchronized. 22 | #' 23 | #' The `surveydata` package makes it easy to extract specific questions from a surveydata object. Because survey data typically has question names like "Q1_a", "Q1_b", "Q1_c" the extract method for a `surveydata` object makes it easy to extract all columns by simply specifying "Q1" as the argument to the column index. 24 | #' 25 | #' Extraction is similar to data frames, with three important exceptions: 26 | #' * The column argument `j` is evaluated using [which.q()] and will return all columns where the column names match the [pattern()]. 27 | #' * The `drop` argument is `FALSE`. Thus the result will always be a surveydata object, even if only a single column is returned. 28 | #' * All extraction methods retain the `pattern` and `varlabels` arguments. 29 | #' 30 | #' @name Extract 31 | #' @param i row index 32 | #' @param j column index 33 | #' @param drop logical. Passed to `[.data.frame`. Note that the default is `FALSE`. 34 | #' @export 35 | #' @keywords internal 36 | #' @aliases [ "[.surveydata" 37 | #' @method [ surveydata 38 | #' @example /inst/examples/example-extract.R 39 | `[.surveydata` <- function(x, i, j, drop = FALSE) { 40 | name <- NULL 41 | has.drop <- !missing(drop) 42 | Narg <- nargs() - (has.drop) - 1 43 | has.i <- !missing(i) 44 | has.j <- !missing(j) 45 | 46 | if (!has.i & !has.j) return(x) 47 | 48 | if (Narg >= 1L & has.j) { 49 | name <- j 50 | if (is.character(j)) { 51 | w <- which.q(x, j) 52 | if (length(w) != 0) { 53 | j <- name <- w 54 | } 55 | } else { 56 | name <- j 57 | } 58 | } else { 59 | # !has.j 60 | name <- seq_along(x) 61 | } 62 | 63 | if (Narg == 1L & has.i) { 64 | drop <- NULL 65 | name <- i 66 | if (is.character(i)) { 67 | w <- which.q(x, i) 68 | if (length(w) != 0) { 69 | i <- name <- w 70 | } else { 71 | name <- i 72 | } 73 | } else { 74 | name <- i 75 | } 76 | } 77 | 78 | if (is.null(drop)) { 79 | ret <- NextMethod("[<-") 80 | } else { 81 | ret <- NextMethod("[<-", drop = drop) 82 | } 83 | 84 | if (is.data.frame(ret)) { 85 | varlabels(ret) <- varlabels(x)[name] 86 | as.surveydata(ret, ptn = pattern(x), renameVarlabels = FALSE) 87 | } else { 88 | ret 89 | } 90 | } 91 | 92 | 93 | 94 | #' @rdname Extract 95 | #' @method [<- surveydata 96 | #' @usage \method{[}{surveydata}(x, i, j) <- value 97 | #' @export 98 | #' @keywords internal 99 | `[<-.surveydata` <- function(x, i, j, value) { 100 | has.value <- !missing(value) 101 | Narg <- nargs() - (has.value) - 1 102 | 103 | has.i <- !missing(i) 104 | has.j <- !missing(j) 105 | if (Narg >= 1L & has.j) { 106 | if (is.character(j)) { 107 | newname <- j 108 | w <- which.q(x, j) 109 | if (length(w) != 0) { 110 | j <- w 111 | name <- j 112 | } else { 113 | name <- newname 114 | } 115 | } else { 116 | name <- j 117 | } 118 | } 119 | 120 | if (Narg == 1L & has.i) { 121 | if (is.character(i)) { 122 | newname <- i 123 | w <- which.q(x, i) 124 | if (length(w) != 0) { 125 | i <- w 126 | name <- i 127 | } else { 128 | name <- newname 129 | } 130 | } else { 131 | name <- i 132 | } 133 | } 134 | 135 | xorig <- x 136 | 137 | labels <- varlabels(x) 138 | if (is.null(value)) { 139 | labels <- labels[-name] 140 | } 141 | if (length(w) == 0) { 142 | labels[newname] <- newname 143 | } 144 | 145 | ret <- NextMethod("[<-") 146 | varlabels(ret) <- labels 147 | as.surveydata(ret, ptn = pattern(xorig), renameVarlabels = FALSE) 148 | } 149 | 150 | 151 | #' @rdname Extract 152 | #' @aliases $<- $<-.surveydata 153 | #' @param x surveydata object 154 | #' @param name Names of columns 155 | #' @param value New value 156 | #' @method $<- surveydata 157 | #' @usage \method{$}{surveydata}(x, name) <- value 158 | #' @export 159 | #' @keywords internal 160 | #' @seealso [surveydata-package], [varlabels] 161 | `$<-.surveydata` <- function(x, name, value) { 162 | labels <- varlabels(x) 163 | if (is.null(value)) { 164 | labels <- labels[names(labels) != name] 165 | } 166 | if (length(grep(name, names(x))) == 0) { 167 | labels[name] <- name 168 | } 169 | x <- as.data.frame(x) 170 | x <- NextMethod("$<-") 171 | varlabels(x) <- labels 172 | as.surveydata(x, renameVarlabels = FALSE) 173 | } 174 | -------------------------------------------------------------------------------- /R/merge.R: -------------------------------------------------------------------------------- 1 | # Defines merge method 2 | 3 | # 4 | # surveydata/R/merge.R by Andrie de Vries Copyright (C) 2011-2017 5 | # 6 | # This program is free software; you can redistribute it and/or modify 7 | # it under the terms of the GNU General Public License as published by 8 | # the Free Software Foundation; either version 2 or 3 of the License 9 | # (at your option). 10 | # 11 | # This program is distributed in the hope that it will be useful, 12 | # but WITHOUT ANY WARRANTY; without even the implied warranty of 13 | # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 14 | # GNU General Public License for more details. 15 | # 16 | # A copy of the GNU General Public License is available at 17 | # http://www.r-project.org/Licenses/ 18 | # 19 | 20 | 21 | #' Merges variable.labels attribute from two surveydata objects 22 | #' 23 | #' Merges variable labels from two data objects. The labels from dat1 takes precedence. 24 | #' 25 | #' @param dat1 surveydata object 26 | #' @param dat2 surveydata object 27 | #' @param new_names A vector with names of the merged varlabels. Defaults to the union of names of dat1 and dat2 28 | #' @keywords internal 29 | merge_varlabels <- function(dat1, dat2, new_names = union(names(dat1), names(dat2))) { 30 | labels1 <- varlabels(dat1) 31 | labels2 <- varlabels(dat2) 32 | names(labels1) <- names(dat1) 33 | names(labels2) <- names(dat2) 34 | # merge(labels1, labels2) 35 | ret <- new_names 36 | names(ret) <- ret 37 | ret[names(labels2)] <- labels2 38 | ret[names(labels1)] <- labels1 39 | ret 40 | } 41 | 42 | 43 | #' Merge surveydata objects. 44 | #' 45 | #' The base R merge will merge data but not all of the attributes. This function also merges the variable.labels attribute. 46 | #' 47 | #' @name merge 48 | #' @aliases merge merge.surveydata 49 | #' @param x surveydata object 50 | #' @param y surveydata object 51 | #' @param ... Other parameters passed to [merge()] 52 | #' @method merge surveydata 53 | #' @export 54 | merge.surveydata <- function(x, y, ...) { 55 | tmp <- merge(as.data.frame(x), as.data.frame(y), ...) 56 | newlabels <- merge_varlabels(x, y, new_names = names(tmp)) 57 | varlabels(tmp) <- newlabels 58 | if (!identical(pattern(x), pattern(y))) warning("In merge of surveydata objects, patterns of objects differ") 59 | as.surveydata(tmp, ptn = pattern(x)) 60 | } 61 | 62 | 63 | #' Combines surveydata object by columns. 64 | #' 65 | #' @param ... surveydata objects 66 | #' @param deparse.level ignored 67 | #' @method cbind surveydata 68 | #' @export 69 | cbind.surveydata <- function(..., deparse.level = 1) { 70 | ptn <- pattern(..1) 71 | varlab <- do.call(c, lapply(list(...), varlabels)) 72 | ret <- do.call(cbind.data.frame, list(...)) 73 | ret <- ret[, names(varlab)] 74 | varlabels(ret) <- varlab 75 | as.surveydata(ret) 76 | } 77 | -------------------------------------------------------------------------------- /R/opentext.R: -------------------------------------------------------------------------------- 1 | #' Print open text questions. 2 | #' 3 | #' @param data data 4 | #' @param q Question number 5 | #' @param cat If TRUE, prints results using `cat()` 6 | #' 7 | #' @family open text functions 8 | #' @export 9 | #' @examples 10 | #' print_opentext(membersurvey, "Q33") 11 | print_opentext <- function(data, q, cat = TRUE) { 12 | assert_that(is.surveydata(data)) 13 | Q_number <- enquo(q) 14 | assert_that(is.character(q)) 15 | 16 | r <- data %>% 17 | un_surveydata() %>% 18 | select(!!Q_number) %>% 19 | rename(txt = !!Q_number) %>% 20 | mutate(txt = as.character(txt)) %>% 21 | filter(!is.na(txt)) %>% 22 | mutate( 23 | txt = sQuote(txt) 24 | ) %>% 25 | distinct() %>% 26 | .[[1]] 27 | if (cat) { 28 | cat(r) 29 | invisible(r) 30 | } else { 31 | r 32 | } 33 | } 34 | 35 | 36 | utils::globalVariables(c("startlanguage", "txt")) 37 | 38 | #' Converts free format question text to datatable using the `DT` package. 39 | #' 40 | #' @param data surveydata object 41 | #' @param q Question 42 | #' 43 | #' @importFrom DT datatable 44 | #' 45 | #' @examples 46 | #' as_opentext_datatable(membersurvey, "Q33") 47 | #' @family open text functions 48 | #' @export 49 | as_opentext_datatable <- function(data, q) { 50 | assert_that(is.surveydata(data)) 51 | Q_number <- enquo(q) 52 | assert_that(is.character(q)) 53 | 54 | data %>% 55 | un_surveydata() %>% 56 | select(!!Q_number) %>% 57 | rename(txt = !!Q_number) %>% 58 | mutate(txt = as.character(txt)) %>% 59 | filter(!is.na(txt)) %>% 60 | mutate( 61 | txt = sQuote(txt) 62 | ) %>% 63 | distinct() %>% 64 | DT::datatable() 65 | } 66 | 67 | # as_opentext_datatable <- function(.data, Q_number){ 68 | # Q_number <- enquo(Q_number) 69 | # .data %>% 70 | # un_surveydata() %>% 71 | # select(!!Q_number, startlanguage) %>% 72 | # rename(txt = !!Q_number, lang = startlanguage) %>% 73 | # filter(!is.na(txt) & nchar(txt) > 3) %>% 74 | # mutate( 75 | # nchar = nchar(txt), 76 | # # txt = gsub("\\.\n+", ". ", txt) %>% gsub("\n+", " ", .), 77 | # txt = sQuote(txt) 78 | # ) %>% 79 | # distinct() %>% 80 | # arrange(lang, -nchar) %>% 81 | # DT::datatable() 82 | # } 83 | -------------------------------------------------------------------------------- /R/pattern.R: -------------------------------------------------------------------------------- 1 | 2 | # 3 | # surveydata/R/pattern.R by Andrie de Vries Copyright (C) 2011-2017 4 | # 5 | # This program is free software; you can redistribute it and/or modify 6 | # it under the terms of the GNU General Public License as published by 7 | # the Free Software Foundation; either version 2 or 3 of the License 8 | # (at your option). 9 | # 10 | # This program is distributed in the hope that it will be useful, 11 | # but WITHOUT ANY WARRANTY; without even the implied warranty of 12 | # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 13 | # GNU General Public License for more details. 14 | # 15 | # A copy of the GNU General Public License is available at 16 | # http://www.r-project.org/Licenses/ 17 | # 18 | 19 | 20 | 21 | #' Returns and updates pattern attribute. 22 | #' 23 | #' The pattern attribute contains information about the separator character used to name sub-questions in the data. Survey software typically makes use of underscores to distinguish sub-questions in a grid of questions, e.g. "Q4_1", "Q4_2", "Q4_3", "Q4_other". The function [pattern()] returns the `pattern` attribute, and [pattern<-] updates the attribute. 24 | #' 25 | #' 26 | #' @aliases pattern pattern<- 27 | #' @param x surveydata object 28 | #' @export pattern 29 | #' @family Attribute functions 30 | #' @seealso [as.surveydata()], [which.q()] 31 | #' @example inst/examples/example-pattern.R 32 | pattern <- function(x) { 33 | attr(x, "pattern") 34 | } 35 | 36 | #' @rdname pattern 37 | #' @usage pattern(x) <- value 38 | #' @param value New value 39 | #' @export 40 | #' @keywords internal 41 | "pattern<-" <- function(x, value) { 42 | attr(x, "pattern") <- value 43 | x 44 | } 45 | 46 | 47 | #' Removes pattern from attributes list. 48 | #' 49 | #' @param x Surveydata object 50 | #' @keywords Internal 51 | rm.pattern <- function(x) { 52 | pattern(x) <- NULL 53 | x 54 | } 55 | 56 | #' Removes pattern and variable.labels from attributes list. 57 | #' 58 | #' @param x Surveydata object 59 | #' @keywords Internal 60 | rm.attrs <- function(x) { 61 | attr(x, "pattern") <- NULL 62 | attr(x, "variable.labels") <- NULL 63 | x 64 | } 65 | -------------------------------------------------------------------------------- /R/plots.R: -------------------------------------------------------------------------------- 1 | 2 | 3 | #' @importFrom purrr map_chr 4 | str_wrap_to_width <- function(x, width = 30) { 5 | map_chr(x, ~ paste(strwrap(., width = width), collapse = "\n")) 6 | } 7 | 8 | utils::globalVariables(c(".key", ".value")) 9 | order_key_by_value <- function(data) { 10 | if (!is.factor(data$.key)) { 11 | data %>% 12 | arrange(.value) %>% 13 | mutate(.key = factor(.key, .key)) 14 | } else { 15 | data 16 | } 17 | } 18 | 19 | 20 | 21 | 22 | #' Construct plot title from the question text, wrapping at the desired width. 23 | #' 24 | #' This creates a plot title using `[ggplot2::ggtitle()]`. The main title is string wrapped, and the subtitle is the number of observations in the data. 25 | #' 26 | #' @param data surveydata object 27 | #' @param q Question 28 | #' @param width Passed to [strwrap()] 29 | #' 30 | #' @export 31 | survey_plot_title <- function(data, q, width = 50) { 32 | ggtitle( 33 | label = paste0( 34 | q, ": ", 35 | question_text_common(data, q) 36 | ) %>% str_wrap_to_width(50), 37 | subtitle = paste( 38 | "n =", 39 | data[, q] %>% filter(complete.cases(.)) %>% nrow() 40 | ) 41 | ) 42 | } 43 | 44 | utils::globalVariables(c(".")) 45 | 46 | #' Plot data in yes/no format. 47 | #' 48 | #' @inheritParams survey_plot_title 49 | #' 50 | #' @export 51 | #' @family survey plotting functions 52 | #' @example inst/examples/example-plots.R 53 | survey_plot_yes_no <- function(data, q) { 54 | dat <- data[, q] 55 | single <- ncol(dat) == 1 56 | if (single) { 57 | sdat <- dat %>% 58 | mutate(.key = .[[1]]) %>% 59 | filter(!is.na(.key)) %>% 60 | group_by(.key) %>% 61 | summarise(.value = n()) %>% 62 | mutate(.value = .value / sum(.value)) 63 | } else { 64 | sdat <- dat %>% 65 | map_df(function(x) sum(na.omit(x) == "Yes") / length(na.omit(x))) 66 | names(sdat) <- question_text_unique(data, q) %>% str_wrap_to_width(30) 67 | sdat <- gather(sdat) %>% 68 | arrange(.value) %>% 69 | mutate(.key = factor(.key, .key)) 70 | } 71 | ggplot(sdat, aes(x = .key, y = .value)) + 72 | geom_point(colour = "blue") + 73 | scale_y_continuous(labels = scales::percent, limits = c(0, NA)) + 74 | coord_flip() + 75 | survey_plot_title(data, q) + 76 | xlab(NULL) + 77 | ylab(NULL) 78 | } 79 | 80 | 81 | #' Plots single and as multi-response questions. 82 | #' 83 | #' @inheritParams survey_plot_title 84 | #' 85 | #' @export 86 | #' @family survey plotting functions 87 | #' @example inst/examples/example-plots.R 88 | survey_plot_question <- function(data, q) { 89 | dat <- data[, q] 90 | dat %>% 91 | mutate(.key = .[[1]]) %>% 92 | select(.key) %>% 93 | filter(!is.na(.key)) %>% 94 | group_by(.key) %>% 95 | summarize(.value = n()) %>% 96 | mutate(.value = .value / sum(.value)) %>% 97 | order_key_by_value() %>% 98 | ggplot(aes(x = .key, y = .value)) + 99 | geom_point(colour = "blue") + 100 | coord_flip() + 101 | survey_plot_title(data, q) + 102 | scale_y_continuous(labels = scales::percent, limits = c(0, NA)) + 103 | xlab(NULL) + 104 | ylab(NULL) 105 | } 106 | 107 | 108 | 109 | # fun = function(x){ 110 | # (sum(x %in% sats_levels[5:7]) - sum(x %in% sats_levels[1:3])) / 111 | # # (length(x) - sum(x %in% sats_levels[4])) 112 | # length(x) 113 | # }, title = "Net satisfaction") 114 | # 115 | # plot_sats(resp, "Q18", fun = function(x){ 116 | # sum(x %in% sats_levels[6:7]) / length(x) 117 | # }, title = "Percentage in top 3 box") 118 | # 119 | # plot_sats(resp, "Q18", fun = function(x){ 120 | # sum(x %in% sats_levels[6:7]) / length(x) 121 | # }, title = "Percentage in top 2 box") 122 | 123 | 124 | utils::globalVariables(c("sats", "aspect")) 125 | 126 | #' Plot satisfaction questions. 127 | #' 128 | #' @inheritParams survey_plot_title 129 | #' @param fun Aggregation function, one of `net` (compute net satisfaction score), `top3` (compute top 3 box score) and `top2` (compute top 2 box score) 130 | #' 131 | #' @export 132 | #' @family survey plotting functions 133 | #' @example inst/examples/example-plots.R 134 | survey_plot_satisfaction <- function(data, q, fun = c("net", "top3", "top2")) { 135 | fun <- match.arg(fun) 136 | sats_levels <- levels(data[, q][[1]]) 137 | fun <- switch( 138 | fun, 139 | net = function(x) { 140 | (sum(x %in% tail(sats_levels, 3)) - sum(x %in% head(sats_levels, 3))) / length(x) 141 | }, 142 | top3 = function(x) sum(x %in% tail(sats_levels, 3)) / length(x), 143 | top2 = function(x) sum(x %in% sats_levels[6:7]) / length(x) 144 | ) 145 | data.frame( 146 | sats = map_dbl(data[, q], fun), 147 | aspect = question_text_unique(data, q) 148 | ) %>% 149 | arrange(-sats) %>% 150 | mutate(aspect = factor(aspect, aspect)) %>% 151 | ggplot(aes(x = aspect, y = sats)) + 152 | geom_point(colour = "blue") + 153 | scale_y_continuous( 154 | breaks = seq(0, 1, by = 0.5), 155 | minor_breaks = seq(0, 1, by = 0.1), 156 | limits = c(0, 1) 157 | ) + 158 | coord_flip() + 159 | survey_plot_title(data, q) + 160 | xlab(NULL) + 161 | ylab(NULL) 162 | } 163 | -------------------------------------------------------------------------------- /R/questions.R: -------------------------------------------------------------------------------- 1 | # Question handling in surveydata objects 2 | 3 | # 4 | # surveydata/R/questions.R by Andrie de Vries Copyright (C) 2011-2017 5 | # 6 | # This program is free software; you can redistribute it and/or modify 7 | # it under the terms of the GNU General Public License as published by 8 | # the Free Software Foundation; either version 2 or 3 of the License 9 | # (at your option). 10 | # 11 | # This program is distributed in the hope that it will be useful, 12 | # but WITHOUT ANY WARRANTY; without even the implied warranty of 13 | # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 14 | # GNU General Public License for more details. 15 | # 16 | # A copy of the GNU General Public License is available at 17 | # http://www.r-project.org/Licenses/ 18 | # 19 | 20 | 21 | qPattern <- function(Q, ptn) { 22 | paste0(ptn[1], Q, ptn[2]) 23 | } 24 | 25 | 26 | #' Identifies the columns indices corresponding to a specific question. 27 | #' 28 | #' In many survey systems, sub-questions take the form "Q1_a", "Q1_b", with the main question and sub-question separated by an underscore. This function conveniently returns column index of matches found for a question id in a [surveydata] object. It does this by using the [pattern] attribute of the `surveydata` object. 29 | #' 30 | #' @inheritParams as.surveydata 31 | #' @param Q Character string with question number, e.g. "Q2" 32 | #' @seealso [questions()] to return all questions matching the [pattern()] 33 | #' @family Question functions 34 | #' @keywords Questions 35 | #' @export 36 | #' @example /inst/examples/example-questions.R 37 | which.q <- function(x, Q, ptn = pattern(x)) { 38 | if (!is.list(ptn)) stop("ptn must be a list of two elements") 39 | num <- !is.na(suppressWarnings(as.numeric(Q))) 40 | chr <- !num 41 | whichQone <- function(qx) { 42 | prefix <- "^" 43 | postfix <- sprintf("($|(%s.+$))", ptn$sep) 44 | pattern <- paste0(prefix, qx, postfix) 45 | w <- grep(pattern, names(x)) 46 | w[names(x)[w] != paste0(qx, ptn[["sep"]], ptn[["exclude"]])] 47 | } 48 | if (any(num)) { 49 | x1 <- as.numeric(Q[which(num)]) 50 | } else { 51 | x1 <- NULL 52 | } 53 | if (any(chr)) { 54 | if (length(which(chr)) == 1L) { 55 | ret <- whichQone(Q[chr]) 56 | } else { 57 | ret <- unname(sapply(Q[chr], whichQone)) 58 | } 59 | if (is.list(ret)) { 60 | x2 <- do.call(c, ret) 61 | } else { 62 | x2 <- ret 63 | } 64 | } else { 65 | x2 <- NULL 66 | } 67 | c(x1, x2) 68 | } 69 | 70 | 71 | 72 | #' Returns a list of all the unique questions in the surveydata object. 73 | #' 74 | #' In many survey systems, sub-questions take the form Q1_a, Q1_b, with the main question and sub-question separated by an underscore. This function conveniently returns all of the main questions in a [surveydata()] object. It does this by using the [pattern()] attribute of the surveydata object. 75 | #' 76 | #' @inheritParams as.surveydata 77 | #' @inheritParams which.q 78 | #' @seealso which.q 79 | #' @family Question functions 80 | #' @keywords Questions 81 | #' @export 82 | #' @return numeric vector 83 | #' @example /inst/examples/example-questions.R 84 | questions <- function(x, ptn = pattern(x)) { 85 | n <- names(x) 86 | ptn1 <- sprintf(".*%s%s$", ptn[1], ptn[2]) 87 | other <- grepl(ptn1, n) 88 | ptn2 <- sprintf("^(.*)(%s.*)+", ptn[1]) 89 | n[!other] <- gsub(ptn2, "\\1", n[!other]) 90 | unique(n) 91 | } 92 | 93 | 94 | 95 | #' Returns question text. 96 | #' 97 | #' Given a question id, e.g. "Q4", returns question text for this question. Note that this returns. The functions [question_text_unique()] and [question_text_common()] returns the unique and common components of the question text. 98 | #' 99 | #' @param x A surveydata object 100 | #' @param Q The question id, e.g. "Q4". If not supplied, returns the text for all questions. 101 | #' 102 | #' @family Question functions 103 | #' @keywords Questions 104 | #' @export 105 | #' @return character vector 106 | #' @example /inst/examples/example-questions.R 107 | question_text <- function(x, Q) { 108 | do_one <- function(q) { 109 | w <- which.q(x, q) 110 | as.character(varlabels(x)[w]) 111 | } 112 | if (missing(Q) || is.null(Q)) { 113 | sapply(questions(x), do_one) 114 | } else { 115 | do_one(Q) 116 | } 117 | } 118 | 119 | 120 | #' Returns unique elements of question text. 121 | #' 122 | #' Given a question id, e.g. "Q4", finds all sub-questions, e.g. Q4_1, Q4_2, etc, 123 | #' and returns the question text that is unique to each 124 | #' 125 | #' @inheritParams question_text 126 | #' @family Question functions 127 | #' @keywords Questions 128 | #' @export 129 | #' @return character vector 130 | #' @example /inst/examples/example-questions.R 131 | question_text_unique <- function(x, Q) { 132 | text <- question_text(x, Q) 133 | split_common_unique(text)$unique 134 | } 135 | 136 | 137 | #' Returns common element of question text. 138 | #' 139 | #' Given a question id, e.g. "Q4", finds all sub-questions, e.g. "Q4_1", "Q4_2", etc, 140 | #' and returns the question text that is common to each. 141 | #' 142 | #' @inheritParams question_text 143 | #' @family Question functions 144 | #' @keywords Questions 145 | #' @export 146 | #' @return character vector 147 | #' @example /inst/examples/example-questions.R 148 | question_text_common <- function(x, Q) { 149 | text <- question_text(x, Q) 150 | split_common_unique(text)$common 151 | } 152 | 153 | 154 | #' Get common and unique text in question based on regex pattern identification. 155 | #' 156 | #' @param x A character vector 157 | #' @family Question functions 158 | #' @keywords Questions 159 | #' @importFrom dplyr mutate arrange slice 160 | #' @param ptn A [regex()] pattern that defines how the string should be split into common and unique elements 161 | split_common_unique <- function(x, ptn = NULL) { 162 | if (is.null(ptn)) { 163 | ptn <- c( 164 | # Find "Please tell us" in "Email (Please tell us)" 165 | "^(.+)\\s*\\((.+?)\\)$", 166 | # Find "Please tell (foo) us" in "Email (Please tell (foo) us)" 167 | "^(.+?)\\((.+)\\)$", 168 | # Find "What is your choice?" in "What is your choice?: Email" 169 | "^(.+)\\s*:\\s*(.+)$", 170 | # Find "Q3" in "Q3(001)Email" or "Q03[01] Email" 171 | "^(.+\\d+)\\s*[[(]\\d+[])]\\s?(.+)$", 172 | # Find "What is your choice?" in "[Email]What is your choice?" 173 | "^\\[(.+)\\]\\s*(.+)$", 174 | # Find "What is your choice?" in "What is your choice? [Email]" 175 | "^(.+?)\\s*\\[(.+)\\]$", 176 | "^(.+?_)(\\d+)" 177 | ) 178 | } 179 | length_pattern <- function(ptn, x) { 180 | do_one <- function(n) length(unique(gsub(ptn, paste0("\\", n), x))) 181 | tibble( 182 | ptn = ptn, 183 | n = sum(grepl(ptn, x)), 184 | left = do_one(1), 185 | right = do_one(2) 186 | ) 187 | } 188 | 189 | identify_pattern <- function(ptn, x) { 190 | left <- right <- n <- common <- NULL # R CMD check trick 191 | purrr::map_df(ptn, length_pattern, x) %>% 192 | mutate( 193 | common = pmin(left, right), 194 | unique = pmax(left, right), 195 | grep_c = if_else(left < right, "\\1", "\\2"), 196 | grep_u = if_else(left < right, "\\2", "\\1") 197 | ) %>% 198 | arrange(-n, common) %>% 199 | slice(1) 200 | } 201 | 202 | bp <- identify_pattern(ptn, x) # best pattern 203 | z <- list( 204 | common = trimws(gsub(bp$ptn, bp$grep_c, x)[1]), 205 | unique = trimws(gsub(bp$ptn, bp$grep_u, x)) 206 | ) 207 | nNa <- sum(is.na(z$unique)) 208 | if (nNa > 0) z$unique[is.na(z$unique)] <- paste("NA_", seq_len(nNa), sep = "") 209 | z 210 | } 211 | -------------------------------------------------------------------------------- /R/strings.R: -------------------------------------------------------------------------------- 1 | ### String functions 2 | 3 | # 4 | # surveydata/R/strings.R by Andrie de Vries Copyright (C) 2011-2017 5 | # 6 | # This program is free software; you can redistribute it and/or modify 7 | # it under the terms of the GNU General Public License as published by 8 | # the Free Software Foundation; either version 2 or 3 of the License 9 | # (at your option). 10 | # 11 | # This program is distributed in the hope that it will be useful, 12 | # but WITHOUT ANY WARRANTY; without even the implied warranty of 13 | # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 14 | # GNU General Public License for more details. 15 | # 16 | # A copy of the GNU General Public License is available at 17 | # http://www.r-project.org/Licenses/ 18 | # 19 | 20 | 21 | #' Finds the common and unique elements in a character vector. 22 | #' 23 | #' Function takes a character string as input and find the common and 24 | #' unique elements. Assumes that the common element is at start of string. 25 | #' 26 | #' @param string Character vector 27 | #' @return list of common and unique strings 28 | #' @keywords string 29 | #' @export 30 | #' @family Strings 31 | #' @examples 32 | #' test <- c("Q_1", "Q_2", "Q_3") 33 | #' strCommonUnique(test)$common 34 | #' strCommonUnique(test)$unique 35 | strCommonUnique <- function(string) { 36 | x <- as.character(string) 37 | y <- string 38 | 39 | ## Handles case with a single string element 40 | if (length(x) <= 1) { 41 | return(list(common = x[1], unique = "")) 42 | } 43 | 44 | ## Handles case where all elements are identical 45 | all_identical <- all(as.logical(lapply(x, function(f) x[1] == f))) 46 | if (all_identical) { 47 | return(list(common = x[1], unique = rep("", length(x)))) 48 | } 49 | 50 | ## Handles case where shortest element has length 0 51 | if (min(nchar(x)) == 0) { 52 | return(list(common = "", unique = x)) 53 | } 54 | 55 | ## Handles case where shortest element has length 1 56 | if (min(nchar(x)) == 1) { 57 | x1 <- sapply(x, function(f) { 58 | unlist(strsplit(f, NULL))[1] 59 | }) 60 | all_identical <- all(as.logical(lapply(x1, function(f) x1[1] == f))) 61 | if (all_identical) { 62 | return( 63 | list(common = substr(x[1], 1, 1), unique = substr(x, 2, nchar(x))) 64 | ) 65 | } else { 66 | return( 67 | list(common = "", unique = x) 68 | ) 69 | } 70 | } 71 | 72 | 73 | # Make all strings the same length as shortest string 74 | x1 <- substr(x, 1, min(nchar(x))) 75 | # Create matrix of characters 76 | split <- lapply(x1, function(f) { 77 | unlist(strsplit(f, NULL)) 78 | }) 79 | # Test which characters are identical 80 | identical <- sapply(split, function(f) { 81 | f == split[[1]] 82 | }) ### aaply 83 | common <- apply(identical, 2, function(f) { 84 | which(f == FALSE)[1] 85 | }) ### aaply 86 | mincommon <- min(common, na.rm = TRUE) - 1 87 | # browser() 88 | if (mincommon < 1) { 89 | return(list(common = "", unique = x)) 90 | } else { 91 | return(list( 92 | common = substr(x[1], 1, mincommon), 93 | unique = substr(x, mincommon + 1, nchar(x)) 94 | )) 95 | } 96 | } 97 | -------------------------------------------------------------------------------- /R/surveydata-deprecated.R: -------------------------------------------------------------------------------- 1 | #' Deprecated functions. 2 | #' 3 | #' @description 4 | #' These functions have all been superseded with functions using `snake_case` function names. 5 | #' 6 | #' * `hasDK`: [has_dont_know()] 7 | #' * `removeDK`: [remove_dont_know()] 8 | #' * `removeAllDK`: [remove_all_dont_know()] 9 | #' * `leveltestSPSS`: [leveltest_spss()] 10 | #' * `leveltestR`: [leveltest_r()] 11 | #' * `fixLevels01SPSS`: [fix_levels_01_spss()] 12 | #' * `fixLevels01R`: [fix_levels_01_r()] 13 | #' * `fixLevels01`: [fix_levels_01()] 14 | #' * `qOrder`: [question_order()] 15 | #' * `lapplyNames`: [lapply_names()] 16 | #' * `fixCommonEncodingProblems`: [fix_common_encoding_problems()] 17 | #' 18 | #' @param ... passed to replacement function 19 | #' 20 | #' @export 21 | #' @keywords internal 22 | #' @rdname surveydata-deprecated 23 | hasDK <- function(...) { 24 | .Deprecated("has_dont_know") 25 | has_dont_know(...) 26 | } 27 | 28 | #' @export 29 | #' @keywords internal 30 | #' @rdname surveydata-deprecated 31 | removeDK <- function(...) { 32 | .Deprecated("remove_dont_know") 33 | remove_dont_know(...) 34 | } 35 | 36 | #' @export 37 | #' @keywords internal 38 | #' @rdname surveydata-deprecated 39 | removeAllDK <- function(...) { 40 | .Deprecated("remove_all_dont_know") 41 | remove_all_dont_know(...) 42 | } 43 | 44 | 45 | #' @export 46 | #' @keywords internal 47 | #' @rdname surveydata-deprecated 48 | leveltestSPSS <- function(...) { 49 | .Deprecated("leveltest_spss") 50 | leveltest_spss(...) 51 | } 52 | 53 | 54 | #' @export 55 | #' @keywords internal 56 | #' @rdname surveydata-deprecated 57 | leveltestR <- function(...) { 58 | .Deprecated("leveltest_r") 59 | leveltest_r(...) 60 | } 61 | 62 | 63 | #' @export 64 | #' @keywords internal 65 | #' @rdname surveydata-deprecated 66 | fixLevels01SPSS <- function(...) { 67 | .Deprecated("fix_levels_01_spss") 68 | fix_levels_01_spss(...) 69 | } 70 | 71 | 72 | #' @export 73 | #' @keywords internal 74 | #' @rdname surveydata-deprecated 75 | fixLevels01R <- function(...) { 76 | .Deprecated("fix_levels_01_r") 77 | fix_levels_01_r(...) 78 | } 79 | 80 | 81 | #' @export 82 | #' @keywords internal 83 | #' @rdname surveydata-deprecated 84 | fixLevels01 <- function(...) { 85 | .Deprecated("fix_levels_01") 86 | fix_levels_01(...) 87 | } 88 | 89 | 90 | #' @export 91 | #' @keywords internal 92 | #' @rdname surveydata-deprecated 93 | qOrder <- function(...) { 94 | .Deprecated("question_order") 95 | question_order(...) 96 | } 97 | 98 | 99 | #' @export 100 | #' @keywords internal 101 | #' @rdname surveydata-deprecated 102 | lapplyNames <- function(...) { 103 | .Deprecated("lapply_names") 104 | lapply_names(...) 105 | } 106 | 107 | #' @export 108 | #' @keywords internal 109 | #' @rdname surveydata-deprecated 110 | fixCommonEncodingProblems <- function(...) { 111 | .Deprecated(fix_common_encoding_problems) 112 | fix_common_encoding_problems(...) 113 | } 114 | 115 | 116 | #' @export 117 | #' @keywords internal 118 | #' @rdname surveydata-deprecated 119 | qText <- function(...) { 120 | .Deprecated("question_text") 121 | question_text(...) 122 | } 123 | 124 | 125 | #' @export 126 | #' @keywords internal 127 | #' @rdname surveydata-deprecated 128 | qTextUnique <- function(...) { 129 | .Deprecated("question_text_unique") 130 | question_text_unique(...) 131 | } 132 | 133 | 134 | #' @export 135 | #' @keywords internal 136 | #' @rdname surveydata-deprecated 137 | qTextCommon <- function(...) { 138 | .Deprecated("question_text_common") 139 | question_text_common(...) 140 | } 141 | 142 | 143 | -------------------------------------------------------------------------------- /R/surveydata-package.R: -------------------------------------------------------------------------------- 1 | # package documentation 2 | # 3 | # Author: Andrie 4 | #------------------------------------------------------------------------------ 5 | 6 | 7 | #' Tools, classes and methods to manipulate survey data. 8 | #' 9 | #' Surveydata objects have been designed to function with SPSS export data, i.e. the result of an SPSS import, [foreign::read.spss()]. This type of data is contained in a data.frame, with information about the questionnaire text in the `variable.labels` attribute. Surveydata objects keep track of the variable labels, by offering methods for renaming, subsetting, etc. 10 | #' 11 | #' Coercion functions: 12 | #' * [as.surveydata()] 13 | #' * [is.surveydata()] 14 | #' * [as.data.frame.surveydata()] 15 | #' 16 | #' To access and modify attributes: 17 | #' * [pattern()] 18 | #' * [varlabels()] 19 | #' 20 | #' To subset or merge surveydata objects: 21 | #' * [surveydata::merge()] 22 | #' * [surveydata::Extract()] 23 | #' * [cbind.surveydata()] 24 | #' 25 | #' To extract question text from varlabels: 26 | #' * [question_text()] 27 | #' * [question_text_common()] 28 | #' * [question_text_unique()] 29 | #' 30 | #' To fix common encoding problems: 31 | #' * [encToInt()] 32 | #' * [intToEnc()] 33 | #' * [fix_common_encoding_problems()] 34 | #' 35 | #' To clean data: 36 | #' * [remove_dont_know()] to remove "Don't know" responses 37 | #' * [remove_all_dont_know()] to remove "Don't know" responses from all questions 38 | #' * [fix_levels_01()] to fix level formatting of all question with Yes/No type answers 39 | #' 40 | #' Miscellaneous tools: 41 | #' * [dropout()] to determine questions where respondents drop out 42 | #' 43 | #' 44 | #' @name surveydata-package 45 | #' @aliases surveydata surveydata-package 46 | #' @docType package 47 | #' @importFrom stats na.omit 48 | #' @importFrom utils localeToCharset 49 | #' @importFrom dplyr tibble if_else 50 | #' @importFrom magrittr '%>%' 51 | #' @importFrom purrr map 52 | #' 53 | #' @import rlang 54 | #' @import ggplot2 55 | #' @import dplyr 56 | #' @importFrom purrr map_chr map_dbl map_df 57 | #' @importFrom tidyr gather 58 | #' @importFrom scales percent 59 | #' @importFrom stats complete.cases na.omit 60 | #' @importFrom utils head tail 61 | #' 62 | #' @importFrom assertthat assert_that 63 | #' 64 | #' @title Tools, classes and methods to manipulate survey data. 65 | #' @author Andrie de Vries \email{apdevries@@gmail.com} 66 | #' @keywords package 67 | #' 68 | #' @example /inst/examples/example-asSurveydata.R 69 | #' @example /inst/examples/example-questions.R 70 | NULL 71 | 72 | 73 | #' Data frame with survey data of member satisfaction survey. 74 | #' 75 | #' @docType data 76 | #' @keywords datasets 77 | #' @name membersurvey 78 | #' @usage membersurvey 79 | #' @format data frame 80 | NULL 81 | -------------------------------------------------------------------------------- /R/surveydata.R: -------------------------------------------------------------------------------- 1 | # Creates surveydata class and provides methods 2 | 3 | # 4 | # surveydata/R/surveydata.R by Andrie de Vries Copyright (C) 2011-2017 5 | # 6 | # This program is free software; you can redistribute it and/or modify 7 | # it under the terms of the GNU General Public License as published by 8 | # the Free Software Foundation; either version 2 or 3 of the License 9 | # (at your option). 10 | # 11 | # This program is distributed in the hope that it will be useful, 12 | # but WITHOUT ANY WARRANTY; without even the implied warranty of 13 | # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 14 | # GNU General Public License for more details. 15 | # 16 | # A copy of the GNU General Public License is available at 17 | # http://www.r-project.org/Licenses/ 18 | # 19 | 20 | 21 | #' Coercion from and to surveydata. 22 | #' 23 | #' Methods for creating `surveydata` objects, testing for class, and coercion from other objects. 24 | #' 25 | #' The function`un_surveydata()` removes the `surveydata` class from the object, leaving intact the other classes, e.g. `data.frame` or `tibble` 26 | #' 27 | #' @param x Object to coerce to surveydata 28 | #' @param sep Separator between question and sub-question names 29 | #' @param exclude Excludes from pattern search 30 | #' @param ptn A list with two elements, `sep` and `exclude`. See [pattern()] and [which.q()] for more detail. 31 | #' @param defaultPtn The default for `ptn`, if it doesn't exist in the object that is being coerced. 32 | #' @param renameVarlabels If TRUE, turns variable.labels attribute into a named vector, using `names(x)` as names. 33 | #' @export 34 | #' @seealso [surveydata-package], [is.surveydata()] 35 | #' @example /inst/examples/example-asSurveydata.R 36 | #' @example /inst/examples/example-questions.R 37 | as.surveydata <- function(x, sep = "_", exclude = "other", ptn = pattern(x), 38 | defaultPtn = list(sep = sep, exclude = exclude), renameVarlabels = FALSE) { 39 | if (!is.list(defaultPtn)) stop("defaultPtn must be a list with elements sep and exclude") 40 | 41 | if (is.null(ptn)) ptn <- defaultPtn 42 | if (!inherits(x, "surveydata")) class(x) <- c("surveydata", class(x)) 43 | if (renameVarlabels) names(varlabels(x)) <- names(x) 44 | # browser() 45 | if (length(x) != length(varlabels(x))) { 46 | warning("surveydata: varlabels must have same length as object") 47 | } 48 | nx <- names(x) 49 | nx <- nx[!is.na(nx)] 50 | nvx <- names(x) 51 | nvx <- nvx[!is.na(nvx)] 52 | 53 | if (!isTRUE(all.equal(nx, nvx))) { 54 | warning("surveydata: names and varlabel names must match") 55 | } 56 | pattern(x) <- ptn 57 | x 58 | } 59 | 60 | #' @export 61 | #' @rdname as.surveydata 62 | un_surveydata <- function(x) { 63 | class(x) <- setdiff(class(x), "surveydata") 64 | x 65 | } 66 | 67 | 68 | 69 | #' Coerces surveydata object to data.frame. 70 | #' 71 | #' @method as.data.frame surveydata 72 | #' @aliases as.data.frame.surveydata as.data.frame 73 | #' @export 74 | #' @param x Surveydata object to coerce to class data.frame 75 | #' @param ... ignored 76 | #' @param rm.pattern If TRUE removes [pattern()] attributes from x 77 | #' @seealso [surveydata-package] 78 | as.data.frame.surveydata <- function(x, ..., rm.pattern = FALSE) { 79 | stopifnot(is.surveydata(x)) 80 | if (rm.pattern) pattern(x) <- NULL 81 | class(x) <- "data.frame" 82 | x 83 | } 84 | 85 | #' Tests whether an object is of class surveydata. 86 | #' 87 | #' @param x Object to check for being of class surveydata 88 | #' @seealso [surveydata-package] 89 | #' @export 90 | is.surveydata <- function(x) { 91 | msg <- "" 92 | if (length(x) != length(varlabels(x))) { 93 | new_msg <- "varlabels must have same length as object" 94 | msg <- paste(msg, new_msg, sep = "; ") 95 | } 96 | if (!isTRUE(all.equal(names(x), names(varlabels(x))))) { 97 | new_msg <- "names and varlabel names must match" 98 | msg <- paste(msg, new_msg, sep = "; ") 99 | } 100 | if (msg != "") warning(msg) 101 | inherits(x, "surveydata") 102 | } 103 | 104 | 105 | 106 | #' Updates names and variable.labels attribute of surveydata. 107 | #' 108 | #' @rdname names 109 | #' @aliases names<- names<-.surveydata 110 | #' @param x surveydata object 111 | #' @param value New names 112 | #' @export 113 | #' @keywords internal 114 | #' @seealso [surveydata-package()], [is.surveydata()] 115 | `names<-.surveydata` <- function(x, value) { 116 | xattr <- attributes(x) 117 | ret <- as.data.frame(x) 118 | names(ret) <- value 119 | names(attr(ret, "variable.labels")) <- value 120 | as.surveydata(ret, ptn = pattern(x)) 121 | } 122 | -------------------------------------------------------------------------------- /R/tools.R: -------------------------------------------------------------------------------- 1 | # 2 | # surveydata/R/tools.R by Andrie de Vries Copyright (C) 2011-2017 3 | # 4 | # This program is free software; you can redistribute it and/or modify 5 | # it under the terms of the GNU General Public License as published by 6 | # the Free Software Foundation; either version 2 or 3 of the License 7 | # (at your option). 8 | # 9 | # This program is distributed in the hope that it will be useful, 10 | # but WITHOUT ANY WARRANTY; without even the implied warranty of 11 | # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 12 | # GNU General Public License for more details. 13 | # 14 | # A copy of the GNU General Public License is available at 15 | # http://www.r-project.org/Licenses/ 16 | # 17 | 18 | 19 | #' Calculates at which questions respondents drop out. 20 | #' 21 | #' The number of respondents for each question is calculated as the length of the vector, after omitting NA values. 22 | #' 23 | #' @param x surveydata object, list or data.frame 24 | #' @param summary If TRUE, returns a shortened vector that contains only the points where respondents drop out. Otherwise, returns the number of respondents for each question. 25 | #' @return Named numeric vector of respondent counts 26 | #' @export 27 | #' @examples 28 | #' dropout(membersurvey[-(127:128)]) 29 | dropout <- function(x, summary = TRUE) { 30 | len <- sapply(x, function(xx) length(na.omit(xx))) 31 | ll <- rev(cummax(rev(len))) 32 | len[c(1, 1 + which(diff(ll) != 0))] 33 | } 34 | -------------------------------------------------------------------------------- /R/varlabels.R: -------------------------------------------------------------------------------- 1 | # Defines varlabels methods 2 | 3 | # 4 | # surveydata/R/varlabels.R by Andrie de Vries Copyright (C) 2011-2017 5 | # 6 | # This program is free software; you can redistribute it and/or modify 7 | # it under the terms of the GNU General Public License as published by 8 | # the Free Software Foundation; either version 2 or 3 of the License 9 | # (at your option). 10 | # 11 | # This program is distributed in the hope that it will be useful, 12 | # but WITHOUT ANY WARRANTY; without even the implied warranty of 13 | # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 14 | # GNU General Public License for more details. 15 | # 16 | # A copy of the GNU General Public License is available at 17 | # http://www.r-project.org/Licenses/ 18 | # 19 | 20 | 21 | #' Returns and updates variable.labels attribute of surveydata object. 22 | #' 23 | #' In a surveydata object, the `variable.labels` attribute store metadata about the original question text (see [foreign::read.spss()] for details). The function `varlabels()` returns the `variable.labels` attribute of data, and `varlabels(x) <- value` updates this attribute. 24 | #' 25 | #' In a surveydata object, the `varlabels` attribute is a named character vector, where the names correspond to the names of the the columns in 26 | #' 27 | #' @param x surveydata object 28 | #' @param value New value 29 | #' @export 30 | #' @seealso [surveydata-package] 31 | #' @family Attribute functions 32 | #' @example /inst/examples/example-varlabels.R 33 | varlabels <- function(x) { 34 | attr(x, "variable.labels") 35 | } 36 | 37 | #' @rdname varlabels 38 | #' @export 39 | #' @keywords internal 40 | #' @family Attribute functions 41 | `varlabels<-` <- function(x, value) { 42 | attr(x, "variable.labels") <- value 43 | x 44 | } 45 | -------------------------------------------------------------------------------- /README.Rmd: -------------------------------------------------------------------------------- 1 | --- 2 | output: github_document 3 | --- 4 | 5 | 6 | 7 | ```{r, include = FALSE} 8 | knitr::opts_chunk$set( 9 | collapse = TRUE, 10 | comment = "#>", 11 | fig.path = "man/figures/README-", 12 | out.width = "100%" 13 | ) 14 | ``` 15 | 16 | # surveydata 17 | 18 | 19 | 20 | [![R build status](https://github.com/andrie/surveydata/workflows/R-CMD-check/badge.svg)](https://github.com/andrie/surveydata/actions) 21 | [![](http://www.r-pkg.org/badges/version/surveydata)](http://www.r-pkg.org/pkg/surveydata) 22 | [![CRAN RStudio mirror downloads](http://cranlogs.r-pkg.org/badges/surveydata)](http://www.r-pkg.org/pkg/surveydata) [![Coverage Status](http://img.shields.io/codecov/c/github/andrie/surveydata/main.svg)](https://codecov.io/github/andrie/surveydata?branch=main) 23 | [![CRAN status](https://www.r-pkg.org/badges/version/surveydata)](https://CRAN.R-project.org/package=surveydata) 24 | 25 | 26 | ```{r, child = rprojroot::find_package_root_file("inst/vignette_child/child.Rmd")} 27 | ``` 28 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | # surveydata 5 | 6 | 7 | 8 | [![R build 9 | status](https://github.com/andrie/surveydata/workflows/R-CMD-check/badge.svg)](https://github.com/andrie/surveydata/actions) 10 | [![](http://www.r-pkg.org/badges/version/surveydata)](http://www.r-pkg.org/pkg/surveydata) 11 | [![CRAN RStudio mirror 12 | downloads](http://cranlogs.r-pkg.org/badges/surveydata)](http://www.r-pkg.org/pkg/surveydata) 13 | [![Coverage 14 | Status](http://img.shields.io/codecov/c/github/andrie/surveydata/main.svg)](https://codecov.io/github/andrie/surveydata?branch=main) 15 | [![CRAN 16 | status](https://www.r-pkg.org/badges/version/surveydata)](https://CRAN.R-project.org/package=surveydata) 17 | 18 | 19 | The `surveydata` package makes it easy to work with typical survey data 20 | that originated in SPSS or other formats. 21 | 22 | ## Motivation 23 | 24 | Specifically, the package makes it easy to include the question text as 25 | metadata with the data itself. 26 | 27 | To track the questions of a survey, you have two options: 28 | 29 | - Keep the data in a data frame, and keep a separate list of the 30 | questions 31 | - Keep the questions as an attribute of the data frame 32 | 33 | Neither of these options are ideal, since any subsetting of the survey 34 | data means you must keep track of the question metadata separately. 35 | 36 | This package solves the problem by creating a new class, `surveydata`, 37 | and keeping the questions as an attribute of this class. Whenever you do 38 | a subset operation, the metadata stays intact. 39 | 40 | In addition, the metadata knows if a question consists of a single 41 | column, or multiple columns. When creating a subset on the question 42 | name, the resulting object can be either a single column or multiple 43 | columns. 44 | 45 | ``` r 46 | library(surveydata) 47 | library(dplyr) 48 | ``` 49 | 50 | ``` r 51 | sv <- membersurvey %>% as.tbl() 52 | #> Warning: `as.tbl()` was deprecated in dplyr 1.0.0. 53 | #> ℹ Please use `tibble::as_tibble()` instead. 54 | #> Warning: 'as.tbl.surveydata' is deprecated. 55 | #> Use 'as_tibble' instead. 56 | #> See help("Deprecated") 57 | sv 58 | #> # A tibble: 215 × 109 59 | #> id Q1_1 Q1_2 Q2 Q3_1 Q3_2 Q3_3 Q3_4 Q3_5 Q3_6 Q3_7 Q3_8 Q3_9 60 | #> 61 | #> 1 3 8 2 2009 No No No No No No No No No 62 | #> 2 5 35 12 Befo… Yes No No No No No No No Yes 63 | #> 3 6 34 12 Befo… Yes Yes No No No Yes No No No 64 | #> 4 11 20 9 2010 No No No No No No No No No 65 | #> 5 13 20 3 2010 No No No No No No No No No 66 | #> 6 15 36 20 Befo… No Yes No No No No No No Yes 67 | #> 7 21 12 2.5 2009 Yes No No No No Yes Yes No No 68 | #> 8 22 11 0.5 2011 Yes Yes Yes Yes Yes No No No No 69 | #> 9 23 18 3 2008 Yes Yes Yes Yes Yes Yes No No Yes 70 | #> 10 25 24 8 2006 No No No Yes Yes Yes No No Yes 71 | #> # … with 205 more rows, and 96 more variables: Q3_10 , Q3_11 , 72 | ... 73 | ``` 74 | 75 | Notice from this summary that Question 2 has two columns, i.e. `Q2_1` 76 | and `Q2_2`. You can extract both these columns by simply referring to 77 | `Q2`: 78 | 79 | ``` r 80 | sv[, "Q2"] 81 | #> # A tibble: 215 × 1 82 | #> Q2 83 | #> 84 | #> 1 2009 85 | #> 2 Before 2002 86 | #> 3 Before 2002 87 | #> 4 2010 88 | #> 5 2010 89 | #> 6 Before 2002 90 | #> 7 2009 91 | #> 8 2011 92 | #> 9 2008 93 | #> 10 2006 94 | #> # … with 205 more rows 95 | ``` 96 | 97 | However, the subset of `Q1` returns only a single column: 98 | 99 | ``` r 100 | sv[, "Q2"] 101 | #> # A tibble: 215 × 1 102 | #> Q2 103 | #> 104 | #> 1 2009 105 | #> 2 Before 2002 106 | #> 3 Before 2002 107 | #> 4 2010 108 | #> 5 2010 109 | #> 6 Before 2002 110 | #> 7 2009 111 | #> 8 2011 112 | #> 9 2008 113 | #> 10 2006 114 | #> # … with 205 more rows 115 | ``` 116 | 117 | Note that in both cases the `surveydata` object doesn’t return a 118 | vector - subsetting a `surveydata` object always returns a `surveydata` 119 | object. 120 | 121 | ## About surveydata objects 122 | 123 | A surveydata object consists of: 124 | 125 | - A data frame with a row for each respondent and a column for each 126 | question. Column names are typically names in the pattern `Q1`, 127 | `Q2_1`, `Q2_2`, `Q3` - where underscores separate the sub-questions 128 | when these originated in a grid (array) of questions. 129 | 130 | - Question metadata gets stored in the \`{variable.labels} attribute of 131 | the data frame. This typically contains the original questionnaire 132 | text for each question. 133 | 134 | - Information about the sub-question separator (typically an underscore) 135 | is stored in the `patterns` attribute. 136 | 137 | Data processing a survey file can be tricky, since the standard methods 138 | for dealing with data frames does not conserve the `variable.labels` 139 | attribute. The `surveydata` package defines a `surveydata` class and the 140 | following methods that knows how to deal with the `variable.labels` 141 | attribute: 142 | 143 | - `as.surveydata` 144 | - `[.surveydata` 145 | - `[<-.surveydata` 146 | - `$.surveydata` 147 | - `$<-.surveydata` 148 | - `merge.surveydata` 149 | 150 | In addition, `surveydata` defines the following convenient methods for 151 | extracting and working with the variable labels: 152 | 153 | - `varlabels` 154 | - `varlabels<-` 155 | 156 | ## Defining a surveydata object 157 | 158 | First load the `surveydata` package. 159 | 160 | ``` r 161 | library(surveydata) 162 | ``` 163 | 164 | Next, create sample data. A data frame is the ideal data structure for 165 | survey data, and the convention is that data for each respondent is 166 | stored in the rows, while each column represents answers to a specific 167 | question. 168 | 169 | ``` r 170 | 171 | sdat <- data.frame( 172 | id = 1:4, 173 | Q1 = c("Yes", "No", "Yes", "Yes"), 174 | Q4_1 = c(1, 2, 1, 2), 175 | Q4_2 = c(3, 4, 4, 3), 176 | Q4_3 = c(5, 5, 6, 6), 177 | Q10 = factor(c("Male", "Female", "Female", "Male")), 178 | crossbreak = c("A", "A", "B", "B"), 179 | weight = c(0.9, 1.1, 0.8, 1.2) 180 | ) 181 | ``` 182 | 183 | The survey metadata consists of the questionnaire text. For example, 184 | this can be represented by a character vector, with an element for each 185 | question. 186 | 187 | To assign this metadata to the survey data, use the `varlabels()` 188 | function. This function assigns the questionnaire text to the 189 | `variable.labels` attribute of the data frame. 190 | 191 | ``` r 192 | 193 | varlabels(sdat) <- c( 194 | "RespID", 195 | "Question 1", 196 | "Question 4: red", "Question 4: green", "Question 4: blue", 197 | "Question 10", 198 | "crossbreak", 199 | "weight" 200 | ) 201 | ``` 202 | 203 | Finally, create the surveydata object. To do this, call the 204 | `as.surveydata()` function. The argument `renameVarlabels` controls 205 | whether the `varlabels` get renamed with the same names as the data. 206 | This is an essential step, and ensures that the question text remains in 207 | synch with the column names. 208 | 209 | ``` r 210 | sv <- as.surveydata(sdat, renameVarlabels = TRUE) 211 | ``` 212 | 213 | ## Extracting specific questions 214 | 215 | It is easy to extract specific questions with the `[` operator. This 216 | works very similar to extraction of data frames. However, there are two 217 | important differences: 218 | 219 | - The extraction operators will always return a `surveydata` object, 220 | even if only a single column is returned. This is different from the 221 | behaviour of data frames, where a single column is simplified to a 222 | vector. 223 | - Extracting a question with multiple sub-questions, e.g. “Q4” returns 224 | multiple columns 225 | 226 | ``` r 227 | sv[, "Q1"] 228 | #> Q1 229 | #> 1 Yes 230 | #> 2 No 231 | #> 3 Yes 232 | #> 4 Yes 233 | sv[, "Q4"] 234 | #> Q4_1 Q4_2 Q4_3 235 | #> 1 1 3 5 236 | #> 2 2 4 5 237 | #> 3 1 4 6 238 | #> 4 2 3 6 239 | ``` 240 | 241 | The extraction makes use of the underlying metadata, contained in the 242 | `varlabels` and `pattern` attributes: 243 | 244 | ``` r 245 | 246 | varlabels(sv) 247 | #> id Q1 Q4_1 Q4_2 248 | #> "RespID" "Question 1" "Question 4: red" "Question 4: green" 249 | #> Q4_3 Q10 crossbreak weight 250 | #> "Question 4: blue" "Question 10" "crossbreak" "weight" 251 | pattern(sv) 252 | #> $sep 253 | #> [1] "_" 254 | #> 255 | #> $exclude 256 | #> [1] "other" 257 | ``` 258 | 259 | ## Working with question columns 260 | 261 | It is easy to query the surveydata object to find out which questions it 262 | contains, as well as which columns store the data for those questions. 263 | 264 | ``` r 265 | questions(sv) 266 | #> [1] "id" "Q1" "Q4" "Q10" "crossbreak" 267 | #> [6] "weight" 268 | which.q(sv, "Q1") 269 | #> [1] 2 270 | which.q(sv, "Q4") 271 | #> [1] 3 4 5 272 | ``` 273 | 274 | ## Reading the questionnaire text 275 | 276 | The function `question_text()` gives access to the questionnaire text. 277 | 278 | ``` r 279 | question_text(sv, "Q1") 280 | #> [1] "Question 1" 281 | question_text(sv, "Q4") 282 | #> [1] "Question 4: red" "Question 4: green" "Question 4: blue" 283 | ``` 284 | 285 | ### Getting the common question text 286 | 287 | Use `question_text_common()` to retrieve the common text, i.e. the 288 | question itself: 289 | 290 | ``` r 291 | question_text_common(sv, "Q4") 292 | #> [1] "Question 4" 293 | ``` 294 | 295 | ### Getting the unique question text 296 | 297 | And use `question_text_unique()` to retrieve the unique part of the 298 | question, i.e. the sub-questions: 299 | 300 | ``` r 301 | question_text_unique(sv, "Q4") 302 | #> [1] "red" "green" "blue" 303 | ``` 304 | 305 | ## Using `surveydata` with `dplyr` 306 | 307 | The `surveydata` object knows how to deal with the following `dplyr` 308 | verbs: 309 | 310 | - `select` 311 | - `filter` 312 | - `mutate` 313 | - `arrange` 314 | - `summarize` 315 | 316 | In every case the resulting object will also be of class `surveydata`. 317 | 318 | ## Summary 319 | 320 | The `surveydata` object can make it much easier to work with survey 321 | data. 322 | -------------------------------------------------------------------------------- /_pkgdown.yml: -------------------------------------------------------------------------------- 1 | reference: 2 | - title: "Overview" 3 | contents: 4 | - surveydata-package 5 | - membersurvey 6 | 7 | - title: "Coercion functions" 8 | desc: "Coerces various objects to a `surveydata` object" 9 | contents: 10 | - matches("^[ai]s.*surveydata$") 11 | 12 | - title: "Access and modify attributes" 13 | contents: 14 | - pattern 15 | - varlabels 16 | 17 | - title: "Subset or merge surveydata objects" 18 | contents: 19 | - merge 20 | - Extract 21 | - cbind.surveydata 22 | 23 | - title: "To extract question text from varlabels" 24 | contents: 25 | - matches("question") 26 | - which.q 27 | - split_common_unique 28 | - strCommonUnique 29 | 30 | - title: "To fix common encoding problems" 31 | contents: 32 | - fix_common_encoding_problems 33 | - encToInt 34 | - intToEnc 35 | 36 | - title: "To clean data" 37 | contents: 38 | - matches("remove_") 39 | - fix_levels_01 40 | - has_dont_know 41 | - matches("leveltest_") 42 | 43 | - title: "Plot functions" 44 | contents: 45 | - matches(".*?plot.*?") 46 | 47 | - title: "Work with open text response data" 48 | contents: 49 | - matches("opentext") 50 | 51 | - title: "Miscellaneous tools" 52 | contents: 53 | - dropout 54 | - rm.attrs 55 | - rm.pattern 56 | - lapply_names 57 | 58 | - title: "Using 'dplyr' verbs" 59 | contents: 60 | - mutate.surveydata 61 | 62 | 63 | -------------------------------------------------------------------------------- /cran-comments.md: -------------------------------------------------------------------------------- 1 | ## New in this package 2 | 3 | This release fixes documentation warnings from CRAN builds 4 | 5 | ## R CMD check results 6 | 7 | There were no ERRORs or WARNINGs or NOTEs. 8 | 9 | 10 | ## Downstream dependencies 11 | 12 | Currently there are no downstream dependencies. -------------------------------------------------------------------------------- /data/membersurvey.rda: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/andrie/surveydata/b4f783d06aaaa06d08818bf50fa376fc6e9f7271/data/membersurvey.rda -------------------------------------------------------------------------------- /inst/WORDLIST: -------------------------------------------------------------------------------- 1 | behaviour 2 | dat 3 | datatable 4 | de 5 | dk 6 | Dont 7 | dplyr 8 | etc 9 | emdash 10 | regex 11 | RStudio 12 | synch 13 | varlabels 14 | Vries 15 | -------------------------------------------------------------------------------- /inst/examples/example-asSurveydata.R: -------------------------------------------------------------------------------- 1 | library(surveydata) 2 | 3 | # Create surveydata object 4 | 5 | sdat <- data.frame( 6 | id = 1:4, 7 | Q1 = c("Yes", "No", "Yes", "Yes"), 8 | Q4_1 = c(1, 2, 1, 2), 9 | Q4_2 = c(3, 4, 4, 3), 10 | Q4_3 = c(5, 5, 6, 6), 11 | Q10 = factor(c("Male", "Female", "Female", "Male")), 12 | crossbreak = c("A", "A", "B", "B"), 13 | weight = c(0.9, 1.1, 0.8, 1.2) 14 | ) 15 | 16 | varlabels(sdat) <- c( 17 | "RespID", 18 | "Question 1", 19 | "Question 4: red", "Question 4: green", "Question 4: blue", 20 | "Question 10", 21 | "crossbreak", 22 | "weight" 23 | ) 24 | 25 | sv <- as.surveydata(sdat, renameVarlabels = TRUE) 26 | 27 | # Extract specific questions 28 | sv[, "Q1"] 29 | sv[, "Q4"] 30 | 31 | # Query attributes 32 | varlabels(sv) 33 | pattern(sv) 34 | 35 | # Find unique questions 36 | 37 | questions(sv) 38 | which.q(sv, "Q1") 39 | which.q(sv, "Q4") 40 | 41 | # Find question text 42 | question_text(sv, "Q1") 43 | question_text(sv, "Q4") 44 | 45 | question_text_common(sv, "Q4") 46 | question_text_unique(sv, "Q4") 47 | 48 | 49 | -------------------------------------------------------------------------------- /inst/examples/example-dplyr-verbs.R: -------------------------------------------------------------------------------- 1 | withr::with_package("dplyr", { 2 | membersurvey %>% 3 | as_tibble() %>% 4 | .[c("id", "Q1", "Q2")] %>% 5 | filter(Q2 == 2009) 6 | }) 7 | 8 | 9 | -------------------------------------------------------------------------------- /inst/examples/example-extract.R: -------------------------------------------------------------------------------- 1 | 2 | names(membersurvey) 3 | head(membersurvey["Q1"]) 4 | head(membersurvey[c("Q1", "Q2")]) 5 | head(membersurvey[membersurvey$Q2=="2009", c("Q1", "Q2")]) 6 | 7 | # The pattern is used to extract columns 8 | 9 | pattern(membersurvey) 10 | 11 | grep("Q20", names(membersurvey), value=TRUE) 12 | head(membersurvey["Q20"]) 13 | head(membersurvey["Q20_other"]) 14 | 15 | -------------------------------------------------------------------------------- /inst/examples/example-pattern.R: -------------------------------------------------------------------------------- 1 | # Extract the pattern from membersurvey 2 | 3 | oldptn <- pattern(membersurvey) 4 | oldptn 5 | 6 | # The pattern is used to extract columns 7 | 8 | names(membersurvey) 9 | grep("Q20", names(membersurvey), value=TRUE) 10 | 11 | head(membersurvey["Q20"]) 12 | head(membersurvey["Q20_other"]) 13 | 14 | # Define a new pattern 15 | 16 | pattern(membersurvey) <- list(sep="_", exclude="") 17 | head(membersurvey["Q20"]) 18 | 19 | # Reset original pattern 20 | 21 | pattern(membersurvey) <- oldptn 22 | rm(oldptn) 23 | -------------------------------------------------------------------------------- /inst/examples/example-plots.R: -------------------------------------------------------------------------------- 1 | question_text(membersurvey) 2 | 3 | survey_plot_question(membersurvey, "Q2") 4 | survey_plot_yes_no(membersurvey, "Q2") 5 | survey_plot_satisfaction(membersurvey, "Q14") 6 | 7 | -------------------------------------------------------------------------------- /inst/examples/example-questions.R: -------------------------------------------------------------------------------- 1 | # Basic operations on a surveydata object, illustrated with the example dataset membersurvey 2 | 3 | class(membersurvey) 4 | 5 | questions(membersurvey) 6 | 7 | which.q(membersurvey, "Q1") 8 | which.q(membersurvey, "Q3") 9 | which.q(membersurvey, c("Q1", "Q3")) 10 | 11 | question_text(membersurvey, "Q3") 12 | question_text_unique(membersurvey, "Q3") 13 | question_text_common(membersurvey, "Q3") 14 | 15 | # Extracting columns from a surveydata object 16 | 17 | head(membersurvey[, "Q1"]) 18 | head(membersurvey["Q1"]) 19 | head(membersurvey[, "Q3"]) 20 | head(membersurvey[, c("Q1", "Q3")]) 21 | 22 | # Note that the result is always a surveydata object, even if only one column is extracted 23 | 24 | head(membersurvey[, "id"]) 25 | str(membersurvey[, "id"]) 26 | 27 | -------------------------------------------------------------------------------- /inst/examples/example-varlabels.R: -------------------------------------------------------------------------------- 1 | # Extract the variable labels from membersurvey 2 | 3 | ms <- membersurvey[, c("id", "Q1", "Q2")] 4 | 5 | str(ms) 6 | varlabels(ms) 7 | varlabels(ms)["Q2"] 8 | 9 | # Assign a new value to the text of question 2 10 | 11 | varlabels(ms)["Q2"] <- "When did you join?" 12 | varlabels(ms) 13 | str(ms["Q2"]) 14 | 15 | -------------------------------------------------------------------------------- /inst/vignette_child/child.Rmd: -------------------------------------------------------------------------------- 1 | The `surveydata` package makes it easy to work with typical survey data that originated in SPSS or other formats. 2 | 3 | ## Motivation 4 | 5 | Specifically, the package makes it easy to include the question text as metadata with the data itself. 6 | 7 | To track the questions of a survey, you have two options: 8 | 9 | * Keep the data in a data frame, and keep a separate list of the questions 10 | * Keep the questions as an attribute of the data frame 11 | 12 | Neither of these options are ideal, since any subsetting of the survey data means you must keep track of the question metadata separately. 13 | 14 | This package solves the problem by creating a new class, `surveydata`, and keeping the questions as an attribute of this class. Whenever you do a subset operation, the metadata stays intact. 15 | 16 | In addition, the metadata knows if a question consists of a single column, or multiple columns. When creating a subset on the question name, the resulting object can be either a single column or multiple columns. 17 | 18 | ```{r options, echo=FALSE} 19 | # from https://stackoverflow.com/questions/23114654/knitr-output-hook-with-an-output-lines-option-that-works-like-echo-26 20 | library(knitr) 21 | hook_output <- knit_hooks$get("output") 22 | knit_hooks$set(output = function(x, options) { 23 | lines <- options$output.lines 24 | if (is.null(lines)) { 25 | return(hook_output(x, options)) # pass to default hook 26 | } 27 | x <- unlist(strsplit(x, "\n")) 28 | more <- "..." 29 | if (length(lines)==1) { # first n lines 30 | if (length(x) > lines) { 31 | # truncate the output, but add .... 32 | x <- c(head(x, lines), more) 33 | } 34 | } else { 35 | x <- c(if (abs(lines[1])>1) more else NULL, 36 | x[lines], 37 | if (length(x)>lines[abs(length(lines))]) more else NULL 38 | ) 39 | } 40 | # paste these lines together 41 | x <- paste(c(x, ""), collapse = "\n") 42 | hook_output(x, options) 43 | }) 44 | ``` 45 | 46 | ```{r load, message=FALSE} 47 | library(surveydata) 48 | library(dplyr) 49 | ``` 50 | ```{r motivation, output.lines = 14} 51 | sv <- membersurvey %>% as.tbl() 52 | sv 53 | ``` 54 | 55 | Notice from this summary that Question 2 has two columns, i.e. `Q2_1` and `Q2_2`. You can extract both these columns by simply referring to `Q2`: 56 | 57 | ```{r motivation-q2} 58 | sv[, "Q2"] 59 | ``` 60 | 61 | However, the subset of `Q1` returns only a single column: 62 | 63 | ```{r motivation-q1} 64 | sv[, "Q2"] 65 | ``` 66 | 67 | Note that in both cases the `surveydata` object doesn't return a vector - subsetting a `surveydata` object always returns a `surveydata` object. 68 | 69 | ## About surveydata objects 70 | 71 | A surveydata object consists of: 72 | 73 | * A data frame with a row for each respondent and a column for each question. Column names are typically names in the pattern `Q1`, `Q2_1`, `Q2_2`, `Q3` - where underscores separate the sub-questions when these originated in a grid (array) of questions. 74 | 75 | * Question metadata gets stored in the `{variable.labels} attribute of the data frame. This typically contains the original questionnaire text for each question. 76 | 77 | * Information about the sub-question separator (typically an underscore) is stored in the `patterns` attribute. 78 | 79 | 80 | Data processing a survey file can be tricky, since the standard methods for dealing with data frames does not conserve the `variable.labels` attribute. The `surveydata` package defines a `surveydata` class and the following methods that knows how to deal with the `variable.labels` attribute: 81 | 82 | * `as.surveydata` 83 | * `[.surveydata` 84 | * `[<-.surveydata` 85 | * `$.surveydata` 86 | * `$<-.surveydata` 87 | * `merge.surveydata` 88 | 89 | In addition, `surveydata` defines the following convenient methods for extracting and working with the variable labels: 90 | 91 | * `varlabels` 92 | * `varlabels<-` 93 | 94 | 95 | ## Defining a surveydata object 96 | 97 | First load the `surveydata` package. 98 | 99 | ```{r Setup} 100 | library(surveydata) 101 | ``` 102 | 103 | Next, create sample data. A data frame is the ideal data structure for survey data, and the convention is that data for each respondent is stored in the rows, while each column represents answers to a specific question. 104 | 105 | ```{r sample-data} 106 | 107 | sdat <- data.frame( 108 | id = 1:4, 109 | Q1 = c("Yes", "No", "Yes", "Yes"), 110 | Q4_1 = c(1, 2, 1, 2), 111 | Q4_2 = c(3, 4, 4, 3), 112 | Q4_3 = c(5, 5, 6, 6), 113 | Q10 = factor(c("Male", "Female", "Female", "Male")), 114 | crossbreak = c("A", "A", "B", "B"), 115 | weight = c(0.9, 1.1, 0.8, 1.2) 116 | ) 117 | 118 | ``` 119 | 120 | 121 | The survey metadata consists of the questionnaire text. For example, this can be represented by a character vector, with an element for each question. 122 | 123 | To assign this metadata to the survey data, use the `varlabels()` function. This function assigns the questionnaire text to the `variable.labels` attribute of the data frame. 124 | 125 | ```{r varlabels} 126 | 127 | varlabels(sdat) <- c( 128 | "RespID", 129 | "Question 1", 130 | "Question 4: red", "Question 4: green", "Question 4: blue", 131 | "Question 10", 132 | "crossbreak", 133 | "weight" 134 | ) 135 | ``` 136 | 137 | 138 | Finally, create the surveydata object. To do this, call the `as.surveydata()` function. The argument `renameVarlabels` controls whether the `varlabels` get renamed with the same names as the data. This is an essential step, and ensures that the question text remains in synch with the column names. 139 | 140 | ```{r init} 141 | sv <- as.surveydata(sdat, renameVarlabels = TRUE) 142 | ``` 143 | 144 | 145 | ## Extracting specific questions 146 | 147 | It is easy to extract specific questions with the `[` operator. This works very similar to extraction of data frames. However, there are two important differences: 148 | 149 | * The extraction operators will always return a `surveydata` object, even if only a single column is returned. This is different from the behaviour of data frames, where a single column is simplified to a vector. 150 | * Extracting a question with multiple sub-questions, e.g. "Q4" returns multiple columns 151 | 152 | 153 | ```{r extract} 154 | sv[, "Q1"] 155 | sv[, "Q4"] 156 | ``` 157 | 158 | The extraction makes use of the underlying metadata, contained in the `varlabels` and `pattern` attributes: 159 | 160 | ```{r attributes} 161 | 162 | varlabels(sv) 163 | pattern(sv) 164 | ``` 165 | 166 | ## Working with question columns 167 | 168 | It is easy to query the surveydata object to find out which questions it contains, as well as which columns store the data for those questions. 169 | 170 | ```{r questions} 171 | questions(sv) 172 | which.q(sv, "Q1") 173 | which.q(sv, "Q4") 174 | ``` 175 | 176 | ## Reading the questionnaire text 177 | 178 | The function `question_text()` gives access to the questionnaire text. 179 | 180 | ```{r question_text} 181 | question_text(sv, "Q1") 182 | question_text(sv, "Q4") 183 | ``` 184 | 185 | 186 | ### Getting the common question text 187 | 188 | Use `question_text_common()` to retrieve the common text, i.e. the question itself: 189 | 190 | ```{r qTextCommon} 191 | question_text_common(sv, "Q4") 192 | ``` 193 | 194 | ### Getting the unique question text 195 | 196 | And use `question_text_unique()` to retrieve the unique part of the question, i.e. the sub-questions: 197 | 198 | ```{r qTextUnique} 199 | question_text_unique(sv, "Q4") 200 | ``` 201 | 202 | 203 | ## Using `surveydata` with `dplyr` 204 | 205 | The `surveydata` object knows how to deal with the following `dplyr` verbs: 206 | 207 | * `select` 208 | * `filter` 209 | * `mutate` 210 | * `arrange` 211 | * `summarize` 212 | 213 | In every case the resulting object will also be of class `surveydata`. 214 | 215 | 216 | 217 | ## Summary 218 | 219 | The `surveydata` object can make it much easier to work with survey data. 220 | -------------------------------------------------------------------------------- /man/as.data.frame.surveydata.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/surveydata.R 3 | \name{as.data.frame.surveydata} 4 | \alias{as.data.frame.surveydata} 5 | \alias{as.data.frame} 6 | \title{Coerces surveydata object to data.frame.} 7 | \usage{ 8 | \method{as.data.frame}{surveydata}(x, ..., rm.pattern = FALSE) 9 | } 10 | \arguments{ 11 | \item{x}{Surveydata object to coerce to class data.frame} 12 | 13 | \item{...}{ignored} 14 | 15 | \item{rm.pattern}{If TRUE removes \code{\link[=pattern]{pattern()}} attributes from x} 16 | } 17 | \description{ 18 | Coerces surveydata object to data.frame. 19 | } 20 | \seealso{ 21 | \link{surveydata-package} 22 | } 23 | -------------------------------------------------------------------------------- /man/as.surveydata.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/surveydata.R 3 | \name{as.surveydata} 4 | \alias{as.surveydata} 5 | \alias{un_surveydata} 6 | \title{Coercion from and to surveydata.} 7 | \usage{ 8 | as.surveydata( 9 | x, 10 | sep = "_", 11 | exclude = "other", 12 | ptn = pattern(x), 13 | defaultPtn = list(sep = sep, exclude = exclude), 14 | renameVarlabels = FALSE 15 | ) 16 | 17 | un_surveydata(x) 18 | } 19 | \arguments{ 20 | \item{x}{Object to coerce to surveydata} 21 | 22 | \item{sep}{Separator between question and sub-question names} 23 | 24 | \item{exclude}{Excludes from pattern search} 25 | 26 | \item{ptn}{A list with two elements, \code{sep} and \code{exclude}. See \code{\link[=pattern]{pattern()}} and \code{\link[=which.q]{which.q()}} for more detail.} 27 | 28 | \item{defaultPtn}{The default for \code{ptn}, if it doesn't exist in the object that is being coerced.} 29 | 30 | \item{renameVarlabels}{If TRUE, turns variable.labels attribute into a named vector, using \code{names(x)} as names.} 31 | } 32 | \description{ 33 | Methods for creating \code{surveydata} objects, testing for class, and coercion from other objects. 34 | } 35 | \details{ 36 | The function\code{un_surveydata()} removes the \code{surveydata} class from the object, leaving intact the other classes, e.g. \code{data.frame} or \code{tibble} 37 | } 38 | \examples{ 39 | library(surveydata) 40 | 41 | # Create surveydata object 42 | 43 | sdat <- data.frame( 44 | id = 1:4, 45 | Q1 = c("Yes", "No", "Yes", "Yes"), 46 | Q4_1 = c(1, 2, 1, 2), 47 | Q4_2 = c(3, 4, 4, 3), 48 | Q4_3 = c(5, 5, 6, 6), 49 | Q10 = factor(c("Male", "Female", "Female", "Male")), 50 | crossbreak = c("A", "A", "B", "B"), 51 | weight = c(0.9, 1.1, 0.8, 1.2) 52 | ) 53 | 54 | varlabels(sdat) <- c( 55 | "RespID", 56 | "Question 1", 57 | "Question 4: red", "Question 4: green", "Question 4: blue", 58 | "Question 10", 59 | "crossbreak", 60 | "weight" 61 | ) 62 | 63 | sv <- as.surveydata(sdat, renameVarlabels = TRUE) 64 | 65 | # Extract specific questions 66 | sv[, "Q1"] 67 | sv[, "Q4"] 68 | 69 | # Query attributes 70 | varlabels(sv) 71 | pattern(sv) 72 | 73 | # Find unique questions 74 | 75 | questions(sv) 76 | which.q(sv, "Q1") 77 | which.q(sv, "Q4") 78 | 79 | # Find question text 80 | question_text(sv, "Q1") 81 | question_text(sv, "Q4") 82 | 83 | question_text_common(sv, "Q4") 84 | question_text_unique(sv, "Q4") 85 | 86 | 87 | # Basic operations on a surveydata object, illustrated with the example dataset membersurvey 88 | 89 | class(membersurvey) 90 | 91 | questions(membersurvey) 92 | 93 | which.q(membersurvey, "Q1") 94 | which.q(membersurvey, "Q3") 95 | which.q(membersurvey, c("Q1", "Q3")) 96 | 97 | question_text(membersurvey, "Q3") 98 | question_text_unique(membersurvey, "Q3") 99 | question_text_common(membersurvey, "Q3") 100 | 101 | # Extracting columns from a surveydata object 102 | 103 | head(membersurvey[, "Q1"]) 104 | head(membersurvey["Q1"]) 105 | head(membersurvey[, "Q3"]) 106 | head(membersurvey[, c("Q1", "Q3")]) 107 | 108 | # Note that the result is always a surveydata object, even if only one column is extracted 109 | 110 | head(membersurvey[, "id"]) 111 | str(membersurvey[, "id"]) 112 | 113 | } 114 | \seealso{ 115 | \link{surveydata-package}, \code{\link[=is.surveydata]{is.surveydata()}} 116 | } 117 | -------------------------------------------------------------------------------- /man/as_opentext_datatable.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/opentext.R 3 | \name{as_opentext_datatable} 4 | \alias{as_opentext_datatable} 5 | \title{Converts free format question text to datatable using the \code{DT} package.} 6 | \usage{ 7 | as_opentext_datatable(data, q) 8 | } 9 | \arguments{ 10 | \item{data}{surveydata object} 11 | 12 | \item{q}{Question} 13 | } 14 | \description{ 15 | Converts free format question text to datatable using the \code{DT} package. 16 | } 17 | \examples{ 18 | as_opentext_datatable(membersurvey, "Q33") 19 | } 20 | \seealso{ 21 | Other open text functions: 22 | \code{\link{print_opentext}()} 23 | } 24 | \concept{open text functions} 25 | -------------------------------------------------------------------------------- /man/cbind.surveydata.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/merge.R 3 | \name{cbind.surveydata} 4 | \alias{cbind.surveydata} 5 | \title{Combines surveydata object by columns.} 6 | \usage{ 7 | \method{cbind}{surveydata}(..., deparse.level = 1) 8 | } 9 | \arguments{ 10 | \item{...}{surveydata objects} 11 | 12 | \item{deparse.level}{ignored} 13 | } 14 | \description{ 15 | Combines surveydata object by columns. 16 | } 17 | -------------------------------------------------------------------------------- /man/dplyr-surveydata.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/dplyr_verbs.R 3 | \name{dplyr-surveydata} 4 | \alias{dplyr-surveydata} 5 | \alias{mutate.surveydata} 6 | \alias{as_tibble.surveydata} 7 | \alias{as.tbl.surveydata} 8 | \alias{select.surveydata} 9 | \alias{filter} 10 | \alias{arrange.surveydata} 11 | \alias{summarise.surveydata} 12 | \alias{summarize.surveydata} 13 | \alias{slice.surveydata} 14 | \title{Methods to support dplyr verbs.} 15 | \usage{ 16 | \method{mutate}{surveydata}(.data, ...) 17 | 18 | \method{as_tibble}{surveydata}(x, ..., .name_repair, rownames) 19 | 20 | \method{as.tbl}{surveydata}(x, ...) 21 | 22 | \method{select}{surveydata}(.data, ...) 23 | 24 | \method{arrange}{surveydata}(.data, ...) 25 | 26 | \method{summarise}{surveydata}(.data, ...) 27 | 28 | \method{summarize}{surveydata}(.data, ...) 29 | 30 | \method{slice}{surveydata}(.data, ...) 31 | } 32 | \arguments{ 33 | \item{.data}{\code{surveydata} object or \code{tbl} passed to \code{dplyr} verb} 34 | 35 | \item{...}{passed to dplyr verb} 36 | } 37 | \description{ 38 | The \code{surveydata} package exposes functionality to support some of the \code{dplyr} verbs, e.g. \code{\link[dplyr:filter]{dplyr::filter()}}. The computation is performed by \code{dplyr}, and the resulting object is of class \code{surveydata} (as well as the \code{dplyr} result). 39 | } 40 | \examples{ 41 | withr::with_package("dplyr", { 42 | membersurvey \%>\% 43 | as_tibble() \%>\% 44 | .[c("id", "Q1", "Q2")] \%>\% 45 | filter(Q2 == 2009) 46 | }) 47 | 48 | 49 | } 50 | \keyword{internal} 51 | -------------------------------------------------------------------------------- /man/dropout.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/tools.R 3 | \name{dropout} 4 | \alias{dropout} 5 | \title{Calculates at which questions respondents drop out.} 6 | \usage{ 7 | dropout(x, summary = TRUE) 8 | } 9 | \arguments{ 10 | \item{x}{surveydata object, list or data.frame} 11 | 12 | \item{summary}{If TRUE, returns a shortened vector that contains only the points where respondents drop out. Otherwise, returns the number of respondents for each question.} 13 | } 14 | \value{ 15 | Named numeric vector of respondent counts 16 | } 17 | \description{ 18 | The number of respondents for each question is calculated as the length of the vector, after omitting NA values. 19 | } 20 | \examples{ 21 | dropout(membersurvey[-(127:128)]) 22 | } 23 | -------------------------------------------------------------------------------- /man/encToInt.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/encoding.R 3 | \name{encToInt} 4 | \alias{encToInt} 5 | \title{Converts a character vector to an integer vector.} 6 | \usage{ 7 | encToInt(x, encoding = localeToCharset()) 8 | } 9 | \arguments{ 10 | \item{x}{Character vector} 11 | 12 | \item{encoding}{A character string describing the encoding of x. Defaults to the current locale. See also \code{\link[=iconvlist]{iconvlist()}}} 13 | } 14 | \value{ 15 | An integer vector 16 | } 17 | \description{ 18 | Conversion of character vector to integer vector. The encoding of the character vector can be specified but defaults to the current locale. 19 | } 20 | \examples{ 21 | encToInt("\xfa") 22 | } 23 | \seealso{ 24 | \code{\link[=iconv]{iconv()}} 25 | 26 | Other Functions to clean data: 27 | \code{\link{fix_common_encoding_problems}()}, 28 | \code{\link{fix_levels_01_spss}()}, 29 | \code{\link{has_dont_know}()}, 30 | \code{\link{intToEnc}()}, 31 | \code{\link{leveltest}}, 32 | \code{\link{remove_all_dont_know}()}, 33 | \code{\link{remove_dont_know}()} 34 | } 35 | \concept{Functions to clean data} 36 | \keyword{encoding} 37 | -------------------------------------------------------------------------------- /man/extract.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/extract.R 3 | \name{Extract} 4 | \alias{Extract} 5 | \alias{[.surveydata} 6 | \alias{[} 7 | \alias{"[.surveydata"} 8 | \alias{[<-.surveydata} 9 | \alias{$<-.surveydata} 10 | \alias{$<-} 11 | \title{Extract or replace subsets of surveydata, ensuring that the varlabels stay synchronized.} 12 | \usage{ 13 | \method{[}{surveydata}(x, i, j, drop = FALSE) 14 | 15 | \method{[}{surveydata}(x, i, j) <- value 16 | 17 | \method{$}{surveydata}(x, name) <- value 18 | } 19 | \arguments{ 20 | \item{x}{surveydata object} 21 | 22 | \item{i}{row index} 23 | 24 | \item{j}{column index} 25 | 26 | \item{drop}{logical. Passed to \verb{[.data.frame}. Note that the default is \code{FALSE}.} 27 | 28 | \item{value}{New value} 29 | 30 | \item{name}{Names of columns} 31 | } 32 | \description{ 33 | The \code{surveydata} package makes it easy to extract specific questions from a surveydata object. Because survey data typically has question names like "Q1_a", "Q1_b", "Q1_c" the extract method for a \code{surveydata} object makes it easy to extract all columns by simply specifying "Q1" as the argument to the column index. 34 | } 35 | \details{ 36 | Extraction is similar to data frames, with three important exceptions: 37 | \itemize{ 38 | \item The column argument \code{j} is evaluated using \code{\link[=which.q]{which.q()}} and will return all columns where the column names match the \code{\link[=pattern]{pattern()}}. 39 | \item The \code{drop} argument is \code{FALSE}. Thus the result will always be a surveydata object, even if only a single column is returned. 40 | \item All extraction methods retain the \code{pattern} and \code{varlabels} arguments. 41 | } 42 | } 43 | \examples{ 44 | 45 | names(membersurvey) 46 | head(membersurvey["Q1"]) 47 | head(membersurvey[c("Q1", "Q2")]) 48 | head(membersurvey[membersurvey$Q2=="2009", c("Q1", "Q2")]) 49 | 50 | # The pattern is used to extract columns 51 | 52 | pattern(membersurvey) 53 | 54 | grep("Q20", names(membersurvey), value=TRUE) 55 | head(membersurvey["Q20"]) 56 | head(membersurvey["Q20_other"]) 57 | 58 | } 59 | \seealso{ 60 | \link{surveydata-package}, \link{varlabels} 61 | } 62 | \keyword{internal} 63 | -------------------------------------------------------------------------------- /man/fix_common_encoding_problems.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/encoding.R 3 | \name{fix_common_encoding_problems} 4 | \alias{fix_common_encoding_problems} 5 | \title{Fix common encoding problems when working with web imported data.} 6 | \usage{ 7 | fix_common_encoding_problems(x, encoding = localeToCharset()) 8 | } 9 | \arguments{ 10 | \item{x}{A character vector} 11 | 12 | \item{encoding}{A character string describing the encoding of x. Defaults to the current locale. See also \code{\link[=iconvlist]{iconvlist()}}} 13 | } 14 | \description{ 15 | This function tries to resolve typical encoding problems when importing web data on Windows. 16 | Typical problems occur with pound and emdash (-), especially when these originated in MS-Word. 17 | } 18 | \seealso{ 19 | Other Functions to clean data: 20 | \code{\link{encToInt}()}, 21 | \code{\link{fix_levels_01_spss}()}, 22 | \code{\link{has_dont_know}()}, 23 | \code{\link{intToEnc}()}, 24 | \code{\link{leveltest}}, 25 | \code{\link{remove_all_dont_know}()}, 26 | \code{\link{remove_dont_know}()} 27 | } 28 | \concept{Functions to clean data} 29 | \keyword{encoding} 30 | -------------------------------------------------------------------------------- /man/fix_levels_01.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/cleandata.R 3 | \name{fix_levels_01_spss} 4 | \alias{fix_levels_01_spss} 5 | \alias{fix_levels_01_r} 6 | \alias{fix_levels_01} 7 | \title{Fix level formatting of all question with Yes/No type answers.} 8 | \usage{ 9 | fix_levels_01_spss(dat) 10 | 11 | fix_levels_01_r(dat) 12 | 13 | fix_levels_01(dat, origin = c("R", "SPSS")) 14 | } 15 | \arguments{ 16 | \item{dat}{surveydata object} 17 | 18 | \item{origin}{Either \code{R} or \code{SPSS}} 19 | } 20 | \description{ 21 | Fix level formatting of all question with Yes/No type answers. 22 | } 23 | \seealso{ 24 | Other Functions to clean data: 25 | \code{\link{encToInt}()}, 26 | \code{\link{fix_common_encoding_problems}()}, 27 | \code{\link{has_dont_know}()}, 28 | \code{\link{intToEnc}()}, 29 | \code{\link{leveltest}}, 30 | \code{\link{remove_all_dont_know}()}, 31 | \code{\link{remove_dont_know}()} 32 | } 33 | \concept{Functions to clean data} 34 | \keyword{"clean} 35 | \keyword{data"} 36 | -------------------------------------------------------------------------------- /man/has_dont_know.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/cleandata.R 3 | \name{has_dont_know} 4 | \alias{has_dont_know} 5 | \title{Tests whether levels contain "Don't know".} 6 | \usage{ 7 | has_dont_know(x, dk = "Don't Know") 8 | } 9 | \arguments{ 10 | \item{x}{Character vector or factor} 11 | 12 | \item{dk}{Character vector, containing search terms, e.g. \code{c("Don't know", "Don't Know")}} 13 | } 14 | \value{ 15 | TRUE or FALSE 16 | } 17 | \description{ 18 | Returns TRUE if x contains any instances of dk 19 | } 20 | \seealso{ 21 | Other Functions to clean data: 22 | \code{\link{encToInt}()}, 23 | \code{\link{fix_common_encoding_problems}()}, 24 | \code{\link{fix_levels_01_spss}()}, 25 | \code{\link{intToEnc}()}, 26 | \code{\link{leveltest}}, 27 | \code{\link{remove_all_dont_know}()}, 28 | \code{\link{remove_dont_know}()} 29 | } 30 | \concept{Functions to clean data} 31 | \keyword{"clean} 32 | \keyword{data"} 33 | -------------------------------------------------------------------------------- /man/intToEnc.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/encoding.R 3 | \name{intToEnc} 4 | \alias{intToEnc} 5 | \title{Converts an integer vector to a character vector.} 6 | \usage{ 7 | intToEnc(x, encoding = localeToCharset()) 8 | } 9 | \arguments{ 10 | \item{x}{Integer vector} 11 | 12 | \item{encoding}{A character string describing the encoding of x. Defaults to the current locale. See also \code{\link[=iconvlist]{iconvlist()}}} 13 | } 14 | \value{ 15 | A character vector 16 | } 17 | \description{ 18 | Conversion of integer vector to character vector. The encoding of the character vector can be specified but defaults to the current locale. 19 | } 20 | \examples{ 21 | intToEnc(8212) 22 | } 23 | \seealso{ 24 | \code{\link[=iconv]{iconv()}} 25 | 26 | Other Functions to clean data: 27 | \code{\link{encToInt}()}, 28 | \code{\link{fix_common_encoding_problems}()}, 29 | \code{\link{fix_levels_01_spss}()}, 30 | \code{\link{has_dont_know}()}, 31 | \code{\link{leveltest}}, 32 | \code{\link{remove_all_dont_know}()}, 33 | \code{\link{remove_dont_know}()} 34 | } 35 | \concept{Functions to clean data} 36 | \keyword{encoding} 37 | -------------------------------------------------------------------------------- /man/is.surveydata.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/surveydata.R 3 | \name{is.surveydata} 4 | \alias{is.surveydata} 5 | \title{Tests whether an object is of class surveydata.} 6 | \usage{ 7 | is.surveydata(x) 8 | } 9 | \arguments{ 10 | \item{x}{Object to check for being of class surveydata} 11 | } 12 | \description{ 13 | Tests whether an object is of class surveydata. 14 | } 15 | \seealso{ 16 | \link{surveydata-package} 17 | } 18 | -------------------------------------------------------------------------------- /man/lapply_names.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/cleandata.R 3 | \name{lapply_names} 4 | \alias{lapply_names} 5 | \title{Applies function only to named elements of a list.} 6 | \usage{ 7 | lapply_names(x, names, FUN, ...) 8 | } 9 | \arguments{ 10 | \item{x}{list} 11 | 12 | \item{names}{character vector identifying which elements of the list to apply FUN} 13 | 14 | \item{FUN}{function to apply.} 15 | 16 | \item{...}{additional arguments passed to \code{FUN}} 17 | } 18 | \description{ 19 | This is useful to clean only some columns in a list (or \code{data.frame} or \code{surveydata} object). This is a simple wrapper around \code{\link[=lapply]{lapply()}} where only the named elements are changed. 20 | } 21 | \seealso{ 22 | Other Tools: 23 | \code{\link{question_order}()} 24 | } 25 | \concept{Tools} 26 | -------------------------------------------------------------------------------- /man/leveltest.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/cleandata.R 3 | \name{leveltest} 4 | \alias{leveltest} 5 | \alias{leveltest_spss} 6 | \alias{leveltest_r} 7 | \title{Fix level formatting of all question with Yes/No type answers.} 8 | \usage{ 9 | leveltest_spss(x) 10 | 11 | leveltest_r(x) 12 | } 13 | \arguments{ 14 | \item{x}{surveydata object} 15 | } 16 | \description{ 17 | Fix level formatting of all question with Yes/No type answers. 18 | } 19 | \seealso{ 20 | Other Functions to clean data: 21 | \code{\link{encToInt}()}, 22 | \code{\link{fix_common_encoding_problems}()}, 23 | \code{\link{fix_levels_01_spss}()}, 24 | \code{\link{has_dont_know}()}, 25 | \code{\link{intToEnc}()}, 26 | \code{\link{remove_all_dont_know}()}, 27 | \code{\link{remove_dont_know}()} 28 | } 29 | \concept{Functions to clean data} 30 | \keyword{"clean} 31 | \keyword{data"} 32 | -------------------------------------------------------------------------------- /man/membersurvey.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/surveydata-package.R 3 | \docType{data} 4 | \name{membersurvey} 5 | \alias{membersurvey} 6 | \title{Data frame with survey data of member satisfaction survey.} 7 | \format{ 8 | data frame 9 | } 10 | \usage{ 11 | membersurvey 12 | } 13 | \description{ 14 | Data frame with survey data of member satisfaction survey. 15 | } 16 | \keyword{datasets} 17 | -------------------------------------------------------------------------------- /man/merge.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/merge.R 3 | \name{merge} 4 | \alias{merge} 5 | \alias{merge.surveydata} 6 | \title{Merge surveydata objects.} 7 | \usage{ 8 | \method{merge}{surveydata}(x, y, ...) 9 | } 10 | \arguments{ 11 | \item{x}{surveydata object} 12 | 13 | \item{y}{surveydata object} 14 | 15 | \item{...}{Other parameters passed to \code{\link[=merge]{merge()}}} 16 | } 17 | \description{ 18 | The base R merge will merge data but not all of the attributes. This function also merges the variable.labels attribute. 19 | } 20 | -------------------------------------------------------------------------------- /man/merge_varlabels.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/merge.R 3 | \name{merge_varlabels} 4 | \alias{merge_varlabels} 5 | \title{Merges variable.labels attribute from two surveydata objects} 6 | \usage{ 7 | merge_varlabels(dat1, dat2, new_names = union(names(dat1), names(dat2))) 8 | } 9 | \arguments{ 10 | \item{dat1}{surveydata object} 11 | 12 | \item{dat2}{surveydata object} 13 | 14 | \item{new_names}{A vector with names of the merged varlabels. Defaults to the union of names of dat1 and dat2} 15 | } 16 | \description{ 17 | Merges variable labels from two data objects. The labels from dat1 takes precedence. 18 | } 19 | \keyword{internal} 20 | -------------------------------------------------------------------------------- /man/names.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/surveydata.R 3 | \name{names<-.surveydata} 4 | \alias{names<-.surveydata} 5 | \alias{names<-} 6 | \title{Updates names and variable.labels attribute of surveydata.} 7 | \usage{ 8 | \method{names}{surveydata}(x) <- value 9 | } 10 | \arguments{ 11 | \item{x}{surveydata object} 12 | 13 | \item{value}{New names} 14 | } 15 | \description{ 16 | Updates names and variable.labels attribute of surveydata. 17 | } 18 | \seealso{ 19 | \code{\link[=surveydata-package]{surveydata-package()}}, \code{\link[=is.surveydata]{is.surveydata()}} 20 | } 21 | \keyword{internal} 22 | -------------------------------------------------------------------------------- /man/pattern.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/pattern.R 3 | \name{pattern} 4 | \alias{pattern} 5 | \alias{pattern<-} 6 | \title{Returns and updates pattern attribute.} 7 | \usage{ 8 | pattern(x) 9 | 10 | pattern(x) <- value 11 | } 12 | \arguments{ 13 | \item{x}{surveydata object} 14 | 15 | \item{value}{New value} 16 | } 17 | \description{ 18 | The pattern attribute contains information about the separator character used to name sub-questions in the data. Survey software typically makes use of underscores to distinguish sub-questions in a grid of questions, e.g. "Q4_1", "Q4_2", "Q4_3", "Q4_other". The function \code{\link[=pattern]{pattern()}} returns the \code{pattern} attribute, and \link{pattern<-} updates the attribute. 19 | } 20 | \examples{ 21 | # Extract the pattern from membersurvey 22 | 23 | oldptn <- pattern(membersurvey) 24 | oldptn 25 | 26 | # The pattern is used to extract columns 27 | 28 | names(membersurvey) 29 | grep("Q20", names(membersurvey), value=TRUE) 30 | 31 | head(membersurvey["Q20"]) 32 | head(membersurvey["Q20_other"]) 33 | 34 | # Define a new pattern 35 | 36 | pattern(membersurvey) <- list(sep="_", exclude="") 37 | head(membersurvey["Q20"]) 38 | 39 | # Reset original pattern 40 | 41 | pattern(membersurvey) <- oldptn 42 | rm(oldptn) 43 | } 44 | \seealso{ 45 | \code{\link[=as.surveydata]{as.surveydata()}}, \code{\link[=which.q]{which.q()}} 46 | 47 | Other Attribute functions: 48 | \code{\link{varlabels}()} 49 | } 50 | \concept{Attribute functions} 51 | \keyword{internal} 52 | -------------------------------------------------------------------------------- /man/print_opentext.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/opentext.R 3 | \name{print_opentext} 4 | \alias{print_opentext} 5 | \title{Print open text questions.} 6 | \usage{ 7 | print_opentext(data, q, cat = TRUE) 8 | } 9 | \arguments{ 10 | \item{data}{data} 11 | 12 | \item{q}{Question number} 13 | 14 | \item{cat}{If TRUE, prints results using \code{cat()}} 15 | } 16 | \description{ 17 | Print open text questions. 18 | } 19 | \examples{ 20 | print_opentext(membersurvey, "Q33") 21 | } 22 | \seealso{ 23 | Other open text functions: 24 | \code{\link{as_opentext_datatable}()} 25 | } 26 | \concept{open text functions} 27 | -------------------------------------------------------------------------------- /man/question_order.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/cleandata.R 3 | \name{question_order} 4 | \alias{question_order} 5 | \title{Changes vector to ordered factor, adding NA levels if applicable.} 6 | \usage{ 7 | question_order(x) 8 | } 9 | \arguments{ 10 | \item{x}{character vector} 11 | } 12 | \description{ 13 | Changes vector to ordered factor, adding NA levels if applicable. 14 | } 15 | \seealso{ 16 | Other Tools: 17 | \code{\link{lapply_names}()} 18 | } 19 | \concept{Tools} 20 | -------------------------------------------------------------------------------- /man/question_text.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/questions.R 3 | \name{question_text} 4 | \alias{question_text} 5 | \title{Returns question text.} 6 | \usage{ 7 | question_text(x, Q) 8 | } 9 | \arguments{ 10 | \item{x}{A surveydata object} 11 | 12 | \item{Q}{The question id, e.g. "Q4". If not supplied, returns the text for all questions.} 13 | } 14 | \value{ 15 | character vector 16 | } 17 | \description{ 18 | Given a question id, e.g. "Q4", returns question text for this question. Note that this returns. The functions \code{\link[=question_text_unique]{question_text_unique()}} and \code{\link[=question_text_common]{question_text_common()}} returns the unique and common components of the question text. 19 | } 20 | \examples{ 21 | # Basic operations on a surveydata object, illustrated with the example dataset membersurvey 22 | 23 | class(membersurvey) 24 | 25 | questions(membersurvey) 26 | 27 | which.q(membersurvey, "Q1") 28 | which.q(membersurvey, "Q3") 29 | which.q(membersurvey, c("Q1", "Q3")) 30 | 31 | question_text(membersurvey, "Q3") 32 | question_text_unique(membersurvey, "Q3") 33 | question_text_common(membersurvey, "Q3") 34 | 35 | # Extracting columns from a surveydata object 36 | 37 | head(membersurvey[, "Q1"]) 38 | head(membersurvey["Q1"]) 39 | head(membersurvey[, "Q3"]) 40 | head(membersurvey[, c("Q1", "Q3")]) 41 | 42 | # Note that the result is always a surveydata object, even if only one column is extracted 43 | 44 | head(membersurvey[, "id"]) 45 | str(membersurvey[, "id"]) 46 | 47 | } 48 | \seealso{ 49 | Other Question functions: 50 | \code{\link{question_text_common}()}, 51 | \code{\link{question_text_unique}()}, 52 | \code{\link{questions}()}, 53 | \code{\link{split_common_unique}()}, 54 | \code{\link{which.q}()} 55 | } 56 | \concept{Question functions} 57 | \keyword{Questions} 58 | -------------------------------------------------------------------------------- /man/question_text_common.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/questions.R 3 | \name{question_text_common} 4 | \alias{question_text_common} 5 | \title{Returns common element of question text.} 6 | \usage{ 7 | question_text_common(x, Q) 8 | } 9 | \arguments{ 10 | \item{x}{A surveydata object} 11 | 12 | \item{Q}{The question id, e.g. "Q4". If not supplied, returns the text for all questions.} 13 | } 14 | \value{ 15 | character vector 16 | } 17 | \description{ 18 | Given a question id, e.g. "Q4", finds all sub-questions, e.g. "Q4_1", "Q4_2", etc, 19 | and returns the question text that is common to each. 20 | } 21 | \examples{ 22 | # Basic operations on a surveydata object, illustrated with the example dataset membersurvey 23 | 24 | class(membersurvey) 25 | 26 | questions(membersurvey) 27 | 28 | which.q(membersurvey, "Q1") 29 | which.q(membersurvey, "Q3") 30 | which.q(membersurvey, c("Q1", "Q3")) 31 | 32 | question_text(membersurvey, "Q3") 33 | question_text_unique(membersurvey, "Q3") 34 | question_text_common(membersurvey, "Q3") 35 | 36 | # Extracting columns from a surveydata object 37 | 38 | head(membersurvey[, "Q1"]) 39 | head(membersurvey["Q1"]) 40 | head(membersurvey[, "Q3"]) 41 | head(membersurvey[, c("Q1", "Q3")]) 42 | 43 | # Note that the result is always a surveydata object, even if only one column is extracted 44 | 45 | head(membersurvey[, "id"]) 46 | str(membersurvey[, "id"]) 47 | 48 | } 49 | \seealso{ 50 | Other Question functions: 51 | \code{\link{question_text_unique}()}, 52 | \code{\link{question_text}()}, 53 | \code{\link{questions}()}, 54 | \code{\link{split_common_unique}()}, 55 | \code{\link{which.q}()} 56 | } 57 | \concept{Question functions} 58 | \keyword{Questions} 59 | -------------------------------------------------------------------------------- /man/question_text_unique.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/questions.R 3 | \name{question_text_unique} 4 | \alias{question_text_unique} 5 | \title{Returns unique elements of question text.} 6 | \usage{ 7 | question_text_unique(x, Q) 8 | } 9 | \arguments{ 10 | \item{x}{A surveydata object} 11 | 12 | \item{Q}{The question id, e.g. "Q4". If not supplied, returns the text for all questions.} 13 | } 14 | \value{ 15 | character vector 16 | } 17 | \description{ 18 | Given a question id, e.g. "Q4", finds all sub-questions, e.g. Q4_1, Q4_2, etc, 19 | and returns the question text that is unique to each 20 | } 21 | \examples{ 22 | # Basic operations on a surveydata object, illustrated with the example dataset membersurvey 23 | 24 | class(membersurvey) 25 | 26 | questions(membersurvey) 27 | 28 | which.q(membersurvey, "Q1") 29 | which.q(membersurvey, "Q3") 30 | which.q(membersurvey, c("Q1", "Q3")) 31 | 32 | question_text(membersurvey, "Q3") 33 | question_text_unique(membersurvey, "Q3") 34 | question_text_common(membersurvey, "Q3") 35 | 36 | # Extracting columns from a surveydata object 37 | 38 | head(membersurvey[, "Q1"]) 39 | head(membersurvey["Q1"]) 40 | head(membersurvey[, "Q3"]) 41 | head(membersurvey[, c("Q1", "Q3")]) 42 | 43 | # Note that the result is always a surveydata object, even if only one column is extracted 44 | 45 | head(membersurvey[, "id"]) 46 | str(membersurvey[, "id"]) 47 | 48 | } 49 | \seealso{ 50 | Other Question functions: 51 | \code{\link{question_text_common}()}, 52 | \code{\link{question_text}()}, 53 | \code{\link{questions}()}, 54 | \code{\link{split_common_unique}()}, 55 | \code{\link{which.q}()} 56 | } 57 | \concept{Question functions} 58 | \keyword{Questions} 59 | -------------------------------------------------------------------------------- /man/questions.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/questions.R 3 | \name{questions} 4 | \alias{questions} 5 | \title{Returns a list of all the unique questions in the surveydata object.} 6 | \usage{ 7 | questions(x, ptn = pattern(x)) 8 | } 9 | \arguments{ 10 | \item{x}{Object to coerce to surveydata} 11 | 12 | \item{ptn}{A list with two elements, \code{sep} and \code{exclude}. See \code{\link[=pattern]{pattern()}} and \code{\link[=which.q]{which.q()}} for more detail.} 13 | } 14 | \value{ 15 | numeric vector 16 | } 17 | \description{ 18 | In many survey systems, sub-questions take the form Q1_a, Q1_b, with the main question and sub-question separated by an underscore. This function conveniently returns all of the main questions in a \code{\link[=surveydata]{surveydata()}} object. It does this by using the \code{\link[=pattern]{pattern()}} attribute of the surveydata object. 19 | } 20 | \examples{ 21 | # Basic operations on a surveydata object, illustrated with the example dataset membersurvey 22 | 23 | class(membersurvey) 24 | 25 | questions(membersurvey) 26 | 27 | which.q(membersurvey, "Q1") 28 | which.q(membersurvey, "Q3") 29 | which.q(membersurvey, c("Q1", "Q3")) 30 | 31 | question_text(membersurvey, "Q3") 32 | question_text_unique(membersurvey, "Q3") 33 | question_text_common(membersurvey, "Q3") 34 | 35 | # Extracting columns from a surveydata object 36 | 37 | head(membersurvey[, "Q1"]) 38 | head(membersurvey["Q1"]) 39 | head(membersurvey[, "Q3"]) 40 | head(membersurvey[, c("Q1", "Q3")]) 41 | 42 | # Note that the result is always a surveydata object, even if only one column is extracted 43 | 44 | head(membersurvey[, "id"]) 45 | str(membersurvey[, "id"]) 46 | 47 | } 48 | \seealso{ 49 | which.q 50 | 51 | Other Question functions: 52 | \code{\link{question_text_common}()}, 53 | \code{\link{question_text_unique}()}, 54 | \code{\link{question_text}()}, 55 | \code{\link{split_common_unique}()}, 56 | \code{\link{which.q}()} 57 | } 58 | \concept{Question functions} 59 | \keyword{Questions} 60 | -------------------------------------------------------------------------------- /man/remove_all_dont_know.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/cleandata.R 3 | \name{remove_all_dont_know} 4 | \alias{remove_all_dont_know} 5 | \title{Removes "Do not know" and other similar words from factor levels in data frame.} 6 | \usage{ 7 | remove_all_dont_know(x, dk = NULL, message = TRUE) 8 | } 9 | \arguments{ 10 | \item{x}{List or data frame} 11 | 12 | \item{dk}{Character vector, containing search terms, e.g. \code{c("Do not know", "DK")}. These terms will be replaced by \code{NA}. If \code{NULL}, defaults to \code{c("I don't know", "Don't Know", "Don't know", "Dont know" , "DK")}} 13 | 14 | \item{message}{If TRUE, displays message with the number of instances that were removed.} 15 | } 16 | \value{ 17 | A data frame 18 | } 19 | \description{ 20 | Removes "Do not know" and other similar words from factor levels in data frame 21 | } 22 | \seealso{ 23 | \code{\link[=hasDK]{hasDK()}} and \code{\link[=removeDK]{removeDK()}} 24 | 25 | Other Functions to clean data: 26 | \code{\link{encToInt}()}, 27 | \code{\link{fix_common_encoding_problems}()}, 28 | \code{\link{fix_levels_01_spss}()}, 29 | \code{\link{has_dont_know}()}, 30 | \code{\link{intToEnc}()}, 31 | \code{\link{leveltest}}, 32 | \code{\link{remove_dont_know}()} 33 | } 34 | \concept{Functions to clean data} 35 | \keyword{"clean} 36 | \keyword{data"} 37 | -------------------------------------------------------------------------------- /man/remove_dont_know.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/cleandata.R 3 | \name{remove_dont_know} 4 | \alias{remove_dont_know} 5 | \title{Removes "Don't know" from levels and replaces with NA.} 6 | \usage{ 7 | remove_dont_know(x, dk = "Don't Know") 8 | } 9 | \arguments{ 10 | \item{x}{Character vector or factor} 11 | 12 | \item{dk}{Character vector, containing search terms, e.g. \code{c("Don't know", "Don't Know")}} 13 | } 14 | \value{ 15 | A factor with "Dont know" removed 16 | } 17 | \description{ 18 | Tests the levels of x contain any instances of "Don't know". If so, replaces these levels with \code{NA} 19 | } 20 | \seealso{ 21 | Other Functions to clean data: 22 | \code{\link{encToInt}()}, 23 | \code{\link{fix_common_encoding_problems}()}, 24 | \code{\link{fix_levels_01_spss}()}, 25 | \code{\link{has_dont_know}()}, 26 | \code{\link{intToEnc}()}, 27 | \code{\link{leveltest}}, 28 | \code{\link{remove_all_dont_know}()} 29 | } 30 | \concept{Functions to clean data} 31 | \keyword{"clean} 32 | \keyword{data"} 33 | -------------------------------------------------------------------------------- /man/rm.attrs.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/pattern.R 3 | \name{rm.attrs} 4 | \alias{rm.attrs} 5 | \title{Removes pattern and variable.labels from attributes list.} 6 | \usage{ 7 | rm.attrs(x) 8 | } 9 | \arguments{ 10 | \item{x}{Surveydata object} 11 | } 12 | \description{ 13 | Removes pattern and variable.labels from attributes list. 14 | } 15 | \keyword{Internal} 16 | -------------------------------------------------------------------------------- /man/rm.pattern.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/pattern.R 3 | \name{rm.pattern} 4 | \alias{rm.pattern} 5 | \title{Removes pattern from attributes list.} 6 | \usage{ 7 | rm.pattern(x) 8 | } 9 | \arguments{ 10 | \item{x}{Surveydata object} 11 | } 12 | \description{ 13 | Removes pattern from attributes list. 14 | } 15 | \keyword{Internal} 16 | -------------------------------------------------------------------------------- /man/split_common_unique.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/questions.R 3 | \name{split_common_unique} 4 | \alias{split_common_unique} 5 | \title{Get common and unique text in question based on regex pattern identification.} 6 | \usage{ 7 | split_common_unique(x, ptn = NULL) 8 | } 9 | \arguments{ 10 | \item{x}{A character vector} 11 | 12 | \item{ptn}{A \code{\link[=regex]{regex()}} pattern that defines how the string should be split into common and unique elements} 13 | } 14 | \description{ 15 | Get common and unique text in question based on regex pattern identification. 16 | } 17 | \seealso{ 18 | Other Question functions: 19 | \code{\link{question_text_common}()}, 20 | \code{\link{question_text_unique}()}, 21 | \code{\link{question_text}()}, 22 | \code{\link{questions}()}, 23 | \code{\link{which.q}()} 24 | } 25 | \concept{Question functions} 26 | \keyword{Questions} 27 | -------------------------------------------------------------------------------- /man/strCommonUnique.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/strings.R 3 | \name{strCommonUnique} 4 | \alias{strCommonUnique} 5 | \title{Finds the common and unique elements in a character vector.} 6 | \usage{ 7 | strCommonUnique(string) 8 | } 9 | \arguments{ 10 | \item{string}{Character vector} 11 | } 12 | \value{ 13 | list of common and unique strings 14 | } 15 | \description{ 16 | Function takes a character string as input and find the common and 17 | unique elements. Assumes that the common element is at start of string. 18 | } 19 | \examples{ 20 | test <- c("Q_1", "Q_2", "Q_3") 21 | strCommonUnique(test)$common 22 | strCommonUnique(test)$unique 23 | } 24 | \concept{Strings} 25 | \keyword{string} 26 | -------------------------------------------------------------------------------- /man/survey_plot_question.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/plots.R 3 | \name{survey_plot_question} 4 | \alias{survey_plot_question} 5 | \title{Plots single and as multi-response questions.} 6 | \usage{ 7 | survey_plot_question(data, q) 8 | } 9 | \arguments{ 10 | \item{data}{surveydata object} 11 | 12 | \item{q}{Question} 13 | } 14 | \description{ 15 | Plots single and as multi-response questions. 16 | } 17 | \examples{ 18 | question_text(membersurvey) 19 | 20 | survey_plot_question(membersurvey, "Q2") 21 | survey_plot_yes_no(membersurvey, "Q2") 22 | survey_plot_satisfaction(membersurvey, "Q14") 23 | 24 | } 25 | \seealso{ 26 | Other survey plotting functions: 27 | \code{\link{survey_plot_satisfaction}()}, 28 | \code{\link{survey_plot_yes_no}()} 29 | } 30 | \concept{survey plotting functions} 31 | -------------------------------------------------------------------------------- /man/survey_plot_satisfaction.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/plots.R 3 | \name{survey_plot_satisfaction} 4 | \alias{survey_plot_satisfaction} 5 | \title{Plot satisfaction questions.} 6 | \usage{ 7 | survey_plot_satisfaction(data, q, fun = c("net", "top3", "top2")) 8 | } 9 | \arguments{ 10 | \item{data}{surveydata object} 11 | 12 | \item{q}{Question} 13 | 14 | \item{fun}{Aggregation function, one of \code{net} (compute net satisfaction score), \code{top3} (compute top 3 box score) and \code{top2} (compute top 2 box score)} 15 | } 16 | \description{ 17 | Plot satisfaction questions. 18 | } 19 | \examples{ 20 | question_text(membersurvey) 21 | 22 | survey_plot_question(membersurvey, "Q2") 23 | survey_plot_yes_no(membersurvey, "Q2") 24 | survey_plot_satisfaction(membersurvey, "Q14") 25 | 26 | } 27 | \seealso{ 28 | Other survey plotting functions: 29 | \code{\link{survey_plot_question}()}, 30 | \code{\link{survey_plot_yes_no}()} 31 | } 32 | \concept{survey plotting functions} 33 | -------------------------------------------------------------------------------- /man/survey_plot_title.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/plots.R 3 | \name{survey_plot_title} 4 | \alias{survey_plot_title} 5 | \title{Construct plot title from the question text, wrapping at the desired width.} 6 | \usage{ 7 | survey_plot_title(data, q, width = 50) 8 | } 9 | \arguments{ 10 | \item{data}{surveydata object} 11 | 12 | \item{q}{Question} 13 | 14 | \item{width}{Passed to \code{\link[=strwrap]{strwrap()}}} 15 | } 16 | \description{ 17 | This creates a plot title using \verb{[ggplot2::ggtitle()]}. The main title is string wrapped, and the subtitle is the number of observations in the data. 18 | } 19 | -------------------------------------------------------------------------------- /man/survey_plot_yes_no.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/plots.R 3 | \name{survey_plot_yes_no} 4 | \alias{survey_plot_yes_no} 5 | \title{Plot data in yes/no format.} 6 | \usage{ 7 | survey_plot_yes_no(data, q) 8 | } 9 | \arguments{ 10 | \item{data}{surveydata object} 11 | 12 | \item{q}{Question} 13 | } 14 | \description{ 15 | Plot data in yes/no format. 16 | } 17 | \examples{ 18 | question_text(membersurvey) 19 | 20 | survey_plot_question(membersurvey, "Q2") 21 | survey_plot_yes_no(membersurvey, "Q2") 22 | survey_plot_satisfaction(membersurvey, "Q14") 23 | 24 | } 25 | \seealso{ 26 | Other survey plotting functions: 27 | \code{\link{survey_plot_question}()}, 28 | \code{\link{survey_plot_satisfaction}()} 29 | } 30 | \concept{survey plotting functions} 31 | -------------------------------------------------------------------------------- /man/surveydata-deprecated.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/surveydata-deprecated.R 3 | \name{hasDK} 4 | \alias{hasDK} 5 | \alias{removeDK} 6 | \alias{removeAllDK} 7 | \alias{leveltestSPSS} 8 | \alias{leveltestR} 9 | \alias{fixLevels01SPSS} 10 | \alias{fixLevels01R} 11 | \alias{fixLevels01} 12 | \alias{qOrder} 13 | \alias{lapplyNames} 14 | \alias{fixCommonEncodingProblems} 15 | \alias{qText} 16 | \alias{qTextUnique} 17 | \alias{qTextCommon} 18 | \title{Deprecated functions.} 19 | \usage{ 20 | hasDK(...) 21 | 22 | removeDK(...) 23 | 24 | removeAllDK(...) 25 | 26 | leveltestSPSS(...) 27 | 28 | leveltestR(...) 29 | 30 | fixLevels01SPSS(...) 31 | 32 | fixLevels01R(...) 33 | 34 | fixLevels01(...) 35 | 36 | qOrder(...) 37 | 38 | lapplyNames(...) 39 | 40 | fixCommonEncodingProblems(...) 41 | 42 | qText(...) 43 | 44 | qTextUnique(...) 45 | 46 | qTextCommon(...) 47 | } 48 | \arguments{ 49 | \item{...}{passed to replacement function} 50 | } 51 | \description{ 52 | These functions have all been superseded with functions using \code{snake_case} function names. 53 | \itemize{ 54 | \item \code{hasDK}: \code{\link[=has_dont_know]{has_dont_know()}} 55 | \item \code{removeDK}: \code{\link[=remove_dont_know]{remove_dont_know()}} 56 | \item \code{removeAllDK}: \code{\link[=remove_all_dont_know]{remove_all_dont_know()}} 57 | \item \code{leveltestSPSS}: \code{\link[=leveltest_spss]{leveltest_spss()}} 58 | \item \code{leveltestR}: \code{\link[=leveltest_r]{leveltest_r()}} 59 | \item \code{fixLevels01SPSS}: \code{\link[=fix_levels_01_spss]{fix_levels_01_spss()}} 60 | \item \code{fixLevels01R}: \code{\link[=fix_levels_01_r]{fix_levels_01_r()}} 61 | \item \code{fixLevels01}: \code{\link[=fix_levels_01]{fix_levels_01()}} 62 | \item \code{qOrder}: \code{\link[=question_order]{question_order()}} 63 | \item \code{lapplyNames}: \code{\link[=lapply_names]{lapply_names()}} 64 | \item \code{fixCommonEncodingProblems}: \code{\link[=fix_common_encoding_problems]{fix_common_encoding_problems()}} 65 | } 66 | } 67 | \keyword{internal} 68 | -------------------------------------------------------------------------------- /man/surveydata-package.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/surveydata-package.R 3 | \docType{package} 4 | \name{surveydata-package} 5 | \alias{surveydata-package} 6 | \alias{surveydata} 7 | \title{Tools, classes and methods to manipulate survey data.} 8 | \description{ 9 | Tools, classes and methods to manipulate survey data. 10 | } 11 | \details{ 12 | Surveydata objects have been designed to function with SPSS export data, i.e. the result of an SPSS import, \code{\link[foreign:read.spss]{foreign::read.spss()}}. This type of data is contained in a data.frame, with information about the questionnaire text in the \code{variable.labels} attribute. Surveydata objects keep track of the variable labels, by offering methods for renaming, subsetting, etc. 13 | 14 | Coercion functions: 15 | \itemize{ 16 | \item \code{\link[=as.surveydata]{as.surveydata()}} 17 | \item \code{\link[=is.surveydata]{is.surveydata()}} 18 | \item \code{\link[=as.data.frame.surveydata]{as.data.frame.surveydata()}} 19 | } 20 | 21 | To access and modify attributes: 22 | \itemize{ 23 | \item \code{\link[=pattern]{pattern()}} 24 | \item \code{\link[=varlabels]{varlabels()}} 25 | } 26 | 27 | To subset or merge surveydata objects: 28 | \itemize{ 29 | \item \code{\link[=merge]{merge()}} 30 | \item \code{\link[=Extract]{Extract()}} 31 | \item \code{\link[=cbind.surveydata]{cbind.surveydata()}} 32 | } 33 | 34 | To extract question text from varlabels: 35 | \itemize{ 36 | \item \code{\link[=question_text]{question_text()}} 37 | \item \code{\link[=question_text_common]{question_text_common()}} 38 | \item \code{\link[=question_text_unique]{question_text_unique()}} 39 | } 40 | 41 | To fix common encoding problems: 42 | \itemize{ 43 | \item \code{\link[=encToInt]{encToInt()}} 44 | \item \code{\link[=intToEnc]{intToEnc()}} 45 | \item \code{\link[=fix_common_encoding_problems]{fix_common_encoding_problems()}} 46 | } 47 | 48 | To clean data: 49 | \itemize{ 50 | \item \code{\link[=remove_dont_know]{remove_dont_know()}} to remove "Don't know" responses 51 | \item \code{\link[=remove_all_dont_know]{remove_all_dont_know()}} to remove "Don't know" responses from all questions 52 | \item \code{\link[=fix_levels_01]{fix_levels_01()}} to fix level formatting of all question with Yes/No type answers 53 | } 54 | 55 | Miscellaneous tools: 56 | \itemize{ 57 | \item \code{\link[=dropout]{dropout()}} to determine questions where respondents drop out 58 | } 59 | } 60 | \examples{ 61 | library(surveydata) 62 | 63 | # Create surveydata object 64 | 65 | sdat <- data.frame( 66 | id = 1:4, 67 | Q1 = c("Yes", "No", "Yes", "Yes"), 68 | Q4_1 = c(1, 2, 1, 2), 69 | Q4_2 = c(3, 4, 4, 3), 70 | Q4_3 = c(5, 5, 6, 6), 71 | Q10 = factor(c("Male", "Female", "Female", "Male")), 72 | crossbreak = c("A", "A", "B", "B"), 73 | weight = c(0.9, 1.1, 0.8, 1.2) 74 | ) 75 | 76 | varlabels(sdat) <- c( 77 | "RespID", 78 | "Question 1", 79 | "Question 4: red", "Question 4: green", "Question 4: blue", 80 | "Question 10", 81 | "crossbreak", 82 | "weight" 83 | ) 84 | 85 | sv <- as.surveydata(sdat, renameVarlabels = TRUE) 86 | 87 | # Extract specific questions 88 | sv[, "Q1"] 89 | sv[, "Q4"] 90 | 91 | # Query attributes 92 | varlabels(sv) 93 | pattern(sv) 94 | 95 | # Find unique questions 96 | 97 | questions(sv) 98 | which.q(sv, "Q1") 99 | which.q(sv, "Q4") 100 | 101 | # Find question text 102 | question_text(sv, "Q1") 103 | question_text(sv, "Q4") 104 | 105 | question_text_common(sv, "Q4") 106 | question_text_unique(sv, "Q4") 107 | 108 | 109 | # Basic operations on a surveydata object, illustrated with the example dataset membersurvey 110 | 111 | class(membersurvey) 112 | 113 | questions(membersurvey) 114 | 115 | which.q(membersurvey, "Q1") 116 | which.q(membersurvey, "Q3") 117 | which.q(membersurvey, c("Q1", "Q3")) 118 | 119 | question_text(membersurvey, "Q3") 120 | question_text_unique(membersurvey, "Q3") 121 | question_text_common(membersurvey, "Q3") 122 | 123 | # Extracting columns from a surveydata object 124 | 125 | head(membersurvey[, "Q1"]) 126 | head(membersurvey["Q1"]) 127 | head(membersurvey[, "Q3"]) 128 | head(membersurvey[, c("Q1", "Q3")]) 129 | 130 | # Note that the result is always a surveydata object, even if only one column is extracted 131 | 132 | head(membersurvey[, "id"]) 133 | str(membersurvey[, "id"]) 134 | 135 | } 136 | \author{ 137 | Andrie de Vries \email{apdevries@gmail.com} 138 | } 139 | \keyword{package} 140 | -------------------------------------------------------------------------------- /man/varlabels.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/varlabels.R 3 | \name{varlabels} 4 | \alias{varlabels} 5 | \alias{varlabels<-} 6 | \title{Returns and updates variable.labels attribute of surveydata object.} 7 | \usage{ 8 | varlabels(x) 9 | 10 | varlabels(x) <- value 11 | } 12 | \arguments{ 13 | \item{x}{surveydata object} 14 | 15 | \item{value}{New value} 16 | } 17 | \description{ 18 | In a surveydata object, the \code{variable.labels} attribute store metadata about the original question text (see \code{\link[foreign:read.spss]{foreign::read.spss()}} for details). The function \code{varlabels()} returns the \code{variable.labels} attribute of data, and \code{varlabels(x) <- value} updates this attribute. 19 | } 20 | \details{ 21 | In a surveydata object, the \code{varlabels} attribute is a named character vector, where the names correspond to the names of the the columns in 22 | } 23 | \examples{ 24 | # Extract the variable labels from membersurvey 25 | 26 | ms <- membersurvey[, c("id", "Q1", "Q2")] 27 | 28 | str(ms) 29 | varlabels(ms) 30 | varlabels(ms)["Q2"] 31 | 32 | # Assign a new value to the text of question 2 33 | 34 | varlabels(ms)["Q2"] <- "When did you join?" 35 | varlabels(ms) 36 | str(ms["Q2"]) 37 | 38 | } 39 | \seealso{ 40 | \link{surveydata-package} 41 | 42 | Other Attribute functions: 43 | \code{\link{pattern}()} 44 | 45 | Other Attribute functions: 46 | \code{\link{pattern}()} 47 | } 48 | \concept{Attribute functions} 49 | \keyword{internal} 50 | -------------------------------------------------------------------------------- /man/which.q.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/questions.R 3 | \name{which.q} 4 | \alias{which.q} 5 | \title{Identifies the columns indices corresponding to a specific question.} 6 | \usage{ 7 | which.q(x, Q, ptn = pattern(x)) 8 | } 9 | \arguments{ 10 | \item{x}{Object to coerce to surveydata} 11 | 12 | \item{Q}{Character string with question number, e.g. "Q2"} 13 | 14 | \item{ptn}{A list with two elements, \code{sep} and \code{exclude}. See \code{\link[=pattern]{pattern()}} and \code{\link[=which.q]{which.q()}} for more detail.} 15 | } 16 | \description{ 17 | In many survey systems, sub-questions take the form "Q1_a", "Q1_b", with the main question and sub-question separated by an underscore. This function conveniently returns column index of matches found for a question id in a \link{surveydata} object. It does this by using the \link{pattern} attribute of the \code{surveydata} object. 18 | } 19 | \examples{ 20 | # Basic operations on a surveydata object, illustrated with the example dataset membersurvey 21 | 22 | class(membersurvey) 23 | 24 | questions(membersurvey) 25 | 26 | which.q(membersurvey, "Q1") 27 | which.q(membersurvey, "Q3") 28 | which.q(membersurvey, c("Q1", "Q3")) 29 | 30 | question_text(membersurvey, "Q3") 31 | question_text_unique(membersurvey, "Q3") 32 | question_text_common(membersurvey, "Q3") 33 | 34 | # Extracting columns from a surveydata object 35 | 36 | head(membersurvey[, "Q1"]) 37 | head(membersurvey["Q1"]) 38 | head(membersurvey[, "Q3"]) 39 | head(membersurvey[, c("Q1", "Q3")]) 40 | 41 | # Note that the result is always a surveydata object, even if only one column is extracted 42 | 43 | head(membersurvey[, "id"]) 44 | str(membersurvey[, "id"]) 45 | 46 | } 47 | \seealso{ 48 | \code{\link[=questions]{questions()}} to return all questions matching the \code{\link[=pattern]{pattern()}} 49 | 50 | Other Question functions: 51 | \code{\link{question_text_common}()}, 52 | \code{\link{question_text_unique}()}, 53 | \code{\link{question_text}()}, 54 | \code{\link{questions}()}, 55 | \code{\link{split_common_unique}()} 56 | } 57 | \concept{Question functions} 58 | \keyword{Questions} 59 | -------------------------------------------------------------------------------- /revdep/.gitignore: -------------------------------------------------------------------------------- 1 | checks 2 | library 3 | checks.noindex 4 | library.noindex 5 | cloud.noindex 6 | data.sqlite 7 | *.html 8 | -------------------------------------------------------------------------------- /revdep/README.md: -------------------------------------------------------------------------------- 1 | # Platform 2 | 3 | |field |value | 4 | |:--------|:-------------------------------------------------------| 5 | |version |R Under development (unstable) (2023-03-10 r83967 ucrt) | 6 | |os |Windows 11 x64 (build 22621) | 7 | |system |x86_64, mingw32 | 8 | |ui |RStudio | 9 | |language |(EN) | 10 | |collate |English_United Kingdom.utf8 | 11 | |ctype |English_United Kingdom.utf8 | 12 | |tz |GMT | 13 | |date |2023-03-11 | 14 | |rstudio |2023.03.0+385 Cherry Blossom (desktop) | 15 | |pandoc |2.18 @ C:\Users\apdev\scoop\shims\pandoc.exe | 16 | 17 | # Dependencies 18 | 19 | |package |old |new |Δ | 20 | |:------------|:-------|:-------|:--| 21 | |surveydata |0.2.6 |0.2.7 |* | 22 | |assertthat |0.2.1 |0.2.1 | | 23 | |base64enc |0.1-3 |0.1-3 | | 24 | |bslib |0.4.2 |0.4.2 | | 25 | |cachem |1.0.7 |1.0.7 | | 26 | |cli |3.6.0 |3.6.0 | | 27 | |colorspace |2.1-0 |2.1-0 | | 28 | |cpp11 |0.4.3 |0.4.3 | | 29 | |crosstalk |1.2.0 |1.2.0 | | 30 | |digest |0.6.31 |0.6.31 | | 31 | |dplyr |1.1.0 |1.1.0 | | 32 | |DT |0.27 |0.27 | | 33 | |ellipsis |0.3.2 |0.3.2 | | 34 | |evaluate |0.20 |0.20 | | 35 | |fansi |1.0.4 |1.0.4 | | 36 | |farver |2.1.1 |2.1.1 | | 37 | |fastmap |1.1.1 |1.1.1 | | 38 | |fs |1.6.1 |1.6.1 | | 39 | |generics |0.1.3 |0.1.3 | | 40 | |ggplot2 |3.4.1 |3.4.1 | | 41 | |glue |1.6.2 |1.6.2 | | 42 | |gtable |0.3.1 |0.3.1 | | 43 | |highr |0.10 |0.10 | | 44 | |htmltools |0.5.4 |0.5.4 | | 45 | |htmlwidgets |1.6.1 |1.6.1 | | 46 | |isoband |0.2.7 |0.2.7 | | 47 | |jquerylib |0.1.4 |0.1.4 | | 48 | |jsonlite |1.8.4 |1.8.4 | | 49 | |knitr |1.42 |1.42 | | 50 | |labeling |0.4.2 |0.4.2 | | 51 | |later |1.3.0 |1.3.0 | | 52 | |lazyeval |0.2.2 |0.2.2 | | 53 | |lifecycle |1.0.3 |1.0.3 | | 54 | |magrittr |2.0.3 |2.0.3 | | 55 | |memoise |2.0.1 |2.0.1 | | 56 | |mime |0.12 |0.12 | | 57 | |munsell |0.5.0 |0.5.0 | | 58 | |pillar |1.8.1 |1.8.1 | | 59 | |pkgconfig |2.0.3 |2.0.3 | | 60 | |promises |1.2.0.1 |1.2.0.1 | | 61 | |purrr |1.0.1 |1.0.1 | | 62 | |R6 |2.5.1 |2.5.1 | | 63 | |rappdirs |0.3.3 |0.3.3 | | 64 | |RColorBrewer |1.1-3 |1.1-3 | | 65 | |Rcpp |1.0.10 |1.0.10 | | 66 | |rlang |1.0.6 |1.0.6 | | 67 | |rmarkdown |2.20 |2.20 | | 68 | |sass |0.4.5 |0.4.5 | | 69 | |scales |1.2.1 |1.2.1 | | 70 | |stringi |1.7.12 |1.7.12 | | 71 | |stringr |1.5.0 |1.5.0 | | 72 | |tibble |3.2.0 |3.2.0 | | 73 | |tidyr |1.3.0 |1.3.0 | | 74 | |tidyselect |1.2.0 |1.2.0 | | 75 | |tinytex |0.44 |0.44 | | 76 | |utf8 |1.2.3 |1.2.3 | | 77 | |vctrs |0.5.2 |0.5.2 | | 78 | |viridisLite |0.4.1 |0.4.1 | | 79 | |withr |2.5.0 |2.5.0 | | 80 | |xfun |0.37 |0.37 | | 81 | |yaml |2.3.7 |2.3.7 | | 82 | 83 | # Revdeps 84 | 85 | -------------------------------------------------------------------------------- /revdep/cran.md: -------------------------------------------------------------------------------- 1 | ## revdepcheck results 2 | 3 | We checked 0 reverse dependencies, comparing R CMD check results across CRAN and dev versions of this package. 4 | 5 | * We saw 0 new problems 6 | * We failed to check 0 packages 7 | 8 | -------------------------------------------------------------------------------- /revdep/email.yml: -------------------------------------------------------------------------------- 1 | release_date: ??? 2 | rel_release_date: ??? 3 | my_news_url: ??? 4 | release_version: ??? 5 | release_details: ??? 6 | -------------------------------------------------------------------------------- /revdep/failures.md: -------------------------------------------------------------------------------- 1 | *Wow, no problems at all. :)* -------------------------------------------------------------------------------- /revdep/problems.md: -------------------------------------------------------------------------------- 1 | *Wow, no problems at all. :)* -------------------------------------------------------------------------------- /tests/spelling.R: -------------------------------------------------------------------------------- 1 | if(requireNamespace('spelling', quietly = TRUE)) 2 | spelling::spell_check_test(vignettes = TRUE, error = FALSE, 3 | skip_on_cran = TRUE) 4 | -------------------------------------------------------------------------------- /tests/testthat.R: -------------------------------------------------------------------------------- 1 | library(testthat) 2 | library(surveydata) 3 | 4 | test_check("surveydata") 5 | -------------------------------------------------------------------------------- /tests/testthat/2010.sav: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/andrie/surveydata/b4f783d06aaaa06d08818bf50fa376fc6e9f7271/tests/testthat/2010.sav -------------------------------------------------------------------------------- /tests/testthat/gss.rda: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/andrie/surveydata/b4f783d06aaaa06d08818bf50fa376fc6e9f7271/tests/testthat/gss.rda -------------------------------------------------------------------------------- /tests/testthat/helper.R: -------------------------------------------------------------------------------- 1 | # Create surveydata object 2 | 3 | 4 | make_test_survey <- function() { 5 | dat <- data.frame( 6 | id = 1:4, 7 | Q1 = c("Yes", "No", "Yes", "Yes"), 8 | Q4_1 = c(1, 2, 1, 2), 9 | Q4_2 = c(3, 4, 4, 3), 10 | Q4_3 = c(5, 5, 6, 6), 11 | Q10 = factor(c("Male", "Female", "Female", "Male")), 12 | crossbreak = c("A", "A", "B", "B"), 13 | weight = c(0.9, 1.1, 0.8, 1.2) 14 | ) 15 | 16 | varlabels(dat) <- c( 17 | "RespID", 18 | "Question 1", 19 | "Question 4: red", "Question 4: green", "Question 4: blue", 20 | "Question 10", 21 | "crossbreak", 22 | "weight" 23 | ) 24 | 25 | as.surveydata(dat, renameVarlabels = TRUE) 26 | } 27 | 28 | make_test_data <- function() { 29 | sdat <- data.frame( 30 | id = 1:4, 31 | Q1 = c("Yes", "No", "Yes", "Yes"), 32 | Q4_1 = c(1, 2, 1, 2), 33 | Q4_2 = c(3, 4, 4, 3), 34 | Q4_3 = c(5, 5, 6, 6), 35 | Q10 = factor(c("Male", "Female", "Female", "Male")), 36 | crossbreak = c("A", "A", "B", "B"), 37 | crossbreak2 = c("D", "E", "D", "E"), 38 | weight = c(0.9, 1.1, 0.8, 1.2) 39 | ) 40 | 41 | sdat_labels <- c( 42 | "RespID", 43 | "Question 1", 44 | "Question 4: red", "Question 4: green", "Question 4: blue", 45 | "Question 10", 46 | "crossbreak", 47 | "crossbreak2", 48 | "weight" 49 | ) 50 | names(sdat_labels) <- names(sdat) 51 | attributes(sdat)$variable.labels <- sdat_labels 52 | sdat 53 | } 54 | 55 | make_test_data_2 <- function() { 56 | sdat2 <- data.frame( 57 | id = 1:4, 58 | Q1 = c("Yes", "No", "Yes", "Yes"), 59 | `Q4__1` = c(1, 2, 1, 2), 60 | `Q4__2` = c(3, 4, 4, 3), 61 | `Q4__3` = c(5, 5, 6, 6), 62 | `Q4__ignore` = c(NA, NA, "some text", NA), 63 | Q10 = factor(c("Male", "Female", "Female", "Male")), 64 | crossbreak = c("A", "A", "B", "B"), 65 | crossbreak2 = c("D", "E", "D", "E"), 66 | weight = c(0.9, 1.1, 0.8, 1.2), 67 | check.names = FALSE 68 | ) 69 | 70 | varlabels(sdat2) <- c( 71 | "RespID", 72 | "Question 1", 73 | "Question 4: red", "Question 4: green", "Question 4: blue", 74 | "Question 4: Other", 75 | "Question 10", 76 | "crossbreak", 77 | "crossbreak2", 78 | "weight" 79 | ) 80 | sdat2 81 | } 82 | -------------------------------------------------------------------------------- /tests/testthat/notest-9-gss.R: -------------------------------------------------------------------------------- 1 | # Unit tests for "surveydata" class 2 | # 3 | # Author: Andrie 4 | #------------------------------------------------------------------------------ 5 | 6 | 7 | # Reads sample data obtained from http://www3.norc.org/GSS+Website/Download/SPSS+Format/ 8 | 9 | # library(foreign) 10 | # path <- file.path("f:", "git", "surveydata", "surveydata", "inst", "tests") 11 | # filename <- "2010.sav" 12 | # gss <- read.spss(file=file.path(path, filename), to.data.frame=TRUE) 13 | # save(gss, file=file.path(path, "gss.rda")) 14 | 15 | path <- file.path("inst", "tests") 16 | filename <- "gss.rda" 17 | load(file = file.path(path, filename)) 18 | 19 | gss <- as.surveydata(gss, ptn = c("^", "(.*?)$")) 20 | 21 | 22 | 23 | test_that("surveydata works with real spss data file", { 24 | qs <- questions(gss) 25 | 26 | expect_equal(length(qs), 790) 27 | expect_equal( 28 | head(qs, 20), 29 | c( 30 | "mar1", "mar2", "mar3", "mar4", "mar5", "mar6", "mar7", "mar8", 31 | "mar9", "mar11", "mar12", "abany", "abdefect", "abhlth", "abnomore", 32 | "abpoor", "abrape", "absingle", "acqntsex", "adults" 33 | ) 34 | ) 35 | 36 | expect_equal( 37 | head(varlabels(gss)), 38 | structure(c( 39 | "MARITAL STATUS OF 1ST PERSON", "MARITAL STATUS OF 2ND PERSON", 40 | "MARITAL STATUS OF 3RD PERSON", "MARITAL STATUS OF 4TH PERSON", 41 | "MARITAL STATUS OF 5TH PERSON", "MARITAL STATUS OF 6TH PERSON" 42 | ), .Names = c("mar1", "mar2", "mar3", "mar4", "mar5", "mar6")) 43 | ) 44 | 45 | expect_equal( 46 | (question_text(gss, "where")), 47 | c( 48 | "WHERE IS 1ST PERSON STAYING?", "WHERE IS 11TH PERSON (VISITOR) STAYING?", 49 | "WHERE IS 2ND PERSON STAYING?", "WHERE IS 3RD PERSON STAYING?", 50 | "WHERE IS 4TH PERSON STAYING?", "WHERE IS 5TH PERSON STAYING?", 51 | "WHERE IS 6TH PERSON STAYING?", "WHERE IS 7TH PERSON STAYING?" 52 | ) 53 | ) 54 | }) 55 | -------------------------------------------------------------------------------- /tests/testthat/test-01-essentials.R: -------------------------------------------------------------------------------- 1 | 2 | if (interactive()) library(testthat) 3 | 4 | tsv <- make_test_survey() 5 | 6 | 7 | 8 | test_that("Basic functionality", { 9 | res <- tsv[, "Q1"] 10 | expect_s3_class(res, "surveydata") 11 | expect_s3_class(res, "data.frame") 12 | expect_equal(ncol(res), 1) 13 | expect_equal(nrow(res), 4) 14 | 15 | res <- tsv[, "Q4"] 16 | expect_s3_class(res, "surveydata") 17 | expect_s3_class(res, "data.frame") 18 | expect_equal(ncol(res), 3) 19 | expect_equal(nrow(res), 4) 20 | 21 | vl <- varlabels(tsv) 22 | expect_type(vl, "character") 23 | expect_equal(length(vl), ncol(tsv)) 24 | expect_equal(names(vl), names(tsv)) 25 | 26 | ptn <- pattern(tsv) 27 | expect_type(ptn, "list") 28 | expect_equal(length(ptn), 2) 29 | expect_equal(ptn, list(sep = "_", exclude = "other")) 30 | 31 | ms <- membersurvey 32 | ms <- rm.pattern(ms) 33 | expect_null(pattern(ms)) 34 | 35 | q <- questions(tsv) 36 | expect_type(q, "character") 37 | expect_equal(q, c("id", "Q1", "Q4", "Q10", "crossbreak", "weight")) 38 | 39 | res <- which.q(tsv, "Q1") 40 | expect_equal(res, 2L) 41 | 42 | res <- which.q(tsv, "Q4") 43 | expect_equal(res, 3:5) 44 | 45 | expect_equal(question_text(tsv, "Q1"), "Question 1") 46 | expect_equal(question_text(tsv, "Q4"), paste("Question 4:", c("red", "green", "blue"))) 47 | 48 | expect_equal(question_text_common(tsv, "Q4"), "Question 4") 49 | expect_equal(question_text_unique(tsv, "Q4"), c("red", "green", "blue")) 50 | }) 51 | -------------------------------------------------------------------------------- /tests/testthat/test-01-surveydata.R: -------------------------------------------------------------------------------- 1 | # Unit tests for "surveydata" class 2 | # 3 | # Author: Andrie 4 | 5 | if (interactive()) library(testthat) 6 | 7 | tsv <- make_test_data() 8 | tsv_labels <- varlabels(tsv) 9 | 10 | 11 | 12 | test_that("as.surveydata and is.surveydata works as expected", { 13 | s <- as.surveydata(tsv) 14 | # expected_pattern <- c("^", "(_[[:digit:]])*(_.*)?$") 15 | expected_pattern <- list(sep = "_", exclude = "other") 16 | expect_s3_class(s, "surveydata") 17 | expect_s3_class(s, "data.frame") 18 | expect_true(is.surveydata(s)) 19 | expect_false(is.surveydata(tsv)) 20 | expect_equal(pattern(s), expected_pattern) 21 | 22 | # new_pattern <- c("", "new_pattern$") 23 | new_pattern <- list(sep = ":", exclude = "last") 24 | s <- as.surveydata(tsv, ptn = new_pattern) 25 | expect_s3_class(s, "surveydata") 26 | expect_true(is.surveydata(s)) 27 | expect_equal(pattern(s), new_pattern) 28 | }) 29 | 30 | test_that("Varlabel names are allocated correctly", { 31 | tdat <- tsv 32 | attributes(tdat)$variable.labels <- unname(attributes(tdat)$variable.labels) 33 | t <- as.surveydata(tsv) 34 | expect_equal(names(t), names(varlabels(t))) 35 | }) 36 | 37 | #------------------------------------------------------------------------------ 38 | 39 | test_that("Varlabel functions work as expected", { 40 | s <- as.surveydata(tsv) 41 | expect_equal(varlabels(s), tsv_labels) 42 | 43 | varlabels(s) <- 1:8 44 | expect_equal(varlabels(s), 1:8) 45 | 46 | varlabels(s)[3] <- 20 47 | expect_equal(varlabels(s), c(1:2, 20, 4:8)) 48 | 49 | s <- as.surveydata(tsv) 50 | varlabels(s)["crossbreak"] <- "New crossbreak" 51 | retn <- tsv_labels 52 | retn["crossbreak"] <- "New crossbreak" 53 | expect_equal(varlabels(s), retn) 54 | }) 55 | 56 | #------------------------------------------------------------------------------ 57 | 58 | test_that("Pattern functions work as expected", { 59 | pattern <- "-pattern-" 60 | s <- as.surveydata(tsv) 61 | attr(s, "pattern") <- pattern 62 | expect_equal(pattern(s), pattern) 63 | 64 | attr(s, "pattern") <- NULL 65 | expect_true(is.null(pattern(s))) 66 | pattern(s) <- pattern 67 | expect_equal(attr(s, "pattern"), pattern) 68 | }) 69 | 70 | test_that("Removing attributes work as expected", { 71 | s <- as.surveydata(tsv) 72 | 73 | t <- rm.attrs(s) 74 | expect_equal(varlabels(t), NULL) 75 | expect_equal(pattern(t), NULL) 76 | 77 | t <- as.data.frame(s, rm.pattern = TRUE) 78 | expect_equal(t, tsv) 79 | }) 80 | 81 | #------------------------------------------------------------------------------ 82 | 83 | test_that("Name_replace works as expected", { 84 | s <- as.surveydata(tsv) 85 | spat <- pattern(s) 86 | 87 | names(s) <- gsub("id", "RespID", names(s)) 88 | expect_equal(names(s)[1], "RespID") 89 | expect_equal(names(varlabels(s))[1], "RespID") 90 | expect_equal(pattern(s), spat) 91 | 92 | newpat <- c("X", "Y") 93 | s <- as.surveydata(tsv, ptn = newpat) 94 | 95 | names(s) <- gsub("id", "RespID", names(s)) 96 | expect_equal(names(s), c("RespID", names(s)[-1])) 97 | expect_equal(names(varlabels(s)), c("RespID", names(s)[-1])) 98 | expect_equal(pattern(s), newpat) 99 | }) 100 | 101 | #------------------------------------------------------------------------------ 102 | 103 | test_that("warnings are issued when names and varlabels mismatch", { 104 | s2 <- as.surveydata(tsv) 105 | varlabels(s2) <- varlabels(s2)[-1] 106 | expect_warning( 107 | is.surveydata(s2), 108 | c("varlabels must have same length as object") 109 | ) 110 | }) 111 | -------------------------------------------------------------------------------- /tests/testthat/test-02-whichq.R: -------------------------------------------------------------------------------- 1 | # Unit tests for "surveydata" class 2 | # 3 | # Author: Andrie 4 | if (interactive()) library(testthat) 5 | 6 | tsv <- make_test_data() 7 | tsv_labels <- varlabels(tsv) 8 | 9 | sdat2 <- make_test_data_2() 10 | 11 | rm.ca <- function(x) { 12 | class(x) <- class(x)[!grepl("surveydata", class(x))] 13 | rm.attrs(x) 14 | } 15 | 16 | #------------------------------------------------------------------------------ 17 | 18 | 19 | 20 | test_that("which.q returns correct question positions", { 21 | s <- as.surveydata(tsv, renameVarlabels = TRUE) 22 | expect_equal(which.q(s, c(1)), 1) 23 | expect_equal(which.q(s, c(4)), 4) 24 | expect_equal(which.q(s, c(-1)), -1) 25 | expect_equal(which.q(s, "Q1"), 2) 26 | expect_equal(which.q(s, "Q10"), 6) 27 | expect_equal(which.q(s, "Q4"), 3:5) 28 | expect_equal(which.q(s, "Q2"), integer(0)) 29 | 30 | expect_equal(which.q(s, c("Q1", "Q4")), c(2, 3:5)) 31 | expect_equal(which.q(s, c("Q1", "crossbreak")), c(2, 7)) 32 | expect_equal(which.q(s, c("Q4", "crossbreak2")), c(3:5, 8)) 33 | 34 | expect_equal(which.q(s, c(3, "crossbreak2")), c(3, 8)) 35 | }) 36 | 37 | #------------------------------------------------------------------------------ 38 | 39 | # context("which.q 2") 40 | 41 | test_that("which.q returns correct question positions", { 42 | s2 <- as.surveydata(sdat2, ptn = list(sep = "__", exclude = "ignore"), renameVarlabels = TRUE) 43 | expect_equal(which.q(s2, c(1)), 1) 44 | expect_equal(which.q(s2, c(4)), 4) 45 | expect_equal(which.q(s2, c(-1)), -1) 46 | expect_equal(which.q(s2, "Q1"), 2) 47 | expect_equal(which.q(s2, "Q10"), 7) 48 | expect_equal(which.q(s2, "Q4"), 3:5) 49 | expect_equal(which.q(s2, "Q2"), integer(0)) 50 | 51 | expect_equal(which.q(s2, c("Q1", "Q4")), c(2, 3:5)) 52 | expect_equal(which.q(s2, c("Q1", "crossbreak")), c(2, 8)) 53 | expect_equal(which.q(s2, c("Q4", "crossbreak2")), c(3:5, 9)) 54 | 55 | expect_equal(which.q(s2, c(3, "crossbreak2")), c(3, 9)) 56 | }) 57 | -------------------------------------------------------------------------------- /tests/testthat/test-03-extract.R: -------------------------------------------------------------------------------- 1 | # Unit tests for "surveydata" class 2 | # 3 | # Author: Andrie 4 | #------------------------------------------------------------------------------ 5 | 6 | { 7 | sdat <- data.frame( 8 | id = 1:4, 9 | Q1 = c("Yes", "No", "Yes", "Yes"), 10 | Q4_1 = c(1, 2, 1, 2), 11 | Q4_2 = c(3, 4, 4, 3), 12 | Q4_3 = c(5, 5, 6, 6), 13 | Q4_other = LETTERS[1:4], 14 | Q10 = factor(c("Male", "Female", "Female", "Male")), 15 | crossbreak = c("A", "A", "B", "B"), 16 | crossbreak2 = c("D", "E", "D", "E"), 17 | weight = c(0.9, 1.1, 0.8, 1.2) 18 | ) 19 | 20 | sdat_labels <- c( 21 | "RespID", 22 | "Question 1", 23 | "Question 4: red", "Question 4: green", "Question 4: blue", "Question 4: other", 24 | "Question 10", 25 | "crossbreak", 26 | "crossbreak2", 27 | "weight" 28 | ) 29 | names(sdat_labels) <- names(sdat) 30 | varlabels(sdat) <- sdat_labels 31 | } 32 | 33 | rm.ca <- function(x) { 34 | class(x) <- class(x)[!grepl("surveydata", class(x))] 35 | rm.attrs(x) 36 | } 37 | 38 | 39 | #------------------------------------------------------------------------------ 40 | 41 | 42 | 43 | test_that("`$` extracts correct columns", { 44 | s <- as.surveydata(sdat, renameVarlabels = TRUE) 45 | 46 | expect_equal(s$id, 1:4) 47 | expect_equal(s$Q4_1, c(1, 2, 1, 2)) 48 | expect_s3_class(s, "surveydata") 49 | }) 50 | 51 | 52 | 53 | 54 | #------------------------------------------------------------------------------ 55 | 56 | # context("Surveydata `[` simple extract") 57 | 58 | test_that("`[` simple extract returns surveydata object", { 59 | s <- as.surveydata(sdat, renameVarlabels = TRUE) 60 | # load_all(pkg) 61 | # which.q(s, "Q4") 62 | # x <- NULL 63 | # x <- s[2] 64 | # x 65 | # varlabels(x) 66 | # str(x) 67 | 68 | expect_s3_class(s[], "surveydata") 69 | expect_s3_class(s[, 2], "surveydata") 70 | expect_s3_class(s[1, ], "surveydata") 71 | expect_s3_class(s[2, 2], "surveydata") 72 | expect_s3_class(s[, "Q1"], "surveydata") 73 | expect_s3_class(s[, "Q4"], "surveydata") 74 | }) 75 | 76 | test_that("`[` simple extract returns correct data", { 77 | s <- as.surveydata(sdat, renameVarlabels = TRUE) 78 | 79 | expect_equal(s[], s) 80 | expect_equal(rm.ca(s[2, ]), rm.ca(sdat[2, ])) 81 | expect_equal(rm.ca(s[, 2]), rm.ca(sdat[, 2, drop = FALSE])) 82 | expect_equal(rm.ca(s[, "Q1"]), rm.ca(sdat[, 2, drop = FALSE])) 83 | expect_equal(rm.ca(s[, "Q4"]), rm.ca(sdat[, 3:5, drop = FALSE])) 84 | expect_equal(rm.ca(s[2, "Q4"]), rm.ca(sdat[2, 3:5, drop = FALSE])) 85 | expect_equal(rm.ca(s[1:2, "Q10"]), rm.ca(sdat[1:2, 7, drop = FALSE])) 86 | expect_equal(rm.ca(s[, "weight"]), rm.ca(sdat[, "weight", drop = FALSE])) 87 | }) 88 | 89 | test_that("`[` simple extract returns correct varlabels", { 90 | s <- as.surveydata(sdat, renameVarlabels = TRUE) 91 | 92 | expect_equal(varlabels(s[]), sdat_labels) 93 | expect_equal(varlabels(s[2]), sdat_labels[2]) 94 | expect_equal(varlabels(s[, 2]), sdat_labels[2]) 95 | expect_equal(varlabels(s[2:4, 5]), sdat_labels[5]) 96 | expect_equal(varlabels(s[, "Q1"]), sdat_labels[2]) 97 | expect_equal(varlabels(s[, "Q4"]), sdat_labels[3:5]) 98 | expect_equal(varlabels(s[2, "Q4"]), sdat_labels[3:5]) 99 | expect_equal(varlabels(s[2, "Q1"]), sdat_labels[2]) 100 | }) 101 | 102 | test_that("`[` simple extract with drop=TRUE returns vectors", { 103 | s <- as.surveydata(sdat, renameVarlabels = TRUE) 104 | 105 | expect_equal(rm.ca(s[, 2, drop = TRUE]), rm.ca(sdat[, 2, drop = TRUE])) 106 | expect_equal(rm.ca(s[, "Q1", drop = TRUE]), rm.ca(sdat[, 2, drop = TRUE])) 107 | expect_equal(rm.ca(s[, "Q4", drop = TRUE]), rm.ca(sdat[, 3:5, drop = TRUE])) 108 | expect_equal(rm.ca(s[2, "Q4", drop = TRUE]), rm.ca(sdat[2, 3:5, drop = TRUE])) 109 | expect_equal(rm.ca(s[1:2, "Q10", drop = TRUE]), rm.ca(sdat[1:2, 7, drop = TRUE])) 110 | expect_equal(rm.ca(s[, "weight", drop = TRUE]), rm.ca(sdat[, "weight", drop = TRUE])) 111 | }) 112 | 113 | 114 | #------------------------------------------------------------------------------ 115 | 116 | # context("Surveydata `[` complex extract") 117 | test_that("`[` complex extract works as expected", { 118 | s <- as.surveydata(sdat, renameVarlabels = TRUE) 119 | 120 | expect_equal(rm.ca(s[, c(1, 3)]), rm.ca(sdat[, c(1, 3)])) 121 | expect_equal(rm.ca(s[, -1]), rm.ca(sdat[, -1])) 122 | expect_equal(rm.ca(s[, c(1, "Q4")]), rm.ca(sdat[, c(1, 3:5)])) 123 | expect_equal(rm.ca(s[, c("Q1", "Q4")]), rm.ca(sdat[, c(2, 3:5)])) 124 | 125 | expect_equal(varlabels(s[, c(1, 3)]), sdat_labels[c(1, 3)]) 126 | expect_equal(varlabels(s[, -1]), sdat_labels[-1]) 127 | expect_equal(varlabels(s[, c(1, "Q4")]), sdat_labels[c(1, 3:5)]) 128 | expect_equal(varlabels(s[, c("Q1", "Q4")]), sdat_labels[c(2, 3:5)]) 129 | }) 130 | 131 | 132 | #------------------------------------------------------------------------------ 133 | 134 | test_that("`[` extract with logicals", { 135 | s <- as.surveydata(sdat, renameVarlabels = TRUE) 136 | 137 | i <- sdat$id == 1 138 | j <- grepl("Q4", names(s)) 139 | expect_equal(rm.ca(s[i, ]), rm.ca(sdat[i, ])) 140 | expect_equal(rm.ca(s[!i, ]), rm.ca(sdat[!i, ])) 141 | expect_equal(rm.ca(s[i, j]), rm.ca(sdat[i, j])) 142 | expect_equal(rm.ca(s[i, !j]), rm.ca(sdat[i, !j])) 143 | expect_equal(rm.ca(s[!i, j]), rm.ca(sdat[!i, j])) 144 | expect_equal(rm.ca(s[!i, j]), rm.ca(sdat[!i, j])) 145 | expect_equal(rm.ca(s[!i, !j]), rm.ca(sdat[!i, !j])) 146 | }) 147 | -------------------------------------------------------------------------------- /tests/testthat/test-03-replace.R: -------------------------------------------------------------------------------- 1 | # Unit tests for "surveydata" class 2 | # 3 | # Author: Andrie 4 | #------------------------------------------------------------------------------ 5 | 6 | { 7 | sdat <- data.frame( 8 | id = 1:4, 9 | Q1 = c("Yes", "No", "Yes", "Yes"), 10 | Q4_1 = c(1, 2, 1, 2), 11 | Q4_2 = c(3, 4, 4, 3), 12 | Q4_3 = c(5, 5, 6, 6), 13 | Q4_other = LETTERS[1:4], 14 | Q10 = factor(c("Male", "Female", "Female", "Male")), 15 | crossbreak = c("A", "A", "B", "B"), 16 | crossbreak2 = c("D", "E", "D", "E"), 17 | weight = c(0.9, 1.1, 0.8, 1.2) 18 | ) 19 | 20 | sdat_labels <- c( 21 | "RespID", 22 | "Question 1", 23 | "Question 4: red", "Question 4: green", "Question 4: blue", "Question 4: other", 24 | "Question 10", 25 | "crossbreak", 26 | "crossbreak2", 27 | "weight" 28 | ) 29 | names(sdat_labels) <- names(sdat) 30 | varlabels(sdat) <- sdat_labels 31 | } 32 | 33 | rm.ca <- function(x) { 34 | class(x) <- class(x)[!grepl("surveydata", class(x))] 35 | rm.attrs(x) 36 | } 37 | 38 | #------------------------------------------------------------------------------ 39 | 40 | 41 | 42 | test_that("`$<-` NULL removes column as well as varlabel", { 43 | s <- as.surveydata(sdat, renameVarlabels = TRUE) 44 | s$id <- NULL 45 | expect_true(is.na(match("id", names(s)))) 46 | expect_true(is.na(match("id", names(varlabels(s))))) 47 | expect_equal(names(s), names(sdat[-1])) 48 | expect_equal(names(varlabels(s)), names(sdat[-1])) 49 | expect_s3_class(s, "surveydata") 50 | }) 51 | 52 | test_that("`$<-` existing_name maintains correct varlabels", { 53 | s <- as.surveydata(sdat, renameVarlabels = TRUE) 54 | expect_equal(varlabels(sdat), varlabels(s)) 55 | s$Q4_1 <- 1:4 56 | expect_equal(varlabels(sdat), varlabels(s)) 57 | }) 58 | 59 | test_that("`$<-` newname inserts column and new varlabel", { 60 | s <- as.surveydata(sdat, renameVarlabels = TRUE) 61 | s$newid <- 101:104 62 | expect_equal(s$newid, 101:104) 63 | expect_true(all(s$newid == 101:104)) 64 | expect_false(is.na(match("newid", names(varlabels(s))))) 65 | expect_s3_class(s, "surveydata") 66 | }) 67 | 68 | #------------------------------------------------------------------------------ 69 | 70 | test_that("`[<-` NULL removes column as well as varlabel", { 71 | s <- as.surveydata(sdat, renameVarlabels = TRUE) 72 | s[, "id"] <- NULL 73 | # browser() 74 | expect_true(is.na(match("id", names(s)))) 75 | expect_true(is.na(match("id", names(varlabels(s))))) 76 | expect_equal(names(s), names(sdat[-1])) 77 | expect_equal(names(varlabels(s)), names(sdat[-1])) 78 | expect_s3_class(s, "surveydata") 79 | }) 80 | 81 | test_that("`[<-` existing_name maintains correct varlabels", { 82 | s <- as.surveydata(sdat, renameVarlabels = TRUE) 83 | expect_equal(varlabels(sdat), varlabels(s)) 84 | s[, "Q4_1"] <- 1:4 85 | expect_equal(varlabels(sdat), varlabels(s)) 86 | }) 87 | 88 | #------------------------------------------------------------------------------ 89 | 90 | test_that("`[<-` newname inserts column and new varlabel", { 91 | s <- as.surveydata(sdat, renameVarlabels = TRUE) 92 | s["newid"] <- 101:104 93 | expect_equal(s$newid, 101:104) 94 | expect_false(is.na(match("newid", names(varlabels(s))))) 95 | expect_s3_class(s, "surveydata") 96 | }) 97 | -------------------------------------------------------------------------------- /tests/testthat/test-03-strings.R: -------------------------------------------------------------------------------- 1 | 2 | 3 | test_that("strCommonUnique works", { 4 | str_common <- function(x) strCommonUnique(x)$common 5 | str_unique <- function(x) strCommonUnique(x)$unique 6 | 7 | x <- "Q" 8 | expect_type(str_common(x), "character") 9 | expect_type(str_unique(x), "character") 10 | 11 | expect_equal(str_common(x), "Q") 12 | expect_equal(str_unique(x), "") 13 | 14 | x <- c("Q", "Q1") 15 | expect_equal(str_common(x), "Q") 16 | expect_equal(str_unique(x), c("", "1")) 17 | 18 | x <- c("Q1", "Q1") 19 | expect_equal(str_common(x), "Q1") 20 | expect_equal(str_unique(x), c("", "")) 21 | 22 | x <- c("Q1", "Q2") 23 | expect_equal(str_common(x), "Q") 24 | expect_equal(str_unique(x), c("1", "2")) 25 | 26 | x <- c("1", "2", "3") 27 | expect_equal(str_common(x), "") 28 | expect_equal(str_unique(x), c("1", "2", "3")) 29 | 30 | x <- c("Q_1", "Q_2", "Q_3") 31 | expect_equal(str_common(x), "Q_") 32 | expect_equal(str_unique(x), c("1", "2", "3")) 33 | 34 | x <- c("X_1", "Z_1", "Z_1") 35 | expect_equal(str_common(x), "") 36 | expect_equal(str_unique(x), c("X_1", "Z_1", "Z_1")) 37 | }) 38 | -------------------------------------------------------------------------------- /tests/testthat/test-04-merge.R: -------------------------------------------------------------------------------- 1 | # Unit tests for "surveydata" class 2 | # 3 | # Author: Andrie 4 | #------------------------------------------------------------------------------ 5 | 6 | { 7 | sdat <- data.frame( 8 | id = 1:4, 9 | Q1 = c("Yes", "No", "Yes", "Yes"), 10 | Q4_1 = c(1, 2, 1, 2), 11 | Q4_2 = c(3, 4, 4, 3), 12 | Q4_3 = c(5, 5, 6, 6), 13 | Q10 = factor(c("Male", "Female", "Female", "Male")), 14 | crossbreak = c("A", "A", "B", "B"), 15 | crossbreak2 = c("D", "E", "D", "E"), 16 | weight = c(0.9, 1.1, 0.8, 1.2) 17 | ) 18 | 19 | sdat_labels <- c( 20 | "RespID", 21 | "Question 1", 22 | "Question 4: red", "Question 4: green", "Question 4: blue", 23 | "Question 10", 24 | "crossbreak", 25 | "crossbreak2", 26 | "weight" 27 | ) 28 | names(sdat_labels) <- names(sdat) 29 | varlabels(sdat) <- sdat_labels 30 | sdat <- as.surveydata(sdat) 31 | } 32 | 33 | 34 | 35 | 36 | 37 | test_that("Merge of surveydata objects work as expected", { 38 | sdat2 <- data.frame( 39 | id = 5:6, 40 | Q1 = c("Yes", "No"), 41 | Q4_1 = c(5, 6), 42 | Q4_2 = c(7, 8), 43 | Q4_3 = c(9, 10), 44 | crossbreak = c("U", "V"), 45 | crossbreak2 = c("X", "Y"), 46 | weight = c(0.95, 1.05) 47 | ) 48 | varlabels(sdat2) <- names(sdat2) 49 | 50 | s1 <- as.surveydata(sdat, renameVarlabels = TRUE) 51 | s2 <- as.surveydata(sdat2, ptn = c("_", ""), renameVarlabels = TRUE) 52 | expect_warning( 53 | sm <- merge(s1, s2, all = TRUE), 54 | "In merge of surveydata objects, patterns of objects differ" 55 | ) 56 | expect_s3_class(sm, "surveydata") 57 | expect_equal(nrow(sm), 6) 58 | expect_equal(pattern(s1), pattern(sm)) 59 | }) 60 | 61 | 62 | test_that("cbind of surveydata objects work as expected", { 63 | sdat1 <- sdat[, c("id", "Q1", "Q4", "Q10")] 64 | sdat2 <- sdat[, c("crossbreak", "crossbreak2", "weight")] 65 | 66 | expect_equal( 67 | cbind(sdat1, sdat2), 68 | sdat 69 | ) 70 | }) 71 | -------------------------------------------------------------------------------- /tests/testthat/test-05-questions.R: -------------------------------------------------------------------------------- 1 | # Unit tests for "surveydata" class 2 | # 3 | # Author: Andrie 4 | #------------------------------------------------------------------------------ 5 | 6 | if (interactive()) library(testthat) 7 | 8 | { 9 | sdat <- data.frame( 10 | id = 1:4, 11 | Q1 = c("Yes", "No", "Yes", "Yes"), 12 | Q4_1 = c(1, 2, 1, 2), 13 | Q4_2 = c(3, 4, 4, 3), 14 | Q4_3 = c(5, 5, 6, 6), 15 | Q4_other = c(NA, NA, "some text", NA), 16 | Q10 = factor(c("Male", "Female", "Female", "Male")), 17 | crossbreak = c("A", "A", "B", "B"), 18 | crossbreak2 = c("D", "E", "D", "E"), 19 | weight = c(0.9, 1.1, 0.8, 1.2) 20 | ) 21 | 22 | varlabels(sdat) <- setNames( 23 | c( 24 | "RespID", 25 | "Question 1", 26 | "Question 4: red", "Question 4: green", "Question 4: blue", 27 | "Question 4: Other", 28 | "Question 10", 29 | "crossbreak", 30 | "crossbreak2", 31 | "weight" 32 | ), 33 | names(sdat) 34 | ) 35 | } 36 | 37 | 38 | #------------------------------------------------------------------------------ 39 | 40 | 41 | 42 | test_that("question_text, qTextCommon and qTextUnique work as expected", { 43 | s <- as.surveydata(sdat) 44 | expect_equal(question_text(s, "Q1"), "Question 1") 45 | expect_equal(question_text(s, "Q4"), c("Question 4: red", "Question 4: green", "Question 4: blue")) 46 | expect_equal(question_text(s, "Q10"), "Question 10") 47 | expect_equal(question_text(s, "Q99"), character(0)) 48 | 49 | expect_equal(question_text_common(s, "Q4"), "Question 4") 50 | expect_equal(question_text_unique(s, "Q4"), c("red", "green", "blue")) 51 | 52 | expect_equal(questions(s), c( 53 | "id", 54 | "Q1", 55 | "Q4", 56 | "Q4_other", 57 | "Q10", 58 | "crossbreak", 59 | "crossbreak2", 60 | "weight" 61 | )) 62 | 63 | expect_equal( 64 | question_text(s), 65 | sapply(questions(s), question_text, x = s) 66 | ) 67 | }) 68 | 69 | #------------------------------------------------------------------------------ 70 | 71 | { 72 | sdat2 <- data.frame( 73 | id = 1:4, 74 | Q1 = c("Yes", "No", "Yes", "Yes"), 75 | Q4__1 = c(1, 2, 1, 2), 76 | Q4__2 = c(3, 4, 4, 3), 77 | Q4__3 = c(5, 5, 6, 6), 78 | Q4__ignore = c(NA, NA, "some text", NA), 79 | Q10 = factor(c("Male", "Female", "Female", "Male")), 80 | crossbreak = c("A", "A", "B", "B"), 81 | crossbreak2 = c("D", "E", "D", "E"), 82 | weight = c(0.9, 1.1, 0.8, 1.2), 83 | check.names = FALSE 84 | ) 85 | 86 | varlabels(sdat2) <- c( 87 | "RespID", 88 | "Question 1", 89 | "Question 4: red", "Question 4: green", "Question 4: blue", 90 | "Question 4: Other", 91 | "Question 10", 92 | "crossbreak", 93 | "crossbreak2", 94 | "weight" 95 | ) 96 | } 97 | 98 | # context("Questions 2") 99 | test_that("question_text, qTextCommon and qTextUnique work as expected", { 100 | s2 <- as.surveydata(sdat2, sep = "__", exclude = "ignore", renameVarlabels = TRUE) 101 | expect_equal(question_text(s2, "Q1"), "Question 1") 102 | expect_equal(question_text(s2, "Q4"), c("Question 4: red", "Question 4: green", "Question 4: blue")) 103 | expect_equal(question_text(s2, "Q10"), "Question 10") 104 | expect_equal(question_text(s2, "Q99"), character(0)) 105 | 106 | expect_equal(question_text_common(s2, "Q4"), "Question 4") 107 | expect_equal(question_text_unique(s2, "Q4"), c("red", "green", "blue")) 108 | 109 | expect_equal(questions(s2), c( 110 | "id", 111 | "Q1", 112 | "Q4", 113 | "Q4__ignore", 114 | "Q10", 115 | "crossbreak", 116 | "crossbreak2", 117 | "weight" 118 | )) 119 | }) 120 | 121 | 122 | #------------------------------------------------------------------------------ 123 | 124 | # context("split_common_unique") 125 | test_that("split_common_unique works as expected", { 126 | test <- c("Email (Please tell us)", "Phone (Please tell us)") 127 | exp <- list(common = "Please tell us", unique = c("Email", "Phone")) 128 | expect_equal(split_common_unique(test), exp) 129 | 130 | test <- c("What is your choice?: Email", "What is your choice?: Phone") 131 | exp <- list(common = "What is your choice?", unique = c("Email", "Phone")) 132 | expect_equal(split_common_unique(test), exp) 133 | 134 | test <- c("What is your choice?:Email", "What is your choice?:Phone") 135 | exp <- list(common = "What is your choice?", unique = c("Email", "Phone")) 136 | expect_equal(split_common_unique(test), exp) 137 | 138 | test <- c("Q3(001)Email", "Q3(001)Phone") 139 | exp <- list(common = "Q3", unique = c("Email", "Phone")) 140 | expect_equal(split_common_unique(test), exp) 141 | 142 | test <- c("Q3(001) Email", "Q3(001) Phone") 143 | exp <- list(common = "Q3", unique = c("Email", "Phone")) 144 | expect_equal(split_common_unique(test), exp) 145 | 146 | test <- c("Q3[001] Email", "Q3[001] Phone") 147 | exp <- list(common = "Q3", unique = c("Email", "Phone")) 148 | expect_equal(split_common_unique(test), exp) 149 | 150 | test <- c("Q3[01]Email", "Q3[01]Phone") 151 | exp <- list(common = "Q3", unique = c("Email", "Phone")) 152 | expect_equal(split_common_unique(test), exp) 153 | 154 | test <- c("[Email]What is your choice?", "[Phone]What is your choice?") 155 | exp <- list(common = "What is your choice?", unique = c("Email", "Phone")) 156 | expect_equal(split_common_unique(test), exp) 157 | 158 | test <- c("What is your choice? [Email]", "What is your choice? [Phone]") 159 | exp <- list(common = "What is your choice?", unique = c("Email", "Phone")) 160 | expect_equal(split_common_unique(test), exp) 161 | 162 | test <- c( 163 | "Question (answer 1 (with embedded parens))", 164 | "Question (answer 2 without embedded parens)" 165 | ) 166 | exp <- list(common = "Question", unique = c( 167 | "answer 1 (with embedded parens)", 168 | "answer 2 without embedded parens" 169 | )) 170 | expect_equal(split_common_unique(test), exp) 171 | 172 | test <- c("Q_1", "Q_2") 173 | exp <- list(common = "Q_", unique = c("1", "2")) 174 | expect_equal(split_common_unique(test), exp) 175 | }) 176 | -------------------------------------------------------------------------------- /tests/testthat/test-06-encoding.R: -------------------------------------------------------------------------------- 1 | # Unit tests using package testthat 2 | # 3 | # Author: Andrie 4 | #------------------------------------------------------------------------------ 5 | 6 | 7 | 8 | test_that("encoding functions work as expected", { 9 | expect_equal(encToInt("\\xfa"), c(92, 120, 102, 97)) 10 | # expect_equal(intToEnc(8212), "—") 11 | expect_equal(intToEnc(encToInt("\\xfa")), "\\xfa") 12 | expect_equal(encToInt(intToEnc(250)), 250) 13 | 14 | # print(encToInt(intToEnc(8212))) 15 | # print(intToEnc(encToInt("\\xfa"))) 16 | }) 17 | -------------------------------------------------------------------------------- /tests/testthat/test-08-tools.R: -------------------------------------------------------------------------------- 1 | # 2 | # Author: andrie 3 | ############################################################################### 4 | 5 | 6 | 7 | test_that("dropout calculation is correct", { 8 | rest <- setNames(c(215, 35), c("id", "Q23_other")) 9 | expect_equal(dropout(membersurvey[-(108:109)]), rest) 10 | }) 11 | -------------------------------------------------------------------------------- /tests/testthat/test-09-dplyr-verbs.R: -------------------------------------------------------------------------------- 1 | if (interactive()) library(testthat) 2 | 3 | 4 | test_that("dplyr verbs retain surveydata class", { 5 | skip_if_not_installed("dplyr") 6 | require(dplyr, quietly = TRUE, warn.conflicts = FALSE) 7 | 8 | expect_warning(membersurvey %>% as.tbl.surveydata(), "deprecated") 9 | 10 | expect_s3_class(membersurvey %>% as_tibble(), "surveydata") 11 | expect_s3_class(membersurvey %>% as_tibble() %>% mutate(id = 1), "surveydata") 12 | expect_s3_class(membersurvey %>% as_tibble() %>% filter(Q2 == 2009), "surveydata") 13 | expect_s3_class(membersurvey %>% as_tibble() %>% slice(1), "surveydata") 14 | expect_s3_class(membersurvey %>% as_tibble() %>% arrange(Q2), "surveydata") 15 | expect_s3_class(membersurvey %>% as_tibble() %>% select(Q2), "surveydata") 16 | expect_s3_class(membersurvey %>% as_tibble() %>% summarise(n = n()), "surveydata") 17 | expect_s3_class(membersurvey %>% as_tibble() %>% summarize(n = n()), "surveydata") 18 | 19 | 20 | }) 21 | -------------------------------------------------------------------------------- /tests/testthat/test-10-cleandata.R: -------------------------------------------------------------------------------- 1 | if (interactive()) library(testthat) 2 | 3 | 4 | test_that("cleandata functions work", { 5 | expect_false( 6 | any(sapply(membersurvey, has_dont_know)) 7 | ) 8 | expect_equal( 9 | membersurvey$Q2, 10 | remove_dont_know(membersurvey$Q2) 11 | ) 12 | expect_equal( 13 | membersurvey, 14 | remove_all_dont_know(membersurvey) 15 | ) 16 | expect_equal( 17 | levels(remove_dont_know(membersurvey$Q2, dk = "Before 2002")), 18 | as.character(2003:2011) 19 | ) 20 | expect_false( 21 | leveltest_r(membersurvey) 22 | ) 23 | expect_s3_class(fix_levels_01(membersurvey), "surveydata") 24 | }) 25 | 26 | 27 | test_that("deprecated functions return warnings", { 28 | expect_warning(hasDK(membersurvey["id"])) 29 | 30 | expect_warning(removeAllDK(membersurvey, message = FALSE)) 31 | expect_warning(removeDK(membersurvey$Q2, dk = "Before 2002")) 32 | expect_warning(leveltestR(membersurvey)) 33 | expect_warning(fixLevels01(membersurvey)) 34 | }) 35 | -------------------------------------------------------------------------------- /tests/testthat/test-11-encoding.R: -------------------------------------------------------------------------------- 1 | if (interactive()) library(testthat) 2 | 3 | 4 | test_that("encoding functions work", { 5 | skip_on_os(c("mac", "linux", "solaris")) 6 | 7 | expect_equal(encToInt("\\xfa", encoding = "ISO8859-1"), c(92L, 120L, 102L, 97L)) 8 | expect_equal(intToEnc(8212, "ISO8859-1"), "-") 9 | expect_equal(intToEnc(encToInt("\\xfa", encoding = "ISO8859-1"), encoding = "ISO8859-1"), "\\xfa") 10 | expect_equal(encToInt(intToEnc(8212, encoding = "UTF-8"), encoding = "UTF-8"), 8212) 11 | 12 | test <- paste0( 13 | intToEnc(194, encoding = "UTF-8"), 14 | intToEnc(128, encoding = "UTF-8"), 15 | intToEnc(226, encoding = "UTF-8"), 16 | intToEnc(147, encoding = "UTF-8"), 17 | collapse = "" 18 | ) 19 | expect_equal(fix_common_encoding_problems(test, encoding = "UTF-8"), "-") 20 | }) 21 | -------------------------------------------------------------------------------- /tests/testthat/test-12-plots.R: -------------------------------------------------------------------------------- 1 | if (interactive()) library(testthat) 2 | 3 | 4 | test_that("plotting functions return plot objects", { 5 | p <- survey_plot_question(membersurvey, "Q2") 6 | expect_s3_class(p, "ggplot") 7 | 8 | p <- survey_plot_yes_no(membersurvey, "Q2") 9 | expect_s3_class(p, "ggplot") 10 | 11 | p <- survey_plot_satisfaction(membersurvey, "Q14") 12 | expect_s3_class(p, "ggplot") 13 | }) 14 | -------------------------------------------------------------------------------- /tests/testthat/test-13-opentext.R: -------------------------------------------------------------------------------- 1 | if (interactive()) library(testthat) 2 | 3 | 4 | test_that("converts free text to DT object", { 5 | p <- as_opentext_datatable(membersurvey, "Q33") 6 | expect_s3_class(p, "datatables") 7 | expect_s3_class(p, "htmlwidget") 8 | 9 | p <- print_opentext(membersurvey, "Q33", cat = FALSE) 10 | expect_type(p, "character") 11 | }) 12 | -------------------------------------------------------------------------------- /vignettes/surveydata.R: -------------------------------------------------------------------------------- 1 | ## ----options, echo=FALSE------------------------------------------------- 2 | # from https://stackoverflow.com/questions/23114654/knitr-output-hook-with-an-output-lines-option-that-works-like-echo-26 3 | library(knitr) 4 | hook_output <- knit_hooks$get("output") 5 | knit_hooks$set(output = function(x, options) { 6 | lines <- options$output.lines 7 | if (is.null(lines)) { 8 | return(hook_output(x, options)) # pass to default hook 9 | } 10 | x <- unlist(strsplit(x, "\n")) 11 | more <- "..." 12 | if (length(lines)==1) { # first n lines 13 | if (length(x) > lines) { 14 | # truncate the output, but add .... 15 | x <- c(head(x, lines), more) 16 | } 17 | } else { 18 | x <- c(if (abs(lines[1])>1) more else NULL, 19 | x[lines], 20 | if (length(x)>lines[abs(length(lines))]) more else NULL 21 | ) 22 | } 23 | # paste these lines together 24 | x <- paste(c(x, ""), collapse = "\n") 25 | hook_output(x, options) 26 | }) 27 | 28 | ## ----load, message=FALSE------------------------------------------------- 29 | library(surveydata) 30 | library(dplyr) 31 | 32 | ## ----motivation, output.lines = 14--------------------------------------- 33 | sv <- membersurvey %>% as_tbl() 34 | sv 35 | 36 | ## ----motivation-q2------------------------------------------------------- 37 | sv[, "Q2"] 38 | 39 | ## ----motivation-q1------------------------------------------------------- 40 | sv[, "Q2"] 41 | 42 | ## ----Setup--------------------------------------------------------------- 43 | library(surveydata) 44 | 45 | ## ----sample-data--------------------------------------------------------- 46 | 47 | sdat <- data.frame( 48 | id = 1:4, 49 | Q1 = c("Yes", "No", "Yes", "Yes"), 50 | Q4_1 = c(1, 2, 1, 2), 51 | Q4_2 = c(3, 4, 4, 3), 52 | Q4_3 = c(5, 5, 6, 6), 53 | Q10 = factor(c("Male", "Female", "Female", "Male")), 54 | crossbreak = c("A", "A", "B", "B"), 55 | weight = c(0.9, 1.1, 0.8, 1.2) 56 | ) 57 | 58 | 59 | ## ----varlabels----------------------------------------------------------- 60 | 61 | varlabels(sdat) <- c( 62 | "RespID", 63 | "Question 1", 64 | "Question 4: red", "Question 4: green", "Question 4: blue", 65 | "Question 10", 66 | "crossbreak", 67 | "weight" 68 | ) 69 | 70 | ## ----init---------------------------------------------------------------- 71 | sv <- as.surveydata(sdat, renameVarlabels = TRUE) 72 | 73 | ## ----extract------------------------------------------------------------- 74 | sv[, "Q1"] 75 | sv[, "Q4"] 76 | 77 | ## ----attributes---------------------------------------------------------- 78 | 79 | varlabels(sv) 80 | pattern(sv) 81 | 82 | ## ----questions----------------------------------------------------------- 83 | questions(sv) 84 | which.q(sv, "Q1") 85 | which.q(sv, "Q4") 86 | 87 | ## ----question_text------------------------------------------------------- 88 | question_text(sv, "Q1") 89 | question_text(sv, "Q4") 90 | 91 | ## ----qTextCommon--------------------------------------------------------- 92 | question_text_common(sv, "Q4") 93 | 94 | ## ----qTextUnique--------------------------------------------------------- 95 | question_text_unique(sv, "Q4") 96 | 97 | -------------------------------------------------------------------------------- /vignettes/surveydata.Rmd: -------------------------------------------------------------------------------- 1 | --- 2 | title: "Introduction to the surveydata package." 3 | author: "Andrie de Vries" 4 | date: "`r Sys.Date()`" 5 | output: rmarkdown::html_vignette 6 | vignette: > 7 | %\VignetteIndexEntry{Introduction to the surveydata package.} 8 | %\VignetteEngine{knitr::rmarkdown} 9 | %\VignetteEncoding{UTF-8} 10 | --- 11 | 12 | 13 | ```{r, child = rprojroot::find_package_root_file("inst/vignette_child/child.Rmd")} 14 | ``` 15 | -------------------------------------------------------------------------------- /vignettes/surveydata.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 | 10 | 11 | 12 | 13 | 14 | 15 | 16 | 17 | Introduction to the surveydata package. 18 | 19 | 20 | 21 | 22 | 86 | 107 | 108 | 109 | 110 | 293 | 294 | 295 | 296 | 297 | 298 | 299 | 300 | 301 |

Introduction to the surveydata package.

302 |

Andrie de Vries

303 |

2019-01-24

304 | 305 | 306 | 307 |

The surveydata package makes it easy to work with typical survey data that originated in SPSS or other formats.

308 |
309 |

Motivation

310 |

Specifically, the package makes it easy question text (metadata) with the data itself.

311 |

To track the questions of a survey, you have two options:

312 |
    313 |
  • Keep the data in a data frame, and keep a separate list of the questions
    • 314 |
  • Keep the questions as an attribute of the data frame
    • 315 |
316 |

Neither of these options are ideal, since any subsetting of the survey data means you must keep track of the question metadata separately.

317 |

This package solves the problem by creating a new class, surveydata, and keeping the questions as an attribute of this class. Whenever you do a subsetting operation, the metadata stays intact.

318 |

In addition, the metadata knows if a question consists of a single column, or multiple columns. When doing subsetting on the question name, the resulting object can be either a single column or multiple columns.

319 | 321 | 323 | 
## # A tibble: 215 x 109
324 | ##       id  Q1_1  Q1_2 Q2     Q3_1  Q3_2  Q3_3  Q3_4  Q3_5  Q3_6  Q3_7  Q3_8 
325 | ##    <dbl> <dbl> <dbl> <ord>  <fct> <fct> <fct> <fct> <fct> <fct> <fct> <fct>
326 | ##  1     3     8   2   2009   No    No    No    No    No    No    No    No   
327 | ##  2     5    35  12   Befor~ Yes   No    No    No    No    No    No    No   
328 | ##  3     6    34  12   Befor~ Yes   Yes   No    No    No    Yes   No    No   
329 | ##  4    11    20   9   2010   No    No    No    No    No    No    No    No   
330 | ##  5    13    20   3   2010   No    No    No    No    No    No    No    No   
331 | ##  6    15    36  20   Befor~ No    Yes   No    No    No    No    No    No   
332 | ##  7    21    12   2.5 2009   Yes   No    No    No    No    Yes   Yes   No   
333 | ##  8    22    11   0.5 2011   Yes   Yes   Yes   Yes   Yes   No    No    No   
334 | ##  9    23    18   3   2008   Yes   Yes   Yes   Yes   Yes   Yes   No    No   
335 | ## 10    25    24   8   2006   No    No    No    Yes   Yes   Yes   No    No   
336 | ## # ... with 205 more rows, and 97 more variables: Q3_9 <fct>, Q3_10 <fct>,
337 | ...
338 |

Notice from this summary that Question 2 has two columns, i.e. Q2_1 and Q2_2. You can extract both these columns by simply referring to Q2:

339 | 340 | 
## # A tibble: 215 x 1
341 | ##    Q2         
342 | ##    <ord>      
343 | ##  1 2009       
344 | ##  2 Before 2002
345 | ##  3 Before 2002
346 | ##  4 2010       
347 | ##  5 2010       
348 | ##  6 Before 2002
349 | ##  7 2009       
350 | ##  8 2011       
351 | ##  9 2008       
352 | ## 10 2006       
353 | ## # ... with 205 more rows
354 |

However, the subset of Q1 returns only a single column:

355 | 356 | 
## # A tibble: 215 x 1
357 | ##    Q2         
358 | ##    <ord>      
359 | ##  1 2009       
360 | ##  2 Before 2002
361 | ##  3 Before 2002
362 | ##  4 2010       
363 | ##  5 2010       
364 | ##  6 Before 2002
365 | ##  7 2009       
366 | ##  8 2011       
367 | ##  9 2008       
368 | ## 10 2006       
369 | ## # ... with 205 more rows
370 |

Note that in both cases the surveydata object doesn’t return a vector - subsetting a surveydata object always returns a surveydata object.

371 |
372 |
373 |

About surveydata objects

374 |

A surveydata object consists of:

375 |
    376 |

  • A data frame with a row for each respondent and a column for each question. Column names are typically names in the pattern Q1, Q2_1, Q2_2, Q3 - where underscores separate the sub-questions when these originated in a grid (array) of questions.

    • 377 |

  • Question metadata gets stored in the `{variable.labels} attribute of the data frame. This typically contains the original questionnaire text for each question.

    • 378 |

  • Information about the sub-question separator (typically an underscore) is stored in the patterns attribute.

    • 379 |
380 |

Data processing a survey file can be tricky, since the standard methods for dealing with data frames does not conserve the variable.labels attribute. The surveydata package defines a surveydata class and the following methods that knows how to deal with the variable.labels attribute:

381 |
    382 |
  • as.surveydata
    • 383 |
  • [.surveydata
    • 384 |
  • [<-.surveydata
    • 385 |
  • $.surveydata
    • 386 |
  • $<-.surveydata
    • 387 |
  • merge.surveydata
    • 388 |
389 |

In addition, surveydata defines the following convenient methods for extracting and working with the variable labels:

390 |
    391 |
  • varlabels
    • 392 |
  • varlabels<-
    • 393 |
394 |
395 |
396 |

Defining a surveydata object

397 |

First load the surveydata package.

398 | 399 |

Next, create sample data. A data frame is the ideal data structure for survey data, and the convention is that data for each respondent is stored in the rows, while each column represents answers to a specific question.

400 | 410 |

The survey metadata consists of the questionnaire text. For example, this can be represented by a character vector, with an element for each question.

411 |

To assign this metadata to the survey data, use the varlabels() function. This function assigns the questionnaire text to the variable.labels attribute of the data frame.

412 | 420 |

Finally, create the surveydata object. To do this, call the as.surveydata() function. The argument renameVarlabels controls whether the varlabels get renamed with the same names as the data. This is an essential step, and ensures that the question text remains in synch with the column names.

421 | 422 |
423 |
424 |

Extracting specific questions

425 |

It is easy to extract specific questions with the [ operator. This works very similar to extraction of data frames. However, there are two important differences:

426 |
    427 |
  • The extraction operators will always return a surveydata object, even if only a single column is returned. This is different from the behaviour of data frames, where a single column is simplified to a vector.
    • 428 |
  • Extracting a question with multiple sub-questions, e.g. “Q4” returns multiple columns
    • 429 |
430 | 431 | 
##    Q1
432 | ## 1 Yes
433 | ## 2  No
434 | ## 3 Yes
435 | ## 4 Yes
436 | 437 | 
##   Q4_1 Q4_2 Q4_3
438 | ## 1    1    3    5
439 | ## 2    2    4    5
440 | ## 3    1    4    6
441 | ## 4    2    3    6
442 |

The extraction makes use of the underlying metadata, contained in the varlabels and pattern attributes:

443 | 444 | 
##                  id                  Q1                Q4_1 
445 | ##            "RespID"        "Question 1"   "Question 4: red" 
446 | ##                Q4_2                Q4_3                 Q10 
447 | ## "Question 4: green"  "Question 4: blue"       "Question 10" 
448 | ##          crossbreak              weight 
449 | ##        "crossbreak"            "weight"
450 | 451 | 
## $sep
452 | ## [1] "_"
453 | ## 
454 | ## $exclude
455 | ## [1] "other"
456 |
457 |
458 |

Working with question columns

459 |

It is easy to query the surveydata object to find out which questions it contains, as well as which columns store the data for those questions.

460 | 461 | 
## [1] "id"         "Q1"         "Q4"         "Q10"        "crossbreak"
462 | ## [6] "weight"
463 | 464 | 
## [1] 2
465 | 466 | 
## [1] 3 4 5
467 |
468 |
469 |

Reading the questionnaire text

470 |

The function question_text() gives access to the questionnaire text.

471 | 472 | 
## [1] "Question 1"
473 | 474 | 
## [1] "Question 4: red"   "Question 4: green" "Question 4: blue"
475 |
476 |

Getting the common question text

477 |

Use question_text_common() to retrieve the common text, i.e. the question itself:

478 | 479 | 
## [1] "Question 4"
480 |
481 |
482 |

Getting the unique question text

483 |

And use question_text_unique() to retrieve the unique part of the question, i.e. the sub-questions:

484 | 485 | 
## [1] "red"   "green" "blue"
486 |
487 |
488 |
489 |

Using surveydata with dplyr

490 |

The surveydata object knows how to deal with the following dplyr verbs:

491 |
    492 |
  • select
    • 493 |
  • filter
    • 494 |
  • mutate
    • 495 |
  • arrange
    • 496 |
  • summarize
    • 497 |
498 |

In every case the resulting object will also be of class surveydata.

499 |
500 |
501 |

Summary

502 |

The surveydata object can make it much easier to work with survey data.

503 |
504 | 505 | 506 | 507 | 508 | 516 | 517 | 518 | 519 | --------------------------------------------------------------------------------