├── .Rbuildignore ├── .gitattributes ├── .github ├── .gitignore └── workflows │ ├── R-CMD-check.yaml │ ├── pkgdown.yaml │ └── rhub.yaml ├── .gitignore ├── .travis.yml ├── .zenodo.json ├── CODE_OF_CONDUCT.md ├── DESCRIPTION ├── LICENSE ├── LICENSE.md ├── NAMESPACE ├── NEWS.md ├── R ├── add_dv.R ├── add_ranef.R ├── cell_combos.R ├── check_design.R ├── check_mixed_design.R ├── codebook.R ├── codebook_interactive.R ├── contrasts.R ├── convert_param.R ├── cormat.R ├── distribution_convertors.R ├── faceratings.R ├── faux-package.R ├── faux_options.R ├── fix_name_labels.R ├── get_coefs.R ├── get_design_long.R ├── get_params.R ├── getcols.R ├── interactive.R ├── json_design.R ├── long2wide.R ├── make_id.R ├── messages.R ├── messy.R ├── nested_list.R ├── norta.R ├── plot_design.R ├── readline_check.R ├── rnorm_multi.R ├── rnorm_pre.R ├── sim_design.R ├── sim_df.R ├── sim_joint_dist.R ├── sim_mixed_cc.R ├── sim_mixed_df.R ├── utils-pipe.R ├── wide2long.R └── zzz.R ├── README.Rmd ├── README.html ├── README.md ├── codecov.yml ├── cran-comments.md ├── data-raw ├── faceratings.R ├── london_faces_info.csv └── london_faces_ratings.csv ├── data ├── faceratings.rda └── fr4.rda ├── faux.Rproj ├── figure ├── plot-design-1.png ├── plot-iris-sim-1.png └── plot-sim-design-1.png ├── inst ├── CITATION └── faux_hex.png ├── man ├── OR.Rd ├── add_between.Rd ├── add_contrast.Rd ├── add_random.Rd ├── add_ranef.Rd ├── add_recode.Rd ├── add_within.Rd ├── average_r2tau_0.Rd ├── beta2norm.Rd ├── binom2norm.Rd ├── cell_combos.Rd ├── check_design.Rd ├── check_mixed_design.Rd ├── codebook.Rd ├── codebook_interactive.Rd ├── contr_code_anova.Rd ├── contr_code_difference.Rd ├── contr_code_helmert.Rd ├── contr_code_poly.Rd ├── contr_code_sum.Rd ├── contr_code_treatment.Rd ├── convert_param.Rd ├── convert_r.Rd ├── cormat.Rd ├── cormat_from_triangle.Rd ├── distfuncs.Rd ├── dlikert.Rd ├── faceratings.Rd ├── faux.Rd ├── faux_options.Rd ├── fh_bounds.Rd ├── figures │ ├── card.png │ ├── get-design-long-1.png │ ├── logo.png │ ├── plot-design-1.png │ ├── plot-iris-sim-1.png │ ├── plot-rnorm-pre-1.png │ └── plot-sim-design-1.png ├── fix_name_labels.Rd ├── fr4.Rd ├── gamma2norm.Rd ├── get_coefs.Rd ├── get_contrast_vals.Rd ├── get_design.Rd ├── get_design_long.Rd ├── get_params.Rd ├── getcols.Rd ├── interactive_design.Rd ├── is_pos_def.Rd ├── json_design.Rd ├── long2wide.Rd ├── make_id.Rd ├── message.Rd ├── messy.Rd ├── nbinom2norm.Rd ├── nested_list.Rd ├── norm2beta.Rd ├── norm2binom.Rd ├── norm2gamma.Rd ├── norm2likert.Rd ├── norm2nbinom.Rd ├── norm2norm.Rd ├── norm2pois.Rd ├── norm2trunc.Rd ├── norm2unif.Rd ├── pipe.Rd ├── plikert.Rd ├── plot_design.Rd ├── pos_def_limits.Rd ├── print.design.Rd ├── print.nested_list.Rd ├── print.psychds_codebook.Rd ├── qlikert.Rd ├── readline_check.Rd ├── rlikert.Rd ├── rmulti.Rd ├── rnorm_multi.Rd ├── rnorm_pre.Rd ├── sample_from_pop.Rd ├── set_design.Rd ├── sim_data.Rd ├── sim_design.Rd ├── sim_df.Rd ├── sim_joint_dist.Rd ├── sim_mixed_cc.Rd ├── sim_mixed_df.Rd ├── std_alpha2average_r.Rd ├── trunc2norm.Rd ├── unif2norm.Rd ├── unique_pairs.Rd └── wide2long.Rd ├── mess ├── codebook.Rmd ├── dist_test.R ├── faux2ANOVA_design.R ├── mess.Rmd ├── r_to_tau.Rmd ├── r_to_tau.html ├── sims ├── sims.rds ├── speed_tests.R ├── speed_tests2.R ├── test-faux2anova_design.R ├── test-sample_from_pop.R ├── test.R ├── todo.md └── y ├── pkgdown ├── _pkgdown.yml ├── extra.js ├── favicon │ ├── apple-touch-icon-120x120.png │ ├── apple-touch-icon-152x152.png │ ├── apple-touch-icon-180x180.png │ ├── apple-touch-icon-60x60.png │ ├── apple-touch-icon-76x76.png │ ├── apple-touch-icon.png │ ├── favicon-16x16.png │ ├── favicon-32x32.png │ └── favicon.ico ├── index.Rmd ├── index.html ├── index.md └── man │ └── figures │ ├── plot-design-1.png │ ├── plot-iris-sim-1.png │ └── plot-sim-design-1.png ├── tests ├── testthat.R └── testthat │ ├── Rplots.pdf │ ├── test-add_dv.R │ ├── test-add_ranef.R │ ├── test-cell_combos.R │ ├── test-check_design.R │ ├── test-check_mixed_design.R │ ├── test-codebook.R │ ├── test-codebook_interactive.R │ ├── test-contrasts.R │ ├── test-convert_param.R │ ├── test-cormat.R │ ├── test-cormat_from_triangle.R │ ├── test-distributions.R │ ├── test-faux_options.R │ ├── test-fix_name_labels.R │ ├── test-get_coefs.R │ ├── test-get_design_long.R │ ├── test-get_params.R │ ├── test-getcols.R │ ├── test-interactive_design.R │ ├── test-json_design.R │ ├── test-long2wide.R │ ├── test-make_id.R │ ├── test-messages.R │ ├── test-messy.R │ ├── test-nested_list.R │ ├── test-norta.R │ ├── test-plot_design.R │ ├── test-pos_def_limits.R │ ├── test-readline_check.R │ ├── test-rnorm_multi.R │ ├── test-rnorm_pre.R │ ├── test-sim_design.R │ ├── test-sim_df.R │ ├── test-sim_joint_dist.R │ ├── test-sim_mixed_cc.R │ ├── test-sim_mixed_df.R │ ├── test-unique_pairs.R │ └── test-zzz.R └── vignettes ├── .gitignore ├── articles ├── .gitignore ├── codebook.Rmd ├── continuous.Rmd ├── contrasts.Rmd ├── distributions.Rmd ├── norta.Rmd ├── random_reports.Rmd ├── rnorm_multi.Rmd ├── sim_df.Rmd ├── sim_mixed.Rmd └── template_instructions.txt ├── plots.Rmd └── sim_design.Rmd /.Rbuildignore: -------------------------------------------------------------------------------- 1 | ^codecov\.yml$ 2 | ^\.travis\.yml$ 3 | ^\.zenodo.json$ 4 | ^CODE_OF_CONDUCT\.md$ 5 | ^Meta$ 6 | ^doc$ 7 | ^README\.Rmd$ 8 | ^README\.html$ 9 | ^index\.Rmd$ 10 | ^index\.md$ 11 | ^index\.html$ 12 | ^README_files$ 13 | ^figure$ 14 | ^data-raw$ 15 | ^mess$ 16 | ^docs$ 17 | ^shiny$ 18 | ^pkgdown$ 19 | ^.*\.Rproj$ 20 | ^\.Rproj\.user$ 21 | ^CRAN-RELEASE$ 22 | ^LICENSE\.md$ 23 | ^cran-comments\.md$ 24 | ^\.github$ 25 | ^_pkgdown\.yml$ 26 | ^_make\.R$ 27 | ^Makefile$ 28 | ^revdep$ 29 | ^vignettes/template_instructions.txt$ 30 | ^vignettes/random_reports.Rmd$ 31 | ^vignettes/plots.Rmd$ 32 | ^vignettes/distributions.Rmd$ 33 | ^vignettes/sim_mixed.Rmd$ 34 | ^CRAN-SUBMISSION$ 35 | ^vignettes/articles$ 36 | -------------------------------------------------------------------------------- /.gitattributes: -------------------------------------------------------------------------------- 1 | docs/* linguist-detectable=false 2 | *.html linguist-detectable=false 3 | *.css linguist-detectable=false 4 | *.js linguist-detectable=false 5 | *.tex linguist-detectable=false 6 | -------------------------------------------------------------------------------- /.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: ubuntu-latest 14 | env: 15 | GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }} 16 | R_KEEP_PKG_SOURCE: yes 17 | steps: 18 | - uses: actions/checkout@v4 19 | 20 | - uses: r-lib/actions/setup-r@v2 21 | with: 22 | use-public-rspm: true 23 | 24 | - uses: r-lib/actions/setup-r-dependencies@v2 25 | with: 26 | extra-packages: any::rcmdcheck 27 | needs: check 28 | 29 | - uses: r-lib/actions/check-r-package@v2 30 | with: 31 | upload-snapshots: true 32 | -------------------------------------------------------------------------------- /.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 | release: 8 | types: [published] 9 | workflow_dispatch: 10 | 11 | name: pkgdown.yaml 12 | 13 | permissions: read-all 14 | 15 | jobs: 16 | pkgdown: 17 | runs-on: ubuntu-latest 18 | # Only restrict concurrency for non-PR jobs 19 | concurrency: 20 | group: pkgdown-${{ github.event_name != 'pull_request' || github.run_id }} 21 | env: 22 | GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }} 23 | permissions: 24 | contents: write 25 | steps: 26 | - uses: actions/checkout@v4 27 | 28 | - uses: r-lib/actions/setup-pandoc@v2 29 | 30 | - uses: r-lib/actions/setup-r@v2 31 | with: 32 | use-public-rspm: true 33 | 34 | - uses: r-lib/actions/setup-r-dependencies@v2 35 | with: 36 | extra-packages: any::pkgdown, local::. 37 | needs: website 38 | 39 | - name: Build site 40 | run: pkgdown::build_site_github_pages(new_process = FALSE, install = FALSE) 41 | shell: Rscript {0} 42 | 43 | - name: Deploy to GitHub pages 🚀 44 | if: github.event_name != 'pull_request' 45 | uses: JamesIves/github-pages-deploy-action@v4.5.0 46 | with: 47 | clean: false 48 | branch: gh-pages 49 | folder: docs 50 | -------------------------------------------------------------------------------- /.github/workflows/rhub.yaml: -------------------------------------------------------------------------------- 1 | # R-hub's generic GitHub Actions workflow file. It's canonical location is at 2 | # https://github.com/r-hub/actions/blob/v1/workflows/rhub.yaml 3 | # You can update this file to a newer version using the rhub2 package: 4 | # 5 | # rhub::rhub_setup() 6 | # 7 | # It is unlikely that you need to modify this file manually. 8 | 9 | name: R-hub 10 | run-name: "${{ github.event.inputs.id }}: ${{ github.event.inputs.name || format('Manually run by {0}', github.triggering_actor) }}" 11 | 12 | on: 13 | workflow_dispatch: 14 | inputs: 15 | config: 16 | description: 'A comma separated list of R-hub platforms to use.' 17 | type: string 18 | default: 'linux,windows,macos' 19 | name: 20 | description: 'Run name. You can leave this empty now.' 21 | type: string 22 | id: 23 | description: 'Unique ID. You can leave this empty now.' 24 | type: string 25 | 26 | jobs: 27 | 28 | setup: 29 | runs-on: ubuntu-latest 30 | outputs: 31 | containers: ${{ steps.rhub-setup.outputs.containers }} 32 | platforms: ${{ steps.rhub-setup.outputs.platforms }} 33 | 34 | steps: 35 | # NO NEED TO CHECKOUT HERE 36 | - uses: r-hub/actions/setup@v1 37 | with: 38 | config: ${{ github.event.inputs.config }} 39 | id: rhub-setup 40 | 41 | linux-containers: 42 | needs: setup 43 | if: ${{ needs.setup.outputs.containers != '[]' }} 44 | runs-on: ubuntu-latest 45 | name: ${{ matrix.config.label }} 46 | strategy: 47 | fail-fast: false 48 | matrix: 49 | config: ${{ fromJson(needs.setup.outputs.containers) }} 50 | container: 51 | image: ${{ matrix.config.container }} 52 | 53 | steps: 54 | - uses: r-hub/actions/checkout@v1 55 | - uses: r-hub/actions/platform-info@v1 56 | with: 57 | token: ${{ secrets.RHUB_TOKEN }} 58 | job-config: ${{ matrix.config.job-config }} 59 | - uses: r-hub/actions/setup-deps@v1 60 | with: 61 | token: ${{ secrets.RHUB_TOKEN }} 62 | job-config: ${{ matrix.config.job-config }} 63 | - uses: r-hub/actions/run-check@v1 64 | with: 65 | token: ${{ secrets.RHUB_TOKEN }} 66 | job-config: ${{ matrix.config.job-config }} 67 | 68 | other-platforms: 69 | needs: setup 70 | if: ${{ needs.setup.outputs.platforms != '[]' }} 71 | runs-on: ${{ matrix.config.os }} 72 | name: ${{ matrix.config.label }} 73 | strategy: 74 | fail-fast: false 75 | matrix: 76 | config: ${{ fromJson(needs.setup.outputs.platforms) }} 77 | 78 | steps: 79 | - uses: r-hub/actions/checkout@v1 80 | - uses: r-hub/actions/setup-r@v1 81 | with: 82 | job-config: ${{ matrix.config.job-config }} 83 | token: ${{ secrets.RHUB_TOKEN }} 84 | - uses: r-hub/actions/platform-info@v1 85 | with: 86 | token: ${{ secrets.RHUB_TOKEN }} 87 | job-config: ${{ matrix.config.job-config }} 88 | - uses: r-hub/actions/setup-deps@v1 89 | with: 90 | job-config: ${{ matrix.config.job-config }} 91 | token: ${{ secrets.RHUB_TOKEN }} 92 | - uses: r-hub/actions/run-check@v1 93 | with: 94 | job-config: ${{ matrix.config.job-config }} 95 | token: ${{ secrets.RHUB_TOKEN }} 96 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | # History files 2 | .Rhistory 3 | .Rapp.history 4 | # Session Data files 5 | .RData 6 | # Example code in package build process 7 | *-Ex.R 8 | # Output files from R CMD build 9 | /*.tar.gz 10 | # Output files from R CMD check 11 | /*.Rcheck/ 12 | # RStudio files 13 | .Rproj.user/ 14 | # produced vignettes 15 | vignettes/*.html 16 | vignettes/*.pdf 17 | # OAuth2 token, see https://github.com/hadley/httr/releases/tag/v0.3 18 | .httr-oauth 19 | # knitr and R markdown default cache directories 20 | /*_cache/ 21 | /cache/ 22 | # Temporary files created by R markdown 23 | *.utf8.md 24 | *.knit.md 25 | # Shiny token, see https://shiny.rstudio.com/articles/shinyapps.html 26 | rsconnect/ 27 | .Rproj.user 28 | inst/doc 29 | .Rprofile 30 | tests/testthat/Rplots.pdf 31 | /doc/ 32 | /Meta/ 33 | /docs/ 34 | docs 35 | -------------------------------------------------------------------------------- /.travis.yml: -------------------------------------------------------------------------------- 1 | # R for travis: see documentation at https://docs.travis-ci.com/user/languages/r 2 | 3 | language: R 4 | sudo: false 5 | cache: packages 6 | after_success: 7 | - Rscript -e 'covr::codecov()' 8 | -------------------------------------------------------------------------------- /.zenodo.json: -------------------------------------------------------------------------------- 1 | { 2 | "description": "Create datasets with factorial structure through simulation by specifying variable parameters.", 3 | "license": "MIT", 4 | "title": "faux: Simulation for Factorial Designs", 5 | "version": "1.2.0", 6 | "upload_type": "software", 7 | "publication_date": "2023-02-03", 8 | "creators": [ 9 | { 10 | "name": "Lisa DeBruine", 11 | "affiliation": "University of Glasgow", 12 | "orcid": "0000-0002-7523-5539" 13 | } 14 | ], 15 | "access_right": "open", 16 | "related_identifiers": [ 17 | { 18 | "scheme": "url", 19 | "identifier": "https://debruine.github.io/faux/", 20 | "relation": "isSupplementTo" 21 | } 22 | ] 23 | } 24 | -------------------------------------------------------------------------------- /CODE_OF_CONDUCT.md: -------------------------------------------------------------------------------- 1 | # Contributor Code of Conduct 2 | 3 | As contributors and maintainers of this project, we pledge to respect all people who 4 | contribute through reporting issues, posting feature requests, updating documentation, 5 | submitting pull requests or patches, and other activities. 6 | 7 | We are committed to making participation in this project a harassment-free experience for 8 | everyone, regardless of level of experience, gender, gender identity and expression, 9 | sexual orientation, disability, personal appearance, body size, race, ethnicity, age, or religion. 10 | 11 | Examples of unacceptable behavior by participants include the use of sexual language or 12 | imagery, derogatory comments or personal attacks, trolling, public or private harassment, 13 | insults, or other unprofessional conduct. 14 | 15 | Project maintainers have the right and responsibility to remove, edit, or reject comments, 16 | commits, code, wiki edits, issues, and other contributions that are not aligned to this 17 | Code of Conduct. Project maintainers who do not follow the Code of Conduct may be removed 18 | from the project team. 19 | 20 | Instances of abusive, harassing, or otherwise unacceptable behavior may be reported by 21 | opening an issue or contacting one or more of the project maintainers. 22 | 23 | This Code of Conduct is adapted from the Contributor Covenant 24 | (http://contributor-covenant.org), version 1.0.0, available at 25 | http://contributor-covenant.org/version/1/0/0/ 26 | -------------------------------------------------------------------------------- /DESCRIPTION: -------------------------------------------------------------------------------- 1 | Package: faux 2 | Title: Simulation for Factorial Designs 3 | Version: 1.2.2 4 | Date: 2025-01-17 5 | Authors@R: c( 6 | person( 7 | given = "Lisa", 8 | family = "DeBruine", 9 | role = c("aut", "cre", "cph"), 10 | email = "debruine@gmail.com", 11 | comment = c(ORCID = "0000-0002-7523-5539") 12 | ), 13 | person( 14 | given = "Anna", 15 | family = "Krystalli", 16 | role = c("ctb"), 17 | email = "annakrystalli@googlemail.com", 18 | comment = c(ORCID = "0000-0002-2378-4915") 19 | ), 20 | person( 21 | given = "Andrew", 22 | family = "Heiss", 23 | role = c("ctb"), 24 | email = "andrew@andrewheiss.com", 25 | comment = c(ORCID = "0000-0002-3948-3914") 26 | )) 27 | Description: Create datasets with factorial structure through simulation by specifying variable parameters. Extended documentation at . Described in DeBruine (2020) . 28 | Depends: 29 | R (>= 3.2.4) 30 | Imports: 31 | lme4, 32 | dplyr (>= 1.1.1), 33 | ggplot2 (>= 3.3.0), 34 | jsonlite, 35 | truncnorm, 36 | rlang 37 | License: MIT + file LICENSE 38 | Suggests: 39 | testthat (>= 2.1.0), 40 | tidyr, 41 | knitr, 42 | rmarkdown, 43 | roxygen2, 44 | cowplot, 45 | ggExtra, 46 | purrr, 47 | broom, 48 | broom.mixed, 49 | psych, 50 | lmerTest, 51 | kableExtra, 52 | glue, 53 | openssl, 54 | readr, 55 | patchwork 56 | VignetteBuilder: knitr 57 | RoxygenNote: 7.3.2 58 | Encoding: UTF-8 59 | LazyData: true 60 | URL: https://github.com/debruine/faux, 61 | https://debruine.github.io/faux/ 62 | BugReports: https://github.com/debruine/faux/issues 63 | Config/Needs/website: rmarkdown 64 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | YEAR: 2020 2 | COPYRIGHT HOLDER: Lisa DeBruine 3 | -------------------------------------------------------------------------------- /LICENSE.md: -------------------------------------------------------------------------------- 1 | # MIT License 2 | 3 | Copyright (c) 2020 Lisa DeBruine 4 | 5 | Permission is hereby granted, free of charge, to any person obtaining a copy 6 | of this software and associated documentation files (the "Software"), to deal 7 | in the Software without restriction, including without limitation the rights 8 | to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 9 | copies of the Software, and to permit persons to whom the Software is 10 | furnished to do so, subject to the following conditions: 11 | 12 | The above copyright notice and this permission notice shall be included in all 13 | copies or substantial portions of the Software. 14 | 15 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 16 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 17 | FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 18 | AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 19 | LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 20 | OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE 21 | SOFTWARE. 22 | -------------------------------------------------------------------------------- /NAMESPACE: -------------------------------------------------------------------------------- 1 | # Generated by roxygen2: do not edit by hand 2 | 3 | S3method(plot,design) 4 | S3method(plot,faux) 5 | S3method(print,design) 6 | S3method(print,nested_list) 7 | S3method(print,psychds_codebook) 8 | export("%>%") 9 | export(add_between) 10 | export(add_contrast) 11 | export(add_random) 12 | export(add_ranef) 13 | export(add_recode) 14 | export(add_within) 15 | export(average_r2tau_0) 16 | export(beta2norm) 17 | export(binom2norm) 18 | export(check_design) 19 | export(check_mixed_design) 20 | export(check_sim_stats) 21 | export(codebook) 22 | export(contr_code_anova) 23 | export(contr_code_difference) 24 | export(contr_code_helmert) 25 | export(contr_code_poly) 26 | export(contr_code_sum) 27 | export(contr_code_treatment) 28 | export(convert_r) 29 | export(cormat) 30 | export(cormat_from_triangle) 31 | export(distfuncs) 32 | export(dlikert) 33 | export(faux_options) 34 | export(fh_bounds) 35 | export(fix_name_labels) 36 | export(gamma2norm) 37 | export(get_coefs) 38 | export(get_contrast_vals) 39 | export(get_design) 40 | export(get_design_long) 41 | export(get_params) 42 | export(getcols) 43 | export(interactive_design) 44 | export(is_pos_def) 45 | export(json_design) 46 | export(long2wide) 47 | export(make_id) 48 | export(messy) 49 | export(nbinom2norm) 50 | export(nested_list) 51 | export(norm2beta) 52 | export(norm2binom) 53 | export(norm2gamma) 54 | export(norm2likert) 55 | export(norm2nbinom) 56 | export(norm2norm) 57 | export(norm2pois) 58 | export(norm2trunc) 59 | export(norm2unif) 60 | export(plikert) 61 | export(plot_design) 62 | export(pos_def_limits) 63 | export(qlikert) 64 | export(readline_check) 65 | export(rlikert) 66 | export(rmulti) 67 | export(rnorm_multi) 68 | export(rnorm_pre) 69 | export(sample_from_pop) 70 | export(set_design) 71 | export(sim_design) 72 | export(sim_df) 73 | export(sim_joint_dist) 74 | export(sim_mixed_cc) 75 | export(sim_mixed_df) 76 | export(std_alpha2average_r) 77 | export(trunc2norm) 78 | export(unif2norm) 79 | export(unique_pairs) 80 | export(wide2long) 81 | import(ggplot2) 82 | importFrom(dplyr,"%>%") 83 | importFrom(stats,cor) 84 | importFrom(stats,sd) 85 | -------------------------------------------------------------------------------- /R/add_dv.R: -------------------------------------------------------------------------------- 1 | #' Add a dependent variable 2 | #' 3 | #' Add a dependent variable to a mixed model simulation using a formula and specification of fixed and random effects parameters. 4 | #' 5 | #' Fixed effects are specified as a named list for each effect in the equation. For example, for the equation `y ~ a * b + (1 | id)`, the fixed effects might be specified as such: `list(a = 5, b = 10, "a:b" = 0)`. 6 | #' 7 | #' Random effects are also specified as a named list of standard deviations for the random intercept and slopes, plus optional correlations. For example, for the equation `y ~ a * b + (b | id)`, the random effects might be specified as such: `list(id = list(intercept = 10, b = 5, .cors = 0.4))`. 8 | #' 9 | #' @param .data the data frame 10 | #' @param formula The formula for your model 11 | #' @param intercept The (grand) intercept value 12 | #' @param error The SD of the error term 13 | #' @param fixef A list of fixed effects (see Details) 14 | #' @param ranef A list of random effects parameters (see Details) 15 | #' 16 | #' @return a data frame with new DV column 17 | #' @keywords internal 18 | #' 19 | #' @examples 20 | #' add_random(id = 1000) |> 21 | #' add_between(a = c("A1", "A2")) |> 22 | #' add_within(b = c("B1", "B2")) |> 23 | #' add_dv(y ~ a*b + (b | id), 24 | #' intercept = 100, 25 | #' error = 10, 26 | #' fixef = list(a = 5, b = 10, "a:b" = 0), 27 | #' ranef = list(id = list(intercept = 10, b = 5, .cors = 0.4)) 28 | #' ) 29 | # add_dv <- function(.data, formula = y ~ 1, 30 | # intercept = 0, 31 | # error = 1, 32 | # fixef = list(), 33 | # ranef = list()) { 34 | # if (is.character(formula)) formula <- stats::as.formula(formula) 35 | # dv <- all.vars(formula[[2]]) 36 | # .data[dv] <- 0 37 | # m <- lm(formula, .data) 38 | # 39 | # conames <- names(m$coefficients) 40 | # coefs <- c(intercept) 41 | # m$coefficients <- setNames(coefs, conames) 42 | # err <- rnorm(nrow(.data), 0, error) 43 | # .data[dv] <- predict(m) + err 44 | # 45 | # return(.data) 46 | # } 47 | -------------------------------------------------------------------------------- /R/cell_combos.R: -------------------------------------------------------------------------------- 1 | #' Cell combos 2 | #' 3 | #' Creates wide cell combination names, such as A1_B1, A2_B1, A1_B2, A2_B2. 4 | #' 5 | #' @param factors A list of lists of named factor levels 6 | #' @param dv name of dv column ("y") to be used if there are no factors 7 | #' @param sep separator 8 | #' 9 | #' @return a list 10 | #' @keywords internal 11 | cell_combos <- function(factors, dv = "y", sep = faux_options("sep")) { 12 | if (length(factors) == 0) { 13 | cells = dv 14 | } else { 15 | fnames <- lapply(factors, names) 16 | exp <- expand.grid(rev(fnames)) 17 | cells <- apply(exp, 1, function(x) { 18 | paste(rev(x), collapse = sep) 19 | }) 20 | } 21 | 22 | cells 23 | } 24 | -------------------------------------------------------------------------------- /R/check_mixed_design.R: -------------------------------------------------------------------------------- 1 | #' Get random intercepts for subjects and items 2 | #' 3 | #' Get error terms from an existing data table. 4 | #' 5 | #' @param data the existing tbl 6 | #' @param dv the column name or index containing the DV 7 | #' @param sub_id the column name or index for the subject IDs 8 | #' @param item_id the column name or index for the item IDs 9 | #' @param formula the formula to run in lmer (defaults to null model dv ~ 1 + (1|sub_id) + (1|item_id)) 10 | #' 11 | #' @return a list of parameters 12 | #' @examples 13 | #' des <- check_mixed_design(fr4, "rating", "rater_id", "face_id") 14 | #' str(des[1:4]) 15 | #' @export 16 | check_mixed_design <- function(data, dv = 1, sub_id = 2, item_id = 3, formula = NULL) { 17 | # error checking ------------------------------------------------------------- 18 | if (is.matrix(data)) { 19 | data = as.data.frame(data) 20 | } else if (!is.data.frame(data)) { 21 | stop("data must be a data frame or matrix") 22 | } 23 | 24 | # get column names if specified by index 25 | if (is.numeric(dv)) dv <- names(data)[dv] 26 | if (is.numeric(sub_id)) sub_id <- names(data)[sub_id] 27 | if (is.numeric(item_id)) item_id <- names(data)[item_id] 28 | 29 | if (is.null(formula)) { 30 | formula <- paste0(dv, " ~ 1 + (1 | ", sub_id, ") + (1 | ", item_id, ")") 31 | } 32 | 33 | lmer_formula <- stats::as.formula(formula) 34 | mod <- lme4::lmer(lmer_formula, data = data) 35 | grand_i <- lme4::fixef(mod)[["(Intercept)"]] 36 | 37 | sds <- lme4::VarCorr(mod) %>% as.data.frame() 38 | 39 | sub_sd <- sds[which((sds$grp==sub_id & 40 | sds$var1== "(Intercept)") & 41 | is.na(sds$var2)), "sdcor"] 42 | item_sd <- sds[which((sds$grp==item_id & 43 | sds$var1== "(Intercept)") & 44 | is.na(sds$var2)), "sdcor"] 45 | error_sd <- sds[which(sds$grp=="Residual"), "sdcor"] 46 | 47 | random_effects <- lme4::ranef(mod) 48 | 49 | list( 50 | grand_i = grand_i, 51 | sub_sd = sub_sd, 52 | item_sd = item_sd, 53 | error_sd = error_sd, 54 | random_effects = random_effects 55 | ) 56 | } 57 | -------------------------------------------------------------------------------- /R/faceratings.R: -------------------------------------------------------------------------------- 1 | #' Attractiveness ratings of faces 2 | #' 3 | #' A dataset containing attractiveness ratings (on a 1-7 scale from "much less attractiveness than average" to "much more attractive than average") for the neutral front faces from 2513 people (ages 17-90) 4 | #' 5 | #' @format A data frame with 256326 rows and 9 variables: 6 | #' \describe{ 7 | #' \item{rater_id}{rater's ID} 8 | #' \item{rater_sex}{rater's sex (female, male, intersex, NA)} 9 | #' \item{rater_age}{rater's age (17-90 years)} 10 | #' \item{rater_sexpref}{rater's preferred sex for romantic relationships (either, men, neither, women, NA)} 11 | #' \item{face_id}{face's ID} 12 | #' \item{face_sex}{face's sex (female, male)} 13 | #' \item{face_age}{face's age (in years)} 14 | #' \item{face_eth}{face's ethnic group} 15 | #' \item{rating}{attractiveness rating on a scale from 1 (much less attractive than average) to 7 (much more attractive than average)} 16 | #' } 17 | #' @source \url{https://figshare.com/articles/dataset/Face_Research_Lab_London_Set/5047666} 18 | "faceratings" 19 | 20 | #' Attractiveness rating subset 21 | #' 22 | #' The faceratings dataset cut down for demos to the first 4 raters of each sex 23 | #' and sexpref and the first 4 faces of each sex and ethnicity with non-NA ages 24 | #' 25 | #' @format A data frame with 768 rows and 9 variables: 26 | #' \describe{ 27 | #' \item{rater_id}{rater's ID} 28 | #' \item{rater_sex}{rater's sex (female, male)} 29 | #' \item{rater_age}{rater's age (17.4-54.3 years)} 30 | #' \item{rater_sexpref}{rater's preferred sex for romantic relationships (either, men, women)} 31 | #' \item{face_id}{face's ID} 32 | #' \item{face_sex}{face's sex (female, male)} 33 | #' \item{face_age}{face's age (19-47 years)} 34 | #' \item{face_eth}{face's ethnic group (black, east_asian, west_asian, white)} 35 | #' \item{rating}{attractiveness rating on a scale from 1 (much less attractive than average) to 7 (much more attractive than average)} 36 | #' } 37 | #' @source \url{https://figshare.com/articles/dataset/Face_Research_Lab_London_Set/5047666} 38 | "fr4" -------------------------------------------------------------------------------- /R/faux-package.R: -------------------------------------------------------------------------------- 1 | #' faux: Simulation Functions. 2 | #' 3 | #' The faux package provides functions for simulating datasets with specified structure. 4 | #' 5 | #' @name faux 6 | #' @keywords internal 7 | #' @import ggplot2 8 | #' @importFrom stats cor sd 9 | "_PACKAGE" 10 | 11 | -------------------------------------------------------------------------------- /R/faux_options.R: -------------------------------------------------------------------------------- 1 | #' Set/get global faux options 2 | #' 3 | #' Global faux options are used, for example, to set the default separator for cell names. 4 | #' 5 | #' @param ... One of four: (1) nothing, then returns all options as a list; (2) a name of an option element, then returns its value; (3) a name-value pair which sets the corresponding option to the new value (and returns nothing), (4) a list with option-value pairs which sets all the corresponding arguments. 6 | #' 7 | #' @return a list of options, values of an option, or nothing 8 | #' @export 9 | #' 10 | #' @examples 11 | #' 12 | #' faux_options() # see all options 13 | #' 14 | #' faux_options("sep") # see value of faux.sep 15 | #' 16 | #' \donttest{ 17 | #' # changes cell separator (e.g., A1.B2) 18 | #' faux_options(sep = ".") 19 | #' 20 | #' # changes cell separator back to default (e.g., A1_B2) 21 | #' faux_options(sep = "_") 22 | #' } 23 | faux_options <- function (...) { 24 | # code from afex::afex_options 25 | dots <- list(...) 26 | if (length(dots) == 0) { 27 | # get all faux options 28 | op <- options() 29 | faux_op <- op[grepl("^faux.", names(op))] 30 | names(faux_op) <- sub("^faux.", "", names(faux_op)) 31 | return(faux_op) 32 | } else if (is.list(dots[[1]])) { 33 | # first item is a list, set from list if named 34 | newop <- dots[[1]] 35 | if (is.null(names(newop))) 36 | stop("Format lists with names like list(sep = '.', verbose = FALSE)") 37 | names(newop) <- paste0("faux.", names(newop)) 38 | options(newop) 39 | } else if (!is.null(names(dots))) { 40 | # dots have names, so set faux options 41 | newop <- dots 42 | names(newop) <- paste0("faux.", names(newop)) 43 | options(newop) 44 | } else if (is.null(names(dots))) { 45 | # dots don't have names, so get faux options 46 | opnames <- paste0("faux.", unlist(dots)) 47 | getop <- lapply(opnames, getOption) 48 | if (length(opnames) == 1) { 49 | getop <- getop[[1]] 50 | } else { 51 | names(getop) <- unlist(dots) 52 | } 53 | return(getop) 54 | } else { 55 | warning("Unsupported command to faux_options(), nothing done.", 56 | call. = FALSE) 57 | } 58 | } -------------------------------------------------------------------------------- /R/fix_name_labels.R: -------------------------------------------------------------------------------- 1 | #' Fix name labels 2 | #' 3 | #' Fixes if a factor list does not have named levels or has special characters in the names 4 | #' 5 | #' @param x the vector or list to fix 6 | #' @param pattern regex pattern to replace; defaults to non-word characters and the value of faux_options("sep") (default = _) 7 | #' @param replacement the character to replace; defaults to . (or _ if faux_options("sep") == ".") 8 | #' 9 | #' @return a named list with fixed names 10 | #' @export 11 | #' 12 | #' @examples 13 | #' source <- list("full.stop", " space ", "under_score", "plus+", "dash-", "tab\t", "line\nbreak") 14 | #' fix_name_labels(source) 15 | #' 16 | fix_name_labels <- function(x, pattern = NA, replacement = ".") { 17 | if (!is.list(x) & !is.vector(x) & !is.factor(x)) 18 | stop("x must be a vector or list") 19 | 20 | if (is.null(names(x))) { names(x) <- x } 21 | nm <- names(x) 22 | 23 | if (!is.null(pattern)) { 24 | if (is.na(pattern)) { 25 | sep_pat <- gsub("([.|()\\^{}+$*?]|\\[|\\])", "\\\\\\1", faux_options("sep")) 26 | pattern <- paste0("(\\W|", sep_pat, ")") 27 | } 28 | # set replacement to _ if the separator is a full stop 29 | if (faux_options("sep") == ".") { 30 | replacement = "_" 31 | } 32 | 33 | # replace non-word characters and underscores with full stops 34 | names(x) <- gsub(pattern = pattern, replacement = replacement, x = nm) 35 | } 36 | as.list(x) 37 | } 38 | -------------------------------------------------------------------------------- /R/get_coefs.R: -------------------------------------------------------------------------------- 1 | #' Get Coefficients from Data 2 | #' 3 | #' You need model coefficients to simulate multilevel data, and can get them from data simulated from parameters using sim_design() or rmulti(). 4 | #' 5 | #' @param data A dataset in long format 6 | #' @param formula A formula (can be extracted from datasets created by sim_design) 7 | #' @param fun the model function (one of "lm", "glm", "lmer", or "glmer") 8 | #' @param ... Further arguments to the model function 9 | #' 10 | #' @return a list of the model coefficients 11 | #' @export 12 | #' 13 | #' @examples 14 | #' # simulate some data 15 | #' data <- sim_design(within = 2, between = 2, 16 | #' mu = c(1, 0, 1, 1), 17 | #' long = TRUE, empirical = TRUE) 18 | #' 19 | #' # get coefs for the full factorial model 20 | #' get_coefs(data) 21 | #' 22 | #' # a reduced model 23 | #' get_coefs(data, y ~ B1 + W1) 24 | #' 25 | #' # specify a different model function 26 | #' data$y <- norm2binom(data$y) 27 | #' get_coefs(data, fun = "glm", family = binomial) 28 | get_coefs <- function(data, formula = NULL, 29 | fun = c("lm", "glm", "lmer", "glmer"), ...) { 30 | fun <- match.arg(fun) 31 | 32 | if (is.null(formula)) { 33 | design <- get_design(data) 34 | factors <- c(names(design$within), names(design$between)) 35 | ranef <- "" 36 | if (length(design$within) > 0) { 37 | ranef <- sprintf(" + (1 | %s)", 38 | #names(design$within) %>% paste(collapse = " * "), 39 | names(design$id)) 40 | 41 | if (fun == "lm") { 42 | fun <- "lmer" 43 | } else if (fun == "glm") { 44 | fun <- "glmer" 45 | } 46 | } 47 | txt_formula <- sprintf("%s ~ %s%s", 48 | names(design$dv), 49 | paste(factors, collapse = " * "), 50 | ranef) 51 | formula <- stats::as.formula(txt_formula) 52 | } 53 | 54 | func <- switch(fun, 55 | lm = stats::lm, 56 | glm = stats::glm, 57 | lmer = lme4::lmer, 58 | glmer = lme4::glmer) 59 | 60 | # switch data wide to long 61 | dv <- as.character(formula[[2]]) 62 | 63 | if (!dv %in% names(data)) { 64 | tryCatch(data <- wide2long(data), 65 | error = function(e) { 66 | stop("The dv (", dv, ") is not in the dataset") 67 | } 68 | ) 69 | } 70 | 71 | args <- list(formula = formula, data = data, ...) 72 | model <- do.call(func, args) 73 | 74 | if (fun %in% c("lm", "glm")) { 75 | estimates <- model$coefficients 76 | } else { 77 | estimates <- lme4::fixef(model) 78 | } 79 | 80 | estimates 81 | } 82 | 83 | 84 | -------------------------------------------------------------------------------- /R/getcols.R: -------------------------------------------------------------------------------- 1 | #' Get data columns 2 | #' 3 | #' Get columns from a data table by specifying the index, column name as a string, or unquoted column name. Returns the column names or indices. 4 | #' 5 | #' @param data the existing tbl 6 | #' @param ... Columns to get 7 | #' @param as_index return the column indices (defaults to name) 8 | #' 9 | #' @return vector of column names or indices 10 | #' @export 11 | #' 12 | #' @examples 13 | #' getcols(mtcars, 1, cyl, "disp", 5:7) 14 | getcols <- function(data, ..., as_index = FALSE) { 15 | cols <- sapply(rlang::enexprs(...), function(v) { 16 | switch( 17 | typeof(v), 18 | symbol = rlang::as_string(v), 19 | character = v, 20 | language = names(data)[eval(v)], # usually e.g., 1:3 21 | names(data)[v] # numeric 22 | ) 23 | }) %>% unlist() %>% as.vector() 24 | 25 | # make sure all columns are in the data 26 | not_in_data <- setdiff(cols, names(data)) 27 | if (length(not_in_data) > 0) { 28 | stop("Some columns were not in the data table: ", 29 | paste(not_in_data, collapse = ", ")) 30 | } 31 | 32 | if (as_index) { 33 | cols <- which(names(data) %in% cols) 34 | } 35 | 36 | unname(cols) 37 | } 38 | -------------------------------------------------------------------------------- /R/json_design.R: -------------------------------------------------------------------------------- 1 | #' Convert design to JSON 2 | #' 3 | #' Convert a design list to JSON notation for archiving (e.g. in scienceverse) 4 | #' 5 | #' @param design a design list including within, between, n, mu, sd, r, dv, id 6 | #' @param filename option name of file to save the json to 7 | #' @param digits number of digits to save 8 | #' @param pretty whether to print condensed or readable 9 | #' @param ... other options to send to jsonlite::toJSON 10 | #' 11 | #' @return a JSON string 12 | #' @export 13 | #' 14 | #' @examples 15 | #' des <- check_design(2,2) 16 | #' json_design(des) 17 | #' json_design(des, pretty = TRUE) 18 | json_design <- function(design, filename = NULL, 19 | digits = 8, pretty = FALSE, ...) { 20 | valid_design <- check_design(design = design, plot = FALSE) 21 | valid_design$params <- NULL 22 | 23 | j <- jsonlite::toJSON(valid_design, auto_unbox = TRUE, digits = digits, pretty = pretty, ...) 24 | 25 | if (!is.null(filename)) { 26 | # fix filename 27 | if (!length(grep("\\.json$", filename))) { 28 | # add .json extension if not already specified 29 | filename <- paste0(filename, ".json") 30 | } 31 | 32 | writeLines(j, filename) 33 | } 34 | 35 | j 36 | } 37 | -------------------------------------------------------------------------------- /R/long2wide.R: -------------------------------------------------------------------------------- 1 | #' Convert data from long to wide format 2 | #' 3 | #' @param data the tbl in long format 4 | #' @param within the names of the within column(s) 5 | #' @param between the names of between column(s) (optional) 6 | #' @param dv the name of the DV (value) column 7 | #' @param id the names of the column(s) for grouping observations 8 | #' @param sep separator for factor levels 9 | #' 10 | #' @return a tbl in wide format 11 | #' 12 | #' @examples 13 | #' df_long <- sim_design(2, 2, long = TRUE) 14 | #' long2wide(df_long, "A", "B") 15 | #' 16 | #' @export 17 | #' 18 | long2wide <- function(data, within = c(), between = c(), dv = "y", id = "id", sep = faux_options("sep")) { 19 | if ("design" %in% names(attributes(data))) { 20 | # get parameters from design 21 | design <- get_design(data) 22 | 23 | within <- names(design$within) 24 | between <- names(design$between) 25 | dv <- names(design$dv) 26 | id <- names(design$id) 27 | sep <- design$sep 28 | } else { 29 | #design <- get_design_long(data, dv = dv, id = id, plot = FALSE) 30 | } 31 | 32 | if (length(within) == 0) return(data) 33 | 34 | d1 <- data[c(id, between, within, dv)] %>% as.data.frame() 35 | sep_replace <- "~-~" # avoid odd parsing 36 | sep_escape <- gsub("([.|()\\^{}+$*?]|\\[|\\])", "\\\\\\1", sep) 37 | for (w in within) d1[w] <- gsub(sep_escape, sep_replace, d1[[w]]) 38 | 39 | tmpw <- d1[within] 40 | tmpw$sep <- sep 41 | d1$.tmpwithin. <- do.call(paste, tmpw) 42 | d1[within] <- NULL 43 | 44 | d1 <- stats::reshape(d1, idvar = c(id, between), 45 | timevar = ".tmpwithin.", 46 | direction = "wide") 47 | pat <- paste0("^", dv, "\\.") 48 | names(d1) <- gsub(pat, "", names(d1)) 49 | 50 | # FIX: get levels from design if available 51 | for (b in between) d1[[b]] <- factor(d1[[b]]) 52 | 53 | # fix names 54 | names(d1) <- gsub(sep_replace, sep, names(d1)) 55 | 56 | if ("design" %in% names(attributes(data))) { 57 | attributes(d1)$design <- design 58 | } 59 | class(d1) <- c("faux", "data.frame") 60 | rownames(d1) <- NULL 61 | 62 | d1 63 | } 64 | 65 | -------------------------------------------------------------------------------- /R/make_id.R: -------------------------------------------------------------------------------- 1 | #' Make ID 2 | #' 3 | #' Make IDs with fixed length and a prefix (e.g., S001, S002, ..., S100). 4 | #' @param n the number of IDs to generate (or a vector of numbers) 5 | #' @param prefix the prefix to the number (default "S") 6 | #' @param digits the number of digits to use for the numeric part. Only used if this is larger than the largest number of digits in n. 7 | #' @param suffix the suffix to the number (default "") 8 | #' 9 | #' @return a vector of IDs 10 | #' @export 11 | #' 12 | #' @examples 13 | #' 14 | #' make_id(20, "SUBJECT_") 15 | #' make_id(10:30, digits = 3) 16 | #' 17 | make_id <- function(n = 100, prefix = "S", digits = 0, suffix = "") { 18 | if (!is.numeric(n)) stop("n must be numeric") 19 | 20 | if (length(n) == 1) n <- 1:n 21 | 22 | max_digits <- as.character(n) %>% 23 | nchar() %>% max() %>% max(digits) 24 | max_decimal <- as.character(n) %>% 25 | # remove whole number parts 26 | # (don't use n%%1 because floating point precision) 27 | sub("(^\\d*\\.|^\\d*$)", "", .) %>% 28 | nchar() %>% max() 29 | fmt <- paste0(prefix, "%0", max_digits, ".", max_decimal, "f", suffix) 30 | 31 | sprintf(fmt, n) 32 | } 33 | -------------------------------------------------------------------------------- /R/messages.R: -------------------------------------------------------------------------------- 1 | #' Less scary green messages 2 | #' 3 | #' @param ... message components (see \code{\link[base]{message}}) 4 | #' @param domain (see \code{\link[base]{message}}) 5 | #' @param appendLF append new line? (see \code{\link[base]{message}}) 6 | #' 7 | #' @return TRUE 8 | #' @keywords internal 9 | #' 10 | message <- function (..., domain = NULL, appendLF = TRUE) { 11 | if (is.null(knitr::opts_knit$get('rmarkdown.pandoc.to'))) { 12 | # not in knitr environment 13 | base::message("\033[32m", ..., "\033[39m", 14 | domain = domain, appendLF = appendLF) 15 | } else { 16 | base::message(..., domain = domain, appendLF = appendLF) 17 | } 18 | } 19 | -------------------------------------------------------------------------------- /R/messy.R: -------------------------------------------------------------------------------- 1 | #' Simulate missing data 2 | #' 3 | #' Insert NA or another replacement value for some proportion of specified 4 | #' columns to simulate missing data. 5 | #' 6 | #' @param data the tbl 7 | #' @param prop the proportion of data to mess up 8 | #' @param ... the columns to mess up (as a vector of column names or numbers) 9 | #' @param replace the replacement value (defaults to NA) 10 | #' 11 | #' @return the messed up table 12 | #' @export 13 | #' 14 | #' @examples 15 | #' messy(iris, 0.1, "Species", replace = "NO SPECIES") 16 | #' messy(iris, 0.5, 1:4) 17 | messy <- function(data, prop = 0, ..., replace = NA) { 18 | if (any(prop > 1)) stop("proportions cannot be greater than 1") 19 | if (any(prop < 0)) stop("proportions cannot be less than 0") 20 | 21 | n <- nrow(data) 22 | cols <- getcols(data, ...) 23 | size <- floor(n*prop) %>% rep(length.out = length(cols)) 24 | 25 | for (i in seq_along(cols)) { 26 | thecol <- cols[i] 27 | 28 | if (data[[thecol]] %>% is.factor()) { # add replace value to factor levels 29 | new_levels <- data[[thecol]] %>% levels() %>% c(replace) 30 | levels(data[[thecol]]) <- new_levels 31 | } 32 | 33 | to_replace <- sample.int(n, size[i]) 34 | data[[thecol]][to_replace] <- replace 35 | } 36 | 37 | data 38 | } 39 | 40 | 41 | 42 | -------------------------------------------------------------------------------- /R/nested_list.R: -------------------------------------------------------------------------------- 1 | #' Output a nested list in RMarkdown list format 2 | #' 3 | #' @param x The list 4 | #' @param pre Text to prefix to each line (e.g., if you want all lines indented 4 spaces to start, use " ") 5 | #' @param quote Text to quote values with (e.g., use "`" to make sure values are not parsed as markdown 6 | #' 7 | #' @return A character string 8 | #' @export 9 | #' 10 | #' @examples 11 | #' x <- list( 12 | #' a = list(a1 = "Named", a2 = "List"), 13 | #' b = list("Unnamed", "List"), 14 | #' c = c(c1 = "Named", c2 = "Vector"), 15 | #' d = c("Unnamed", "Vector"), 16 | #' e = list(e1 = list("A", "B", "C"), 17 | #' e2 = list(a = "A", b = "B"), 18 | #' e3 = c("A", "B", "C"), 19 | #' e4 = 100), 20 | #' f = "single item vector", 21 | #' g = list() 22 | #' ) 23 | #' nested_list(x) 24 | nested_list <- function(x, pre = "", quote = "") { 25 | txt <- c() 26 | 27 | if (is.function(x)) { 28 | fnc <- x %>% 29 | jsonlite::toJSON() %>% 30 | jsonlite::fromJSON() 31 | 32 | txt <- c("```r", fnc, "```") %>% paste0(pre, .) 33 | } else if (!is.null(x) & !is.atomic(x) & !is.vector(x) & !is.list(x)) { 34 | # not a displayable type 35 | txt <- class(x)[1] %>% paste0("{", ., "}") 36 | } else if (is.null(x) | length(x) == 0) { 37 | txt <- "{empty}" 38 | } else if (length(x) == 1 & 39 | is.null(names(x)) & 40 | !is.list(x)) { # single-item unnamed vector 41 | txt <- paste0(quote, x, quote) 42 | } else { # x is a list, named vector, or vector length > 1 43 | # handle named, unnamed, or partially named 44 | list_names <- names(x) 45 | if (is.null(list_names)) { 46 | bullet <- paste0(1:length(x), ". ") 47 | } else { 48 | blanks <- grep("^$", list_names) 49 | list_names[blanks] <- paste0("{", blanks, "}") 50 | bullet <- paste0("* ", list_names, ": ") 51 | } 52 | 53 | pre2 <- paste0(pre, " ") 54 | txt <- lapply(seq_along(x), function(i) { 55 | item <- x[[i]] 56 | sub <- nested_list(item, pre2, quote) 57 | # add line break unless item is unnamed and length = 1 58 | lbreak <- ifelse(length(item) > 1 | (length(names(item)) > 0), "\n", "") 59 | if (grepl("\n", sub)) lbreak <- "\n" 60 | paste0(pre, bullet[i], lbreak, sub) 61 | }) 62 | } 63 | 64 | list_txt <- paste(txt, collapse = "\n") 65 | class(list_txt) <- c("nested_list", "character") 66 | 67 | list_txt 68 | } 69 | 70 | #' Print Nested List 71 | #' 72 | #' @param x The nested_list string 73 | #' @param ... Additional parameters for print 74 | #' 75 | #' @export 76 | #' @keywords internal 77 | #' @returns Prints x and returns it invisibly 78 | #' 79 | print.nested_list <- function(x, ...) { 80 | cat(x) 81 | } 82 | 83 | 84 | -------------------------------------------------------------------------------- /R/readline_check.R: -------------------------------------------------------------------------------- 1 | #' Check readline input 2 | #' 3 | #' @param prompt the prompt for readline 4 | #' @param type what type of check to perform, one of c("numeric", "integer", "length", "grep") 5 | #' @param min the minimum value 6 | #' @param max the maximum value 7 | #' @param warning an optional custom warning message 8 | #' @param default the default option to return if the entry is blank, NULL allows no default, the default value will be displayed after the text as [default] 9 | #' @param ... other arguments to pass to grep 10 | #' 11 | #' @return the validated result of readline 12 | #' @export 13 | #' 14 | #' @examples 15 | #' if(interactive()){ 16 | #' readline_check("Type a number: ", "numeric") 17 | #' readline_check("Type two characters: ", "length", min = 2, max = 2) 18 | #' readline_check("Type at least 3 characters: ", "length", min = 3) 19 | #' readline_check("Type no more than 4 characters: ", "length", max = 44) 20 | #' readline_check("Type a letter and a number: ", "grep", pattern = "^[a-zA-Z]\\d$") 21 | #' } 22 | readline_check <- function(prompt, type = c("numeric", "integer", "length", "grep"), 23 | min = -Inf, max = Inf, warning = NULL, default = NULL, ...) { 24 | con <- getOption("faux.connection", stdin()) 25 | if (!is.null(default)) prompt <- sprintf("%s [%s]", prompt, default) 26 | cat(paste0(prompt, "\n")) 27 | input <- readLines(con = con, n = 1) 28 | 29 | if (!is.null(default) & (length(input) == 0 || input == "")) { 30 | return(default) 31 | } 32 | 33 | type <- match.arg(type) 34 | if (type == "numeric") { 35 | if (min != -Inf | max != Inf) { 36 | warn_text <- paste0("The input must be a number between ", min, " and ", max, ":") 37 | } else { 38 | warn_text <- "The input must be a number:" 39 | } 40 | input <- suppressWarnings(as.numeric(input)) 41 | check <- !is.na(input) 42 | check <- check & (input >= min) & (input <= max) 43 | } else if (type == "integer") { 44 | if (min != -Inf | max != Inf) { 45 | warn_text <- paste0("The input must be an integer between ", min, " and ", max, ":") 46 | } else { 47 | warn_text <- "The input must be an integer:" 48 | } 49 | check <- grep("^\\d+$", input) %>% length() > 0 50 | input <- suppressWarnings(as.integer(input)) 51 | check <- check & (input >= min) & (input <= max) 52 | } else if (type == "length") { 53 | min <- max(min, 0) # min can't be smaller than 0 for text 54 | warn_text <- paste0("The input must be between ", min, " and " , max, " characters long:") 55 | check <- (nchar(input) >= min) & (nchar(input) <= max) 56 | } else if (type == "grep") { 57 | warn_text <- "The input is incorrect:" 58 | check <- grep(x = input, ...) %>% length() > 0 59 | } else { 60 | warn_text <- "The input is incorrect:" 61 | check <- FALSE # default false if type is wrong? 62 | } 63 | 64 | # custom warning text 65 | if (!is.null(warning)) { 66 | warn_text = warning 67 | } 68 | 69 | # add red Error start 70 | warn_text <- paste0("\033[31mError:\033[39m ", warn_text) 71 | 72 | if (!check) { 73 | Recall(warn_text, type, min, max, warning, ...) 74 | } else { 75 | input 76 | } 77 | } 78 | 79 | -------------------------------------------------------------------------------- /R/sim_joint_dist.R: -------------------------------------------------------------------------------- 1 | #' Simulate category joint distribution 2 | #' 3 | #' This function is mainly used internally, such as for simulating missing data patterns, but is available in case anyone finds it useful. 4 | #' 5 | #' @param data the existing tbl 6 | #' @param ... columns to calculate the joint distribution from, if none are chosen, all columns with 10 or fewer unique values will be chosen 7 | #' @param n the number of total observations to return 8 | #' @param empirical Should the returned data have the exact same distribution of conditions? (versus be sampled from a population with this distribution) 9 | #' 10 | #' @return data table 11 | #' @export 12 | #' 13 | #' @examples 14 | #' sim_joint_dist(ggplot2::diamonds, cut, color, n = 10) 15 | sim_joint_dist <- function(data, ..., n = 100, empirical = FALSE) { 16 | cols <- getcols(data, ...) 17 | # if not specified, choose all columns with < 10 values 18 | if (length(cols) == 0) { 19 | col_unique <- lapply(data, unique) %>% 20 | sapply(length) 21 | 22 | cols <- names(data[, col_unique<=10, drop = FALSE]) 23 | } 24 | 25 | # count instances of each unique combo 26 | grps <- data[cols] 27 | combos <- by(data, grps, function(x) { 28 | y <- x[1, cols, drop = FALSE] 29 | y$.n. <- nrow(x) 30 | y 31 | }) %>% do.call(rbind, .) 32 | 33 | # sample n combos with probs from above 34 | prob <- combos$.n. 35 | if (empirical == TRUE) { 36 | n_per_grp <- round(n*prob/sum(prob)) 37 | # because of rounding, total is sometimes not n 38 | diff <- n - sum(n_per_grp) 39 | grp_n <- length(n_per_grp) 40 | ndiff <- abs(sum(diff)) 41 | if (ndiff > grp_n) { 42 | # more diffs than groups 43 | n_per_grp <- n_per_grp + (floor(ndiff/grp_n) * diff/abs(diff)) 44 | # change ndiff to its remainder 45 | ndiff <- ndiff %% grp_n 46 | } 47 | # add or sub 1 to randomly sampled ndiff items from n_per_grp 48 | to_adjust <- sample(1:grp_n, ndiff) 49 | n_per_grp[to_adjust] <- n_per_grp[to_adjust] + diff/abs(diff) 50 | # select each combo n_per_grp times 51 | samp <- rep(1:nrow(combos), n_per_grp) 52 | } else { 53 | samp <- sample(1:nrow(combos), n, TRUE, prob) 54 | } 55 | 56 | # make a new data from with sampled combo columns 57 | combos$.n. <- NULL 58 | new_data <- lapply(samp, function(x) { 59 | combos[x, , drop = FALSE] 60 | }) %>% do.call(rbind, .) 61 | 62 | rownames(new_data) <- c() 63 | 64 | new_data 65 | } 66 | 67 | -------------------------------------------------------------------------------- /R/sim_mixed_df.R: -------------------------------------------------------------------------------- 1 | #' Generate a mixed design from existing data 2 | #' 3 | #' \code{sim_mixed_df()} produces a data table with the same distributions of 4 | #' by-subject and by-item random intercepts as an existing data table. 5 | #' 6 | #' @param data the existing tbl 7 | #' @param sub_n the number of subjects to simulate (if NULL, returns data for the same subjects) 8 | #' @param item_n the number of items to simulate (if NULL, returns data for the same items) 9 | #' @param dv the column name or index containing the DV 10 | #' @param sub_id the column name or index for the subject IDs 11 | #' @param item_id the column name or index for the item IDs 12 | #' 13 | #' @return a tbl 14 | #' @examples 15 | #' \donttest{sim_mixed_df(faceratings, 10, 10, "rating", "rater_id", "face_id")} 16 | #' @export 17 | 18 | sim_mixed_df <- function(data, sub_n = NULL, item_n = NULL, 19 | dv = "y", sub_id = "sub_id", item_id = "item_id") { 20 | 21 | params <- check_mixed_design(data, dv, sub_id, item_id) 22 | 23 | # get exact intercepts if sub_n or item_n is NULL 24 | if (is.null(item_n)) { 25 | if (is.numeric(item_id)) item_id <- names(data)[item_id] 26 | params$item_sd <- params$random_effects[[item_id]][1] %>% as.matrix() 27 | item_n <- length(params$item_sd) 28 | } 29 | if (is.null(sub_n)) { 30 | if (is.numeric(sub_id)) sub_id <- names(data)[sub_id] 31 | params$sub_sd <- params$random_effects[[sub_id]][1] %>% as.matrix() 32 | sub_n <- length(params$sub_sd) 33 | } 34 | 35 | new_obs <- sim_mixed_cc(sub_n, item_n, params$grand_i, 36 | params$sub_sd, params$item_sd, params$error_sd) 37 | 38 | new_obs 39 | } 40 | -------------------------------------------------------------------------------- /R/utils-pipe.R: -------------------------------------------------------------------------------- 1 | #' Pipe operator 2 | #' 3 | #' See \code{dplyr::\link[dplyr]{\%>\%}} for details. 4 | #' 5 | #' @name %>% 6 | #' @rdname pipe 7 | #' @keywords internal 8 | #' @export 9 | #' @importFrom dplyr %>% 10 | #' @usage lhs \%>\% rhs 11 | #' @param lhs A value or the magrittr placeholder. 12 | #' @param rhs A function call using the magrittr semantics. 13 | #' @returns The result of applying the function in the rhs to the value in the lhs. 14 | NULL 15 | 16 | #' Piped OR 17 | #' 18 | #' LHS if not \code{NULL}, otherwise RHS 19 | #' 20 | #' @param l LHS. 21 | #' @param r RHS. 22 | #' @return LHS if not \code{NULL}, otherwise RHS. 23 | #' @name OR 24 | #' 25 | #' @keywords internal 26 | #' 27 | `%||%` <- function(l, r) { 28 | if (is.null(l)) r else l 29 | } 30 | 31 | 32 | ## quiets concerns of R CMD check re: the .'s that appear in pipelines 33 | if(getRversion() >= "2.15.1") utils::globalVariables(c(".")) 34 | 35 | 36 | -------------------------------------------------------------------------------- /R/wide2long.R: -------------------------------------------------------------------------------- 1 | #' Convert data from wide to long format 2 | #' 3 | #' @param data the tbl in wide format 4 | #' @param within_factors the names of the within factors 5 | #' @param within_cols the names (or indices) of the within-subject (value) columns 6 | #' @param dv the name of the dv column (defaults to "y") 7 | #' @param id the name of the ID column(s) if they don't exist, a new column will be made (defaults to ("id") 8 | #' @param sep separator for within-columns (to be used in strsplit, so can be regex), defaults to "_" 9 | #' 10 | #' @return a tbl in long format 11 | #' 12 | #' @examples 13 | #' wide2long(iris, c("Feature", "Measure"), 1:4, sep = "\\.") 14 | #' 15 | #' @export 16 | #' 17 | wide2long <- function(data, within_factors = c(), within_cols = c(), 18 | dv = "y", id = "id", sep = faux_options("sep")) { 19 | if ("design" %in% names(attributes(data))) { 20 | # get parameters from design 21 | design <- get_design(data) 22 | 23 | dv <- names(design$dv) 24 | id <- names(design$id) 25 | within_factors <- names(design$within) 26 | within_cols <- cell_combos(design$within, dv) 27 | } else { 28 | design <- NULL 29 | } 30 | 31 | # a full stop never makes sense, so escape 32 | if (sep == ".") sep <- "\\." 33 | 34 | if (is.numeric(within_cols)) within_cols <- names(data)[within_cols] 35 | 36 | # check if ID exists and make if not 37 | if (!(id %in% names(data))) { 38 | data[[id]] <- make_id(nrow(data)) 39 | } 40 | 41 | df_long <- stats::reshape(data, within_cols, direction = "long", 42 | idvar = id, v.names = dv, 43 | timevar = ".win.") 44 | 45 | w_in <- within_cols[df_long$.win.] %>% 46 | strsplit(sep) %>% 47 | unlist() %>% matrix(nrow = length(within_factors)) %>% 48 | t() %>% as.data.frame() 49 | names(w_in) <- within_factors 50 | df_long$.win. <- NULL 51 | btwn <- setdiff(names(df_long), c(id, dv)) 52 | col_ord <- c(id, btwn, within_factors, dv) 53 | longdat <- cbind(df_long, w_in)[col_ord] 54 | 55 | # make new factors into factors 56 | for (wf in within_factors) { 57 | if (is.null(design)) { 58 | levels <- unique(longdat[[wf]]) 59 | } else { 60 | levels <- names(design$within[[wf]]) 61 | } 62 | longdat[[wf]] <- factor(longdat[[wf]], levels, levels) 63 | } 64 | 65 | attributes(longdat)$design <- design 66 | class(longdat) <- c("faux", "data.frame") 67 | rownames(longdat) <- NULL 68 | 69 | longdat 70 | } 71 | 72 | -------------------------------------------------------------------------------- /R/zzz.R: -------------------------------------------------------------------------------- 1 | ## set default options for faux_options: 2 | .onLoad <- function(libname, pkgname) { 3 | op <- options() 4 | op.faux <- list( 5 | faux.connection = stdin(), 6 | faux.sep = "_", 7 | faux.plot = TRUE, 8 | faux.verbose = TRUE, 9 | faux.long = FALSE 10 | ) 11 | toset <- !(names(op.faux) %in% names(op)) 12 | if(any(toset)) options(op.faux[toset]) 13 | 14 | invisible() 15 | } 16 | 17 | .onAttach <- function(libname, pkgname) { 18 | paste( 19 | "\n************", 20 | "Welcome to faux. For support and examples visit:", 21 | "https://debruine.github.io/faux/", 22 | "- Get and set global package options with: faux_options()", 23 | "************", 24 | sep = "\n" 25 | ) %>% packageStartupMessage() 26 | } -------------------------------------------------------------------------------- /README.Rmd: -------------------------------------------------------------------------------- 1 | --- 2 | output: github_document 3 | always_allow_html: true 4 | --- 5 | 6 | # faux 7 | 8 | 9 | 10 | 11 | 12 | [![DOI](https://zenodo.org/badge/163506566.svg)](https://zenodo.org/badge/latestdoi/163506566) 13 | [![CRAN status](https://www.r-pkg.org/badges/version-last-release/faux)](https://CRAN.R-project.org/package=faux) 14 | ![Downloads](https://cranlogs.r-pkg.org/badges/grand-total/faux) 15 | [![Lifecycle: stable](https://img.shields.io/badge/lifecycle-stable-brightgreen.svg)](https://lifecycle.r-lib.org/articles/stages.html#stable) 16 | [![Coverage status](https://codecov.io/gh/debruine/faux/branch/master/graph/badge.svg)](https://app.codecov.io/github/debruine/faux?branch=master) 17 | [![R-CMD-check](https://github.com/debruine/faux/workflows/R-CMD-check/badge.svg)](https://github.com/debruine/faux/actions) 18 | [![R-CMD-check](https://github.com/debruine/faux/actions/workflows/R-CMD-check.yaml/badge.svg)](https://github.com/debruine/faux/actions/workflows/R-CMD-check.yaml) 19 | 20 | 21 | 22 | ```{r setup, include = FALSE} 23 | knitr::opts_chunk$set( 24 | fig.path = "man/figures/", 25 | fig.width = 8, 26 | fig.height = 5, 27 | collapse = TRUE, 28 | comment = "#>" 29 | ) 30 | 31 | library(ggplot2) 32 | library(dplyr) 33 | library(tidyr) 34 | library(faux) 35 | set.seed(200) 36 | ``` 37 | 38 | 39 | It is useful to be able to simulate data with a specified structure. The `faux` package provides some functions to make this process easier. See the [package website](https://debruine.github.io/faux/) for more details. 40 | 41 | ## Installation 42 | 43 | You can install the released version of faux from [CRAN](https://CRAN.R-project.org) with: 44 | 45 | ``` r 46 | install.packages("faux") 47 | ``` 48 | 49 | And the development version from [GitHub](https://github.com/debruine/faux) with: 50 | 51 | ``` r 52 | # install.packages("devtools") 53 | devtools::install_github("debruine/faux") 54 | ``` 55 | 56 | Please note that the 'faux' project is released with a [Contributor Code of Conduct](https://github.com/debruine/faux/blob/master/CODE_OF_CONDUCT.md). By contributing to this project, you agree to abide by its terms. 57 | 58 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | 2 | # faux 3 | 4 | 5 | 6 | 7 | 8 | [![DOI](https://zenodo.org/badge/163506566.svg)](https://zenodo.org/badge/latestdoi/163506566) 9 | [![CRAN 10 | status](https://www.r-pkg.org/badges/version-last-release/faux)](https://CRAN.R-project.org/package=faux) 11 | ![Downloads](https://cranlogs.r-pkg.org/badges/grand-total/faux) 12 | [![Lifecycle: 13 | stable](https://img.shields.io/badge/lifecycle-stable-brightgreen.svg)](https://lifecycle.r-lib.org/articles/stages.html#stable) 14 | [![Coverage 15 | status](https://codecov.io/gh/debruine/faux/branch/master/graph/badge.svg)](https://app.codecov.io/github/debruine/faux?branch=master) 16 | [![R-CMD-check](https://github.com/debruine/faux/workflows/R-CMD-check/badge.svg)](https://github.com/debruine/faux/actions) 17 | [![R-CMD-check](https://github.com/debruine/faux/actions/workflows/R-CMD-check.yaml/badge.svg)](https://github.com/debruine/faux/actions/workflows/R-CMD-check.yaml) 18 | 19 | 20 | It is useful to be able to simulate data with a specified structure. The 21 | `faux` package provides some functions to make this process easier. See 22 | the [package website](https://debruine.github.io/faux/) for more 23 | details. 24 | 25 | ## Installation 26 | 27 | You can install the released version of faux from 28 | [CRAN](https://CRAN.R-project.org) with: 29 | 30 | ``` r 31 | install.packages("faux") 32 | ``` 33 | 34 | And the development version from 35 | [GitHub](https://github.com/debruine/faux) with: 36 | 37 | ``` r 38 | # install.packages("devtools") 39 | devtools::install_github("debruine/faux") 40 | ``` 41 | 42 | Please note that the ‘faux’ project is released with a [Contributor Code 43 | of 44 | Conduct](https://github.com/debruine/faux/blob/master/CODE_OF_CONDUCT.md). 45 | By contributing to this project, you agree to abide by its terms. 46 | -------------------------------------------------------------------------------- /codecov.yml: -------------------------------------------------------------------------------- 1 | comment: false 2 | 3 | coverage: 4 | status: 5 | project: 6 | default: 7 | target: auto 8 | threshold: 1% 9 | patch: 10 | default: 11 | target: auto 12 | threshold: 1% 13 | -------------------------------------------------------------------------------- /cran-comments.md: -------------------------------------------------------------------------------- 1 | ## R CMD check results 2 | 3 | 0 errors | 0 warnings | 0 notes 4 | 5 | * DeBruine is my name and not misspelled 6 | * https://doi.org/10.1111/j.1467-6494.1996.tb00813.x is a real DOI 7 | * I moved most of the vignettes to pkgdown articles so they don't take too long 8 | * There was previously a note about the test for norm2likert, but it was skipped with skip(), which I then changed to skip_on_cran(), and now commented them all out. I am at a loss as to how this keeps coming up as a note, as it doesn't on rhub. 9 | 10 | 11 | ## responses to coments 12 | 13 | > Please add \value to .Rd files regarding exported methods and explain the functions results in the documentation. Please write about the structure of the output (class) and also what the output means. (If a function does not return a value, please document that too, e.g. \value{No return value, called for side effects} or similar) 14 | 15 | - pipe.Rd: This is an imported function (from dplyr), so it seems odd for me to replicate their explanations, but I've done it. 16 | - print.design, print.nested_list, print.psychds_codebook: Done! 17 | 18 | > \dontrun{} should only be used if the example really cannot be executed (e.g. because of missing additional software, missing API keys, ...) by the user. That's why wrapping examples in \dontrun{} adds the comment ("# Not run:") as a warning for the user. Does not seem necessary. Please replace \dontrun with \donttest. 19 | 20 | - faux_options: Done! 21 | 22 | > Please do not modifiy the .GlobalEnv. This is not allowed by the CRAN policies. 23 | 24 | - R/norta.R: Done! 25 | -------------------------------------------------------------------------------- /data-raw/faceratings.R: -------------------------------------------------------------------------------- 1 | library(dplyr) 2 | library(readr) 3 | library(tidyr) 4 | 5 | set.seed(8675309) 6 | 7 | faceinfo <- readr::read_csv("data-raw/london_faces_info.csv") 8 | faceratings <- 9 | readr::read_csv("data-raw/london_faces_ratings.csv") %>% 10 | dplyr::mutate(rater_id = make_id(nrow(.))) %>% 11 | tidyr::gather(face_id, rating, X001:X173) %>% 12 | dplyr::left_join(faceinfo, by = "face_id") %>% 13 | dplyr::mutate(face_id = sub("X", "I", face_id)) %>% 14 | dplyr::select(rating, rater_id, face_id, 15 | rater_sex, rater_age, rater_sexpref, 16 | face_sex, face_age, face_eth) 17 | 18 | usethis::use_data(faceratings, overwrite = T) 19 | 20 | rater24 <- faceratings %>% 21 | filter(rater_sex %in% c("male", "female"), 22 | rater_sexpref %in% c("men", "women", "either"), 23 | !is.na(rater_age)) %>% 24 | group_by(rater_id, rater_sex, rater_sexpref) %>% 25 | summarise(.groups = "drop") %>% 26 | ungroup() %>% 27 | group_by(rater_sex, rater_sexpref) %>% 28 | arrange(sample(nrow(.))) %>% 29 | filter(row_number() < 5) %>% 30 | ungroup() %>% 31 | pull(rater_id) 32 | 33 | face32 <- faceratings %>% 34 | filter(face_eth %in% c("black", "white", "east_asian", "west_asian"), 35 | !is.na(face_age)) %>% 36 | group_by(face_id, face_sex, face_eth) %>% 37 | summarise(.groups = "drop") %>% 38 | ungroup() %>% 39 | group_by(face_sex, face_eth) %>% 40 | arrange(sample(nrow(.))) %>% 41 | filter(row_number() < 5) %>% 42 | ungroup() %>% 43 | pull(face_id) 44 | 45 | fr4 <- faceratings %>% 46 | filter(face_id %in% face32, rater_id %in% rater24) 47 | 48 | usethis::use_data(fr4, overwrite = T) 49 | 50 | range(fr4$face_age) 51 | range(fr4$rater_age) 52 | -------------------------------------------------------------------------------- /data-raw/london_faces_info.csv: -------------------------------------------------------------------------------- 1 | face_id,face_age,face_sex,face_eth 2 | X001,24,female,white 3 | X002,24,female,white 4 | X003,38,female,white 5 | X004,30,male,white 6 | X005,28,male,east_asian 7 | X006,31,female,west_asian 8 | X007,21,female,white 9 | X008,25,male,west_asian 10 | X009,22,female,white 11 | X010,26,female,white 12 | X011,36,female,white 13 | X012,24,male,white 14 | X013,26,female,white 15 | X014,23,female,white 16 | X016,23,female,white 17 | X017,34,male,white 18 | X018,19,male,white 19 | X019,24,female,white 20 | X020,35,female,white 21 | X021,48,male,white 22 | X022,29,male,white 23 | X024,47,male,east_asian 24 | X025,21,female,black 25 | X026,24,male,white 26 | X027,26,female,white 27 | X029,26,male,white 28 | X030,24,female,east_asian 29 | X031,,male,white 30 | X032,36,female,white 31 | X033,28,male,white 32 | X034,24,female,east_asian 33 | X036,21,male,east_asian/white 34 | X037,37,male,west_asian 35 | X038,40,female,west_asian 36 | X039,27,female,white 37 | X041,29,male,white 38 | X042,27,male,black 39 | X043,20,male,black 40 | X044,22,male,black 41 | X045,23,male,east_asian 42 | X061,40,male,black 43 | X062,30,female,black 44 | X063,19,male,white 45 | X064,25,female,west_asian 46 | X066,22,female,west_asian 47 | X067,29,male,east_asian 48 | X068,24,male,white 49 | X069,21,male,white 50 | X070,31,male,west_asian 51 | X081,25,female,white 52 | X082,20,male,black 53 | X083,21,female,white 54 | X086,23,female,white 55 | X087,31,female,east_asian 56 | X090,29,female,white 57 | X091,20,female,white 58 | X092,32,male,white 59 | X094,25,female,white 60 | X096,23,male,black 61 | X097,19,female,white 62 | X099,24,female,black 63 | X100,19,female,white 64 | X101,37,male,white 65 | X102,31,female,white 66 | X103,32,male,white 67 | X104,22,male,white 68 | X105,35,male,white 69 | X107,41,female,white 70 | X108,23,male,white 71 | X112,29,female,white 72 | X113,33,female,white 73 | X114,24,male,black 74 | X115,25,male,west_asian 75 | X117,26,male,white 76 | X118,22,female,white 77 | X119,39,male,east_asian 78 | X120,37,female,white 79 | X121,34,male,white 80 | X122,23,female,white 81 | X123,18,male,white 82 | X124,28,female,white 83 | X125,32,male,white 84 | X126,25,female,black 85 | X127,28,female,east_asian 86 | X128,20,male,white 87 | X129,21,female,black 88 | X130,19,male,white 89 | X131,34,male,white 90 | X132,25,male,white 91 | X134,21,female,white 92 | X135,,female,west_asian 93 | X136,54,female,white 94 | X137,21,male,black 95 | X138,23,male,white 96 | X139,25,female,white 97 | X140,42,male,white 98 | X141,23,male,white 99 | X142,26,male,west_asian 100 | X143,29,male,white 101 | X144,27,female,white 102 | X172,40,male,white 103 | X173,34,male,white -------------------------------------------------------------------------------- /data/faceratings.rda: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/debruine/faux/94dc8cecd26f1a5c7c0a1574ac648d04b0cddcfe/data/faceratings.rda -------------------------------------------------------------------------------- /data/fr4.rda: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/debruine/faux/94dc8cecd26f1a5c7c0a1574ac648d04b0cddcfe/data/fr4.rda -------------------------------------------------------------------------------- /faux.Rproj: -------------------------------------------------------------------------------- 1 | Version: 1.0 2 | ProjectId: 7c3e3676-011e-4ef4-a11b-dc44a162557a 3 | 4 | RestoreWorkspace: No 5 | SaveWorkspace: No 6 | AlwaysSaveHistory: Default 7 | 8 | EnableCodeIndexing: Yes 9 | UseSpacesForTab: Yes 10 | NumSpacesForTab: 2 11 | Encoding: UTF-8 12 | 13 | RnwWeave: Sweave 14 | LaTeX: pdfLaTeX 15 | 16 | BuildType: Package 17 | PackageUseDevtools: Yes 18 | PackageInstallArgs: --no-multiarch --with-keep.source 19 | PackageCheckArgs: --as-cran 20 | PackageRoxygenize: rd,collate,namespace 21 | 22 | QuitChildProcessesOnExit: Yes 23 | -------------------------------------------------------------------------------- /figure/plot-design-1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/debruine/faux/94dc8cecd26f1a5c7c0a1574ac648d04b0cddcfe/figure/plot-design-1.png -------------------------------------------------------------------------------- /figure/plot-iris-sim-1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/debruine/faux/94dc8cecd26f1a5c7c0a1574ac648d04b0cddcfe/figure/plot-iris-sim-1.png -------------------------------------------------------------------------------- /figure/plot-sim-design-1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/debruine/faux/94dc8cecd26f1a5c7c0a1574ac648d04b0cddcfe/figure/plot-sim-design-1.png -------------------------------------------------------------------------------- /inst/CITATION: -------------------------------------------------------------------------------- 1 | year <- sub("-.*", "", meta$Date) 2 | note <- sprintf("R package version %s", meta$Version) 3 | textVersion <- paste0("Lisa DeBruine, (", year, ").", 4 | " faux: Simulation for Factorial Designs ", 5 | note, ".", 6 | " Zenodo. http://doi.org/10.5281/zenodo.2669586") 7 | 8 | bibentry( 9 | header = "To cite faux in publications use:", 10 | bibtype = "Manual", 11 | title = "faux: Simulation for Factorial Designs", 12 | author = person("Lisa", "DeBruine", email = "debruine@gmail.com"), 13 | doi = "10.5281/zenodo.2669586", 14 | publisher = "Zenodo", 15 | year = year, 16 | note = note, 17 | url = "https://debruine.github.io/faux/", 18 | textVersion = textVersion 19 | ) 20 | -------------------------------------------------------------------------------- /inst/faux_hex.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/debruine/faux/94dc8cecd26f1a5c7c0a1574ac648d04b0cddcfe/inst/faux_hex.png -------------------------------------------------------------------------------- /man/OR.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/utils-pipe.R 3 | \name{OR} 4 | \alias{OR} 5 | \alias{\%||\%} 6 | \title{Piped OR} 7 | \usage{ 8 | l \%||\% r 9 | } 10 | \arguments{ 11 | \item{l}{LHS.} 12 | 13 | \item{r}{RHS.} 14 | } 15 | \value{ 16 | LHS if not \code{NULL}, otherwise RHS. 17 | } 18 | \description{ 19 | LHS if not \code{NULL}, otherwise RHS 20 | } 21 | \keyword{internal} 22 | -------------------------------------------------------------------------------- /man/add_between.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/add_ranef.R 3 | \name{add_between} 4 | \alias{add_between} 5 | \title{Add between factors} 6 | \usage{ 7 | add_between(.data, .by = NULL, ..., .shuffle = FALSE, .prob = NULL) 8 | } 9 | \arguments{ 10 | \item{.data}{the data frame} 11 | 12 | \item{.by}{the grouping column (groups by row if NULL)} 13 | 14 | \item{...}{the names and levels of the new factors} 15 | 16 | \item{.shuffle}{whether to assign cells randomly or in "order"} 17 | 18 | \item{.prob}{probability of each level, equal if NULL} 19 | } 20 | \value{ 21 | data frame 22 | } 23 | \description{ 24 | Add between factors 25 | } 26 | \examples{ 27 | add_random(subj = 4, item = 2) \%>\% 28 | add_between("subj", condition = c("cntl", "test")) \%>\% 29 | add_between("item", version = c("A", "B")) 30 | } 31 | -------------------------------------------------------------------------------- /man/add_contrast.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/contrasts.R 3 | \name{add_contrast} 4 | \alias{add_contrast} 5 | \title{Add a contrast to a data frame} 6 | \usage{ 7 | add_contrast( 8 | data, 9 | col, 10 | contrast = c("anova", "sum", "treatment", "helmert", "poly", "difference"), 11 | levels = NULL, 12 | ..., 13 | add_cols = TRUE, 14 | colnames = NULL 15 | ) 16 | } 17 | \arguments{ 18 | \item{data}{the data frame} 19 | 20 | \item{col}{the column to recode} 21 | 22 | \item{contrast}{the contrast to recode to} 23 | 24 | \item{levels}{the levels of the factor in order} 25 | 26 | \item{...}{arguments to pass to the contrast function (base or omit)} 27 | 28 | \item{add_cols}{whether to just add the contrast to the existing column or also to create new explicit columns in the dataset (default)} 29 | 30 | \item{colnames}{optional list of column names for the added contrasts} 31 | } 32 | \value{ 33 | the data frame with the recoded column and added columns (if add_cols == TRUE) 34 | } 35 | \description{ 36 | Add a contrast to a data frame 37 | } 38 | \examples{ 39 | df <- sim_design(between = list(time = 1:6), plot = FALSE) \%>\% 40 | add_contrast("time", "poly") 41 | 42 | # test all polynomial contrasts 43 | lm(y ~ time, df) \%>\% broom::tidy() 44 | 45 | # test only the linear and quadratic contrasts 46 | lm(y ~ `time^1` + `time^2`, df) \%>\% broom::tidy() 47 | } 48 | -------------------------------------------------------------------------------- /man/add_random.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/add_ranef.R 3 | \name{add_random} 4 | \alias{add_random} 5 | \title{Add random factors to a data structure} 6 | \usage{ 7 | add_random(.data = NULL, ..., .nested_in = NULL) 8 | } 9 | \arguments{ 10 | \item{.data}{the data frame} 11 | 12 | \item{...}{the new random factor column name and the number of values of the random factor (if crossed) or the n per group (if nested); can be a vector of n per group if nested} 13 | 14 | \item{.nested_in}{the column(s) to nest in (if NULL, the factor is crossed with all columns)} 15 | } 16 | \value{ 17 | a data frame 18 | } 19 | \description{ 20 | Add random factors to a data structure 21 | } 22 | \examples{ 23 | # start a data frame 24 | data1 <- add_random(school = 3) 25 | # nest classes in schools (2 classes per school) 26 | data2 <- add_random(data1, class = 2, .nested_in = "school") 27 | # nest pupils in each class (different n per class) 28 | data3 <- add_random(data2, pupil = c(20, 24, 23, 21, 25, 24), .nested_in = "class") 29 | # cross each pupil with 10 questions 30 | data4 <- add_random(data3, question = 10) 31 | 32 | # compare nesting in 2 different factors 33 | data <- add_random(A = 2, B = 2) 34 | add_random(data, C = 2, .nested_in = "A") 35 | add_random(data, C = 2, .nested_in = "B") 36 | 37 | # specify item names 38 | add_random(school = c("Hyndland Primary", "Hyndland Secondary")) \%>\% 39 | add_random(class = list(paste0("P", 1:7), 40 | paste0("S", 1:6)), 41 | .nested_in = "school") 42 | } 43 | -------------------------------------------------------------------------------- /man/add_ranef.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/add_ranef.R 3 | \name{add_ranef} 4 | \alias{add_ranef} 5 | \title{Add random effects to a data frame} 6 | \usage{ 7 | add_ranef(.data, .by = NULL, ..., .cors = 0, .empirical = FALSE) 8 | } 9 | \arguments{ 10 | \item{.data}{the data frame} 11 | 12 | \item{.by}{the grouping column (groups by row if NULL)} 13 | 14 | \item{...}{the name and standard deviation of each random effect} 15 | 16 | \item{.cors}{the correlations among multiple random effects, to be passed to \code{\link{rnorm_multi}} as r} 17 | 18 | \item{.empirical}{logical. To be passed to \code{\link{rnorm_multi}} as empirical} 19 | } 20 | \value{ 21 | data frame with new random effects columns 22 | } 23 | \description{ 24 | Add random effects to a data frame 25 | } 26 | \examples{ 27 | add_random(rater = 2, stimulus = 2, time = 2) \%>\% 28 | add_ranef("rater", u0r = 1.5) \%>\% 29 | add_ranef("stimulus", u0s = 2.2, u1s = 0.75, .cors = 0.5) \%>\% 30 | add_ranef(c("rater", "stimulus"), u0sr = 1.2) 31 | } 32 | -------------------------------------------------------------------------------- /man/add_recode.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/add_ranef.R 3 | \name{add_recode} 4 | \alias{add_recode} 5 | \title{Recode a categorical column} 6 | \usage{ 7 | add_recode(.data, .col, .newcol = paste0(col, ".c"), ...) 8 | } 9 | \arguments{ 10 | \item{.data}{the data frame} 11 | 12 | \item{.col}{the column to recode} 13 | 14 | \item{.newcol}{the name of the recoded column (defaults to col.c)} 15 | 16 | \item{...}{coding for categorical column} 17 | } 18 | \value{ 19 | data frame with new fixed effects columns 20 | } 21 | \description{ 22 | Recode a categorical column 23 | } 24 | \examples{ 25 | add_random(subj = 4, item = 4) \%>\% 26 | add_between("subj", cond = c("cntl", "test")) \%>\% 27 | add_recode("cond", "cond.t", cntl = 0, test = 1) 28 | } 29 | -------------------------------------------------------------------------------- /man/add_within.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/add_ranef.R 3 | \name{add_within} 4 | \alias{add_within} 5 | \title{Add within factors} 6 | \usage{ 7 | add_within(.data, .by = NULL, ...) 8 | } 9 | \arguments{ 10 | \item{.data}{the data frame} 11 | 12 | \item{.by}{the grouping column (groups by row if NULL)} 13 | 14 | \item{...}{the names and levels of the new factors} 15 | } 16 | \value{ 17 | data frame 18 | } 19 | \description{ 20 | Add within factors 21 | } 22 | \examples{ 23 | add_random(subj = 2, item = 2) \%>\% 24 | add_within("subj", time = c("pre", "post")) 25 | } 26 | -------------------------------------------------------------------------------- /man/average_r2tau_0.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/distribution_convertors.R 3 | \name{average_r2tau_0} 4 | \alias{average_r2tau_0} 5 | \title{Average r to Random Intercept SD} 6 | \usage{ 7 | average_r2tau_0(average_r, sigma) 8 | } 9 | \arguments{ 10 | \item{average_r}{The average inter-item correlation} 11 | 12 | \item{sigma}{Total error variance} 13 | } 14 | \value{ 15 | The standard deviation of the random intercept 16 | } 17 | \description{ 18 | Average r to Random Intercept SD 19 | } 20 | -------------------------------------------------------------------------------- /man/beta2norm.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/distribution_convertors.R 3 | \name{beta2norm} 4 | \alias{beta2norm} 5 | \title{Convert beta to normal} 6 | \usage{ 7 | beta2norm(x, mu = 0, sd = 1, shape1 = NULL, shape2 = NULL, ...) 8 | } 9 | \arguments{ 10 | \item{x}{the gamma distributed vector} 11 | 12 | \item{mu}{the mean of the normal distribution to convert to} 13 | 14 | \item{sd}{the SD of the normal distribution to convert to} 15 | 16 | \item{shape1, shape2}{non-negative parameters of the beta distribution} 17 | 18 | \item{...}{further arguments to pass to pbeta (e.g., ncp)} 19 | } 20 | \value{ 21 | a vector with a normal distribution 22 | } 23 | \description{ 24 | Convert beta to normal 25 | } 26 | \examples{ 27 | 28 | x <- rbeta(10000, 2, 3) 29 | y <- beta2norm(x) 30 | g <- ggplot2::ggplot() + ggplot2::geom_point(ggplot2::aes(x, y)) 31 | ggExtra::ggMarginal(g, type = "histogram") 32 | 33 | } 34 | -------------------------------------------------------------------------------- /man/binom2norm.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/distribution_convertors.R 3 | \name{binom2norm} 4 | \alias{binom2norm} 5 | \title{Convert binomial to normal} 6 | \usage{ 7 | binom2norm(x, mu = 0, sd = 1, size = NULL, prob = NULL) 8 | } 9 | \arguments{ 10 | \item{x}{the binomially distributed vector} 11 | 12 | \item{mu}{the mean of the normal distribution to return} 13 | 14 | \item{sd}{the SD of the normal distribution to return} 15 | 16 | \item{size}{number of trials (set to max value of x if not specified)} 17 | 18 | \item{prob}{the probability of success on each trial (set to mean probability if not specified)} 19 | } 20 | \value{ 21 | a vector with a gaussian distribution 22 | } 23 | \description{ 24 | Convert a binomial distribution to a normal (gaussian) distribution with specified mu and sd 25 | } 26 | \examples{ 27 | 28 | x <- rbinom(10000, 20, 0.75) 29 | y <- binom2norm(x, 0, 1, 20, 0.75) 30 | g <- ggplot2::ggplot() + ggplot2::geom_point(ggplot2::aes(x, y)) 31 | ggExtra::ggMarginal(g, type = "histogram") 32 | 33 | } 34 | -------------------------------------------------------------------------------- /man/cell_combos.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/cell_combos.R 3 | \name{cell_combos} 4 | \alias{cell_combos} 5 | \title{Cell combos} 6 | \usage{ 7 | cell_combos(factors, dv = "y", sep = faux_options("sep")) 8 | } 9 | \arguments{ 10 | \item{factors}{A list of lists of named factor levels} 11 | 12 | \item{dv}{name of dv column ("y") to be used if there are no factors} 13 | 14 | \item{sep}{separator} 15 | } 16 | \value{ 17 | a list 18 | } 19 | \description{ 20 | Creates wide cell combination names, such as A1_B1, A2_B1, A1_B2, A2_B2. 21 | } 22 | \keyword{internal} 23 | -------------------------------------------------------------------------------- /man/check_design.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/check_design.R 3 | \name{check_design} 4 | \alias{check_design} 5 | \title{Validates the specified design} 6 | \usage{ 7 | check_design( 8 | within = list(), 9 | between = list(), 10 | n = 100, 11 | mu = 0, 12 | sd = 1, 13 | r = 0, 14 | dv = list(y = "value"), 15 | id = list(id = "id"), 16 | vardesc = list(), 17 | plot = faux_options("plot"), 18 | design = NULL, 19 | fix_names = FALSE, 20 | sep = faux_options("sep") 21 | ) 22 | } 23 | \arguments{ 24 | \item{within}{a list of the within-subject factors} 25 | 26 | \item{between}{a list of the between-subject factors} 27 | 28 | \item{n}{the number of samples required} 29 | 30 | \item{mu}{a vector giving the means of the variables} 31 | 32 | \item{sd}{the standard deviations of the variables} 33 | 34 | \item{r}{the correlations among the variables (can be a single number, full correlation matrix as a matric or vector, or a vector of the upper right triangle of the correlation matrix} 35 | 36 | \item{dv}{the name of the DV column list(y = "value")} 37 | 38 | \item{id}{the name of the ID column list(id = "id")} 39 | 40 | \item{vardesc}{a list of variable descriptions having the names of the within- and between-subject factors} 41 | 42 | \item{plot}{whether to show a plot of the design} 43 | 44 | \item{design}{a design list including within, between, n, mu, sd, r, dv, id} 45 | 46 | \item{fix_names}{deprecated} 47 | 48 | \item{sep}{separator for factor levels} 49 | } 50 | \value{ 51 | list 52 | } 53 | \description{ 54 | Specify any number of within- and between-subject factors with any number of levels. 55 | } 56 | \details{ 57 | Specify n for each between-subject cell; mu and sd for each cell, and r for the within-subject cells for each between-subject cell. 58 | 59 | This function returns a validated design list for use in sim_data to simulate a data table with this design, or to archive your design. 60 | 61 | See \href{../doc/sim_design.html}{\code{vignette("sim_design", package = "faux")}} for details. 62 | } 63 | \examples{ 64 | 65 | within <- list(time = c("day", "night")) 66 | between <- list(pet = c("dog", "cat")) 67 | mu <- list(dog = 10, cat = 5) 68 | vardesc <- list(time = "Time of Day", pet = "Type of Pet") 69 | check_design(within, between, mu = mu, vardesc = vardesc) 70 | 71 | between <- list(language = c("dutch", "thai"), 72 | pet = c("dog", "cat")) 73 | mu <- list(dutch_dog = 12, dutch_cat = 7, thai_dog = 8, thai_cat = 3) 74 | check_design(within, between, mu = mu) 75 | } 76 | -------------------------------------------------------------------------------- /man/check_mixed_design.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/check_mixed_design.R 3 | \name{check_mixed_design} 4 | \alias{check_mixed_design} 5 | \title{Get random intercepts for subjects and items} 6 | \usage{ 7 | check_mixed_design(data, dv = 1, sub_id = 2, item_id = 3, formula = NULL) 8 | } 9 | \arguments{ 10 | \item{data}{the existing tbl} 11 | 12 | \item{dv}{the column name or index containing the DV} 13 | 14 | \item{sub_id}{the column name or index for the subject IDs} 15 | 16 | \item{item_id}{the column name or index for the item IDs} 17 | 18 | \item{formula}{the formula to run in lmer (defaults to null model dv ~ 1 + (1|sub_id) + (1|item_id))} 19 | } 20 | \value{ 21 | a list of parameters 22 | } 23 | \description{ 24 | Get error terms from an existing data table. 25 | } 26 | \examples{ 27 | des <- check_mixed_design(fr4, "rating", "rater_id", "face_id") 28 | str(des[1:4]) 29 | } 30 | -------------------------------------------------------------------------------- /man/codebook.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/codebook.R 3 | \name{codebook} 4 | \alias{codebook} 5 | \title{Create PsychDS Codebook from Data} 6 | \usage{ 7 | codebook( 8 | data, 9 | name = NULL, 10 | vardesc = list(), 11 | ..., 12 | schemaVersion = "Psych-DS 0.1.0", 13 | return = c("json", "list", "data"), 14 | interactive = FALSE 15 | ) 16 | } 17 | \arguments{ 18 | \item{data}{The data frame to generate a codebook for} 19 | 20 | \item{name}{The name of this dataset (if NULL, will be the same as `data`, limited to 64 characters)} 21 | 22 | \item{vardesc}{Optional variable properties in the format of a named list of vectors (can be named or unnamed and in the same order as the data) from the options "description", "privacy", "dataType", "identifier", "minValue", "maxValue", "levels", "levelsOrdered", "na", "naValue", "alternateName", "privacy", "unitCode", "unitText"} 23 | 24 | \item{...}{Further dataset properties (e.g., description, license, author, citation, funder, url, identifier, keywords, privacyPolicy)} 25 | 26 | \item{schemaVersion}{defaults to "Psych-DS 0.1.0"} 27 | 28 | \item{return}{Whether the output should be in JSON format (json), a list (list) or the reformatted data with the codebook as an attribute (data)} 29 | 30 | \item{interactive}{Whether the function should prompt the user to describe columns and factor levels} 31 | } 32 | \value{ 33 | a list or json-formatted codebook, or reformatted data with the codebook as an attribute 34 | } 35 | \description{ 36 | See \href{../doc/codebook.html}{\code{vignette("codebook", package = "faux")}} for details. 37 | } 38 | \examples{ 39 | 40 | vardesc = list( 41 | description = c("Length of the sepal", 42 | "Width of the sepal", 43 | "Length of the petal", 44 | "Width of the petal", 45 | "The flower species"), 46 | type = c("float", "float", "float", "float", "string") 47 | ) 48 | codebook(iris, vardesc = vardesc) 49 | 50 | } 51 | -------------------------------------------------------------------------------- /man/codebook_interactive.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/codebook_interactive.R 3 | \name{codebook_interactive} 4 | \alias{codebook_interactive} 5 | \title{Interactive Codebook} 6 | \usage{ 7 | codebook_interactive(data, cb = NULL) 8 | } 9 | \arguments{ 10 | \item{data}{The data frame to generate a codebook for} 11 | 12 | \item{cb}{The codebook in list format if already generated} 13 | } 14 | \value{ 15 | codebook list 16 | } 17 | \description{ 18 | Create a Psych-DS formatted codebook from data by answering questions interactively in the console. 19 | } 20 | \keyword{internal} 21 | -------------------------------------------------------------------------------- /man/contr_code_anova.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/contrasts.R 3 | \name{contr_code_anova} 4 | \alias{contr_code_anova} 5 | \title{Anova code a factor} 6 | \usage{ 7 | contr_code_anova(fct, levels = NULL, base = 1, colnames = NULL) 8 | } 9 | \arguments{ 10 | \item{fct}{the factor to contrast code (or a vector)} 11 | 12 | \item{levels}{the levels of the factor in order} 13 | 14 | \item{base}{the index of the level to use as baseline} 15 | 16 | \item{colnames}{optional list of column names for the added contrasts} 17 | } 18 | \value{ 19 | the factor with contrasts set 20 | } 21 | \description{ 22 | Anova coding (also called deviation or simple coding) sets the grand mean as the intercept. 23 | Each contrast compares one level with the reference level (base). 24 | } 25 | \examples{ 26 | df <- sim_design(between = list(pet = c("cat", "dog")), 27 | mu = c(10, 20), plot = FALSE) 28 | df$pet <- contr_code_anova(df$pet) 29 | lm(y ~ pet, df) \%>\% broom::tidy() 30 | 31 | df <- sim_design(between = list(pet = c("cat", "dog", "ferret")), 32 | mu = c(2, 4, 9), empirical = TRUE, plot = FALSE) 33 | 34 | df$pet <- contr_code_anova(df$pet, base = 1) 35 | lm(y ~ pet, df) \%>\% broom::tidy() 36 | 37 | df$pet <- contr_code_anova(df$pet, base = 2) 38 | lm(y ~ pet, df) \%>\% broom::tidy() 39 | 40 | df$pet <- contr_code_anova(df$pet, base = "ferret") 41 | lm(y ~ pet, df) \%>\% broom::tidy() 42 | } 43 | -------------------------------------------------------------------------------- /man/contr_code_difference.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/contrasts.R 3 | \name{contr_code_difference} 4 | \alias{contr_code_difference} 5 | \title{Difference code a factor} 6 | \usage{ 7 | contr_code_difference(fct, levels = NULL, colnames = NULL) 8 | } 9 | \arguments{ 10 | \item{fct}{the factor to contrast code (or a vector)} 11 | 12 | \item{levels}{the levels of the factor in order} 13 | 14 | \item{colnames}{optional list of column names for the added contrasts} 15 | } 16 | \value{ 17 | the factor with contrasts set 18 | } 19 | \description{ 20 | Difference coding sets the grand mean as the intercept. 21 | Each contrast compares one level with the previous level. 22 | } 23 | \examples{ 24 | df <- sim_design(between = list(pet = c("cat", "dog", "ferret")), 25 | mu = c(2, 4, 9), empirical = TRUE, plot = FALSE) 26 | 27 | df$pet <- contr_code_difference(df$pet) 28 | lm(y ~ pet, df) \%>\% broom::tidy() 29 | 30 | } 31 | -------------------------------------------------------------------------------- /man/contr_code_helmert.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/contrasts.R 3 | \name{contr_code_helmert} 4 | \alias{contr_code_helmert} 5 | \title{Helmert code a factor} 6 | \usage{ 7 | contr_code_helmert(fct, levels = NULL, colnames = NULL) 8 | } 9 | \arguments{ 10 | \item{fct}{the factor to contrast code (or a vector)} 11 | 12 | \item{levels}{the levels of the factor in order} 13 | 14 | \item{colnames}{optional list of column names for the added contrasts} 15 | } 16 | \value{ 17 | the factor with contrasts set 18 | } 19 | \description{ 20 | Helmert coding sets the grand mean as the intercept. 21 | Each contrast compares one level with the mean of previous levels. 22 | } 23 | \examples{ 24 | df <- sim_design(between = list(pet = c("cat", "dog")), 25 | mu = c(10, 20), plot = FALSE) 26 | df$pet <- contr_code_helmert(df$pet) 27 | lm(y ~ pet, df) \%>\% broom::tidy() 28 | 29 | df <- sim_design(between = list(pet = c("cat", "dog", "ferret")), 30 | mu = c(2, 4, 9), empirical = TRUE, plot = FALSE) 31 | 32 | df$pet <- contr_code_helmert(df$pet) 33 | lm(y ~ pet, df) \%>\% broom::tidy() 34 | 35 | # reorder the levels to change the comparisons 36 | df$pet <- contr_code_helmert(df$pet, levels = c("dog", "cat", "ferret")) 37 | lm(y ~ pet, df) \%>\% broom::tidy() 38 | 39 | df$pet <- contr_code_helmert(df$pet, levels = c("ferret", "dog", "cat")) 40 | lm(y ~ pet, df) \%>\% broom::tidy() 41 | } 42 | -------------------------------------------------------------------------------- /man/contr_code_poly.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/contrasts.R 3 | \name{contr_code_poly} 4 | \alias{contr_code_poly} 5 | \title{Polynomial code a factor} 6 | \usage{ 7 | contr_code_poly(fct, levels = NULL, colnames = NULL) 8 | } 9 | \arguments{ 10 | \item{fct}{the factor to contrast code (or a vector)} 11 | 12 | \item{levels}{the levels of the factor in order} 13 | 14 | \item{colnames}{optional list of column names for the added contrasts} 15 | } 16 | \value{ 17 | the factor with contrasts set 18 | } 19 | \description{ 20 | Polynomial coding sets the grand mean as the intercept. 21 | Each contrast tests a trend (linear, quadratic, cubic, etc.). This is only suitable for ordered factors. 22 | } 23 | \examples{ 24 | df <- sim_design(within = list(time = 1:6), 25 | mu = 1:6 + (1:6-3.5)^2, 26 | long = TRUE, plot = FALSE) 27 | 28 | df$time <- contr_code_poly(df$time) 29 | lm(y ~ time, df) \%>\% broom::tidy() 30 | 31 | } 32 | -------------------------------------------------------------------------------- /man/contr_code_sum.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/contrasts.R 3 | \name{contr_code_sum} 4 | \alias{contr_code_sum} 5 | \title{Sum code a factor} 6 | \usage{ 7 | contr_code_sum(fct, levels = NULL, omit = length(levels), colnames = NULL) 8 | } 9 | \arguments{ 10 | \item{fct}{the factor to contrast code (or a vector)} 11 | 12 | \item{levels}{the levels of the factor in order} 13 | 14 | \item{omit}{the level to omit (defaults to the last level)} 15 | 16 | \item{colnames}{optional list of column names for the added contrasts} 17 | } 18 | \value{ 19 | the factor with contrasts set 20 | } 21 | \description{ 22 | Sum coding sets the grand mean as the intercept. 23 | Each contrast compares one level with the grand mean. 24 | } 25 | \examples{ 26 | df <- sim_design(between = list(pet = c("cat", "dog", "bird", "ferret")), 27 | mu = c(2, 4, 9, 13), empirical = TRUE, plot = FALSE) 28 | 29 | df$pet <- contr_code_sum(df$pet) 30 | lm(y ~ pet, df) \%>\% broom::tidy() 31 | 32 | df$pet <- contr_code_sum(df$pet, omit = "cat") 33 | lm(y ~ pet, df) \%>\% broom::tidy() 34 | 35 | df$pet <- contr_code_sum(df$pet, omit = 1) 36 | lm(y ~ pet, df) \%>\% broom::tidy() 37 | } 38 | -------------------------------------------------------------------------------- /man/contr_code_treatment.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/contrasts.R 3 | \name{contr_code_treatment} 4 | \alias{contr_code_treatment} 5 | \title{Treatment code a factor} 6 | \usage{ 7 | contr_code_treatment(fct, levels = NULL, base = 1, colnames = NULL) 8 | } 9 | \arguments{ 10 | \item{fct}{the factor to contrast code (or a vector)} 11 | 12 | \item{levels}{the levels of the factor in order} 13 | 14 | \item{base}{the index of the level to use as baseline} 15 | 16 | \item{colnames}{optional list of column names for the added contrasts} 17 | } 18 | \value{ 19 | the factor with contrasts set 20 | } 21 | \description{ 22 | Treatment coding sets the mean of the reference level (base) as the intercept. 23 | Each contrast compares one level with the reference level. 24 | } 25 | \examples{ 26 | df <- sim_design(between = list(pet = c("cat", "dog")), 27 | mu = c(10, 20), plot = FALSE) 28 | df$pet <- contr_code_treatment(df$pet) 29 | lm(y ~ pet, df) \%>\% broom::tidy() 30 | 31 | df <- sim_design(between = list(pet = c("cat", "dog", "ferret")), 32 | mu = c(2, 4, 9), empirical = TRUE, plot = FALSE) 33 | 34 | df$pet <- contr_code_treatment(df$pet) 35 | lm(y ~ pet, df) \%>\% broom::tidy() 36 | 37 | df$pet <- contr_code_treatment(df$pet, base = 2) 38 | lm(y ~ pet, df) \%>\% broom::tidy() 39 | 40 | df$pet <- contr_code_treatment(df$pet, base = "ferret") 41 | lm(y ~ pet, df) \%>\% broom::tidy() 42 | } 43 | -------------------------------------------------------------------------------- /man/convert_param.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/convert_param.R 3 | \name{convert_param} 4 | \alias{convert_param} 5 | \title{Convert parameter} 6 | \usage{ 7 | convert_param(param, cells_w, cells_b, type = "this parameter") 8 | } 9 | \arguments{ 10 | \item{param}{the parameter (mu, sd, or n)} 11 | 12 | \item{cells_w}{a vector of within-subject cells combinations} 13 | 14 | \item{cells_b}{a vector of between-subject cell combinations} 15 | 16 | \item{type}{the name of the parameter (for error messages)} 17 | } 18 | \value{ 19 | a list of parameters 20 | } 21 | \description{ 22 | Converts parameter specification from vector or list format 23 | } 24 | \keyword{internal} 25 | -------------------------------------------------------------------------------- /man/convert_r.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/norta.R 3 | \name{convert_r} 4 | \alias{convert_r} 5 | \title{Convert r for NORTA} 6 | \usage{ 7 | convert_r( 8 | target_r = 0, 9 | dist1 = "norm", 10 | dist2 = "norm", 11 | params1 = list(), 12 | params2 = list(), 13 | tol = 0.01 14 | ) 15 | } 16 | \arguments{ 17 | \item{target_r}{The target correlation} 18 | 19 | \item{dist1}{The target distribution function for variable 1 (e.g., norm, binom, gamma, truncnorm)} 20 | 21 | \item{dist2}{The target distribution function for variable 2} 22 | 23 | \item{params1}{Arguments to pass to the functions for distribution 1} 24 | 25 | \item{params2}{Arguments to pass to the functions for distribution 2} 26 | 27 | \item{tol}{Tolerance for optimise function} 28 | } 29 | \value{ 30 | r-value to induce in the bivariate normal variables 31 | } 32 | \description{ 33 | Given a target r-value, returns the correlation you need to induce in a bivariate normal distribution to have the target correlation after converting distributions. 34 | } 35 | \details{ 36 | See \link[stats:Distributions]{Distributions} for distributions and their various arguments to specify in params1 and params2. 37 | } 38 | \examples{ 39 | convert_r(target_r = 0.5, 40 | dist1 = "norm", 41 | dist2 = "binom", 42 | params1 = list(mean = 100, sd = 10), 43 | params2 = list(size = 1, prob = 0.5)) 44 | } 45 | -------------------------------------------------------------------------------- /man/cormat.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/cormat.R 3 | \name{cormat} 4 | \alias{cormat} 5 | \title{Make a correlation matrix} 6 | \usage{ 7 | cormat(cors = 0, vars = 3) 8 | } 9 | \arguments{ 10 | \item{cors}{the correlations among the variables (can be a single number, vars\*vars matrix, vars\*vars vector, or a vars\*(vars-1)/2 vector)} 11 | 12 | \item{vars}{the number of variables in the matrix} 13 | } 14 | \value{ 15 | matrix 16 | } 17 | \description{ 18 | \code{cormat} makes a correlation matrix from a single number, 19 | vars\*vars matrix, vars\*vars vector, or a vars\*(vars-1)/2 vector. 20 | } 21 | \examples{ 22 | cormat(.5, 3) 23 | cormat(c( 1, .2, .3, .4, 24 | .2, 1, .5, .6, 25 | .3, .5, 1, .7, 26 | .4, .6, .7, 1), 4) 27 | cormat(c(.2, .3, .4, .5, .6, .7), 4) 28 | } 29 | -------------------------------------------------------------------------------- /man/cormat_from_triangle.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/cormat.R 3 | \name{cormat_from_triangle} 4 | \alias{cormat_from_triangle} 5 | \title{Make Correlation Matrix from Triangle} 6 | \usage{ 7 | cormat_from_triangle(cors) 8 | } 9 | \arguments{ 10 | \item{cors}{the correlations among the variables as a vars\*(vars-1)/2 vector} 11 | } 12 | \value{ 13 | matrix 14 | } 15 | \description{ 16 | \code{cormat_from_triangle} makes a correlation matrix from a vector of the upper right triangle 17 | } 18 | \examples{ 19 | cormat_from_triangle(c(.2, .3, .4, 20 | .5, .6, 21 | .7)) 22 | } 23 | -------------------------------------------------------------------------------- /man/distfuncs.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/norta.R 3 | \name{distfuncs} 4 | \alias{distfuncs} 5 | \title{Get distribution functions} 6 | \usage{ 7 | distfuncs(dist = "norm") 8 | } 9 | \arguments{ 10 | \item{dist}{The target distribution function (e.g., norm, binom, gamma, truncnorm, likert). If the distribution isn't definited in the packages stats, truncnorm, or faux, use the format "package::dist".} 11 | } 12 | \value{ 13 | a list with the r and q functions 14 | } 15 | \description{ 16 | Get distribution functions 17 | } 18 | \examples{ 19 | qfunc <- distfuncs("norm")$q # returns qnorm 20 | p <- seq(0.1, 0.9, .1) 21 | qfunc(p) == qnorm(p) 22 | 23 | rfunc <- distfuncs("norm")$r # returns rnorm 24 | rfunc(n = 10, mean = 100, sd = 10) 25 | } 26 | -------------------------------------------------------------------------------- /man/dlikert.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/distribution_convertors.R 3 | \name{dlikert} 4 | \alias{dlikert} 5 | \title{Likert density function} 6 | \usage{ 7 | dlikert(x, prob, labels = names(prob)) 8 | } 9 | \arguments{ 10 | \item{x}{the likert distributed vector} 11 | 12 | \item{prob}{a vector of probabilities or counts; if named, the output is a factor} 13 | 14 | \item{labels}{a vector of values, defaults to names(prob) or 1:length(prob), if numeric, the output is numeric} 15 | } 16 | \value{ 17 | a vector of the densities 18 | } 19 | \description{ 20 | Likert density function 21 | } 22 | \examples{ 23 | x <- 1:5 24 | prob <- c(.1, .2, .4, .2, .1) 25 | dlikert(x, prob) 26 | 27 | x <- c("A", "C", "B", "B") 28 | prob <- c(A = 10, B = 20, C = 30) 29 | dlikert(x, prob) 30 | 31 | # specify labels if prob not named and not 1:length(prob) 32 | labels <- -2:2 33 | x <- sample(labels, 10, replace = TRUE) 34 | prob <- rep(1, length(labels)) # uniform probability 35 | dlikert(x, prob, labels) 36 | } 37 | -------------------------------------------------------------------------------- /man/faceratings.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/faceratings.R 3 | \docType{data} 4 | \name{faceratings} 5 | \alias{faceratings} 6 | \title{Attractiveness ratings of faces} 7 | \format{ 8 | A data frame with 256326 rows and 9 variables: 9 | \describe{ 10 | \item{rater_id}{rater's ID} 11 | \item{rater_sex}{rater's sex (female, male, intersex, NA)} 12 | \item{rater_age}{rater's age (17-90 years)} 13 | \item{rater_sexpref}{rater's preferred sex for romantic relationships (either, men, neither, women, NA)} 14 | \item{face_id}{face's ID} 15 | \item{face_sex}{face's sex (female, male)} 16 | \item{face_age}{face's age (in years)} 17 | \item{face_eth}{face's ethnic group} 18 | \item{rating}{attractiveness rating on a scale from 1 (much less attractive than average) to 7 (much more attractive than average)} 19 | } 20 | } 21 | \source{ 22 | \url{https://figshare.com/articles/dataset/Face_Research_Lab_London_Set/5047666} 23 | } 24 | \usage{ 25 | faceratings 26 | } 27 | \description{ 28 | A dataset containing attractiveness ratings (on a 1-7 scale from "much less attractiveness than average" to "much more attractive than average") for the neutral front faces from 2513 people (ages 17-90) 29 | } 30 | \keyword{datasets} 31 | -------------------------------------------------------------------------------- /man/faux.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/faux-package.R 3 | \docType{package} 4 | \name{faux} 5 | \alias{faux-package} 6 | \alias{faux} 7 | \title{faux: Simulation Functions.} 8 | \description{ 9 | The faux package provides functions for simulating datasets with specified structure. 10 | } 11 | \seealso{ 12 | Useful links: 13 | \itemize{ 14 | \item \url{https://github.com/debruine/faux} 15 | \item \url{https://debruine.github.io/faux/} 16 | \item Report bugs at \url{https://github.com/debruine/faux/issues} 17 | } 18 | 19 | } 20 | \author{ 21 | \strong{Maintainer}: Lisa DeBruine \email{debruine@gmail.com} (\href{https://orcid.org/0000-0002-7523-5539}{ORCID}) [copyright holder] 22 | 23 | Other contributors: 24 | \itemize{ 25 | \item Anna Krystalli \email{annakrystalli@googlemail.com} (\href{https://orcid.org/0000-0002-2378-4915}{ORCID}) [contributor] 26 | \item Andrew Heiss \email{andrew@andrewheiss.com} (\href{https://orcid.org/0000-0002-3948-3914}{ORCID}) [contributor] 27 | } 28 | 29 | } 30 | \keyword{internal} 31 | -------------------------------------------------------------------------------- /man/faux_options.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/faux_options.R 3 | \name{faux_options} 4 | \alias{faux_options} 5 | \title{Set/get global faux options} 6 | \usage{ 7 | faux_options(...) 8 | } 9 | \arguments{ 10 | \item{...}{One of four: (1) nothing, then returns all options as a list; (2) a name of an option element, then returns its value; (3) a name-value pair which sets the corresponding option to the new value (and returns nothing), (4) a list with option-value pairs which sets all the corresponding arguments.} 11 | } 12 | \value{ 13 | a list of options, values of an option, or nothing 14 | } 15 | \description{ 16 | Global faux options are used, for example, to set the default separator for cell names. 17 | } 18 | \examples{ 19 | 20 | faux_options() # see all options 21 | 22 | faux_options("sep") # see value of faux.sep 23 | 24 | \donttest{ 25 | # changes cell separator (e.g., A1.B2) 26 | faux_options(sep = ".") 27 | 28 | # changes cell separator back to default (e.g., A1_B2) 29 | faux_options(sep = "_") 30 | } 31 | } 32 | -------------------------------------------------------------------------------- /man/fh_bounds.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/norta.R 3 | \name{fh_bounds} 4 | \alias{fh_bounds} 5 | \title{Get Fréchet-Hoefding bounds} 6 | \usage{ 7 | fh_bounds(dist1 = "norm", dist2 = "norm", params1 = list(), params2 = list()) 8 | } 9 | \arguments{ 10 | \item{dist1}{The target distribution function for variable 1 (e.g., norm, binom, gamma, truncnorm)} 11 | 12 | \item{dist2}{The target distribution function for variable 2} 13 | 14 | \item{params1}{Arguments to pass to the random generation function (e.g., rnorm) for distribution 1} 15 | 16 | \item{params2}{Arguments to pass to the random generation function (e.g., rnorm) for distribution 2} 17 | } 18 | \value{ 19 | a list of the min and max possible values 20 | } 21 | \description{ 22 | Fréchet-Hoefding bounds are the limits to a correlation between different distributions. 23 | } 24 | \examples{ 25 | fh_bounds(dist1 = "pois", 26 | dist2 = "unif", 27 | params1 = list(lambda = 3), 28 | params2 = list(min = 0, max = 100)) 29 | } 30 | -------------------------------------------------------------------------------- /man/figures/card.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/debruine/faux/94dc8cecd26f1a5c7c0a1574ac648d04b0cddcfe/man/figures/card.png -------------------------------------------------------------------------------- /man/figures/get-design-long-1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/debruine/faux/94dc8cecd26f1a5c7c0a1574ac648d04b0cddcfe/man/figures/get-design-long-1.png -------------------------------------------------------------------------------- /man/figures/logo.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/debruine/faux/94dc8cecd26f1a5c7c0a1574ac648d04b0cddcfe/man/figures/logo.png -------------------------------------------------------------------------------- /man/figures/plot-design-1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/debruine/faux/94dc8cecd26f1a5c7c0a1574ac648d04b0cddcfe/man/figures/plot-design-1.png -------------------------------------------------------------------------------- /man/figures/plot-iris-sim-1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/debruine/faux/94dc8cecd26f1a5c7c0a1574ac648d04b0cddcfe/man/figures/plot-iris-sim-1.png -------------------------------------------------------------------------------- /man/figures/plot-rnorm-pre-1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/debruine/faux/94dc8cecd26f1a5c7c0a1574ac648d04b0cddcfe/man/figures/plot-rnorm-pre-1.png -------------------------------------------------------------------------------- /man/figures/plot-sim-design-1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/debruine/faux/94dc8cecd26f1a5c7c0a1574ac648d04b0cddcfe/man/figures/plot-sim-design-1.png -------------------------------------------------------------------------------- /man/fix_name_labels.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/fix_name_labels.R 3 | \name{fix_name_labels} 4 | \alias{fix_name_labels} 5 | \title{Fix name labels} 6 | \usage{ 7 | fix_name_labels(x, pattern = NA, replacement = ".") 8 | } 9 | \arguments{ 10 | \item{x}{the vector or list to fix} 11 | 12 | \item{pattern}{regex pattern to replace; defaults to non-word characters and the value of faux_options("sep") (default = _)} 13 | 14 | \item{replacement}{the character to replace; defaults to . (or _ if faux_options("sep") == ".")} 15 | } 16 | \value{ 17 | a named list with fixed names 18 | } 19 | \description{ 20 | Fixes if a factor list does not have named levels or has special characters in the names 21 | } 22 | \examples{ 23 | source <- list("full.stop", " space ", "under_score", "plus+", "dash-", "tab\t", "line\nbreak") 24 | fix_name_labels(source) 25 | 26 | } 27 | -------------------------------------------------------------------------------- /man/fr4.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/faceratings.R 3 | \docType{data} 4 | \name{fr4} 5 | \alias{fr4} 6 | \title{Attractiveness rating subset} 7 | \format{ 8 | A data frame with 768 rows and 9 variables: 9 | \describe{ 10 | \item{rater_id}{rater's ID} 11 | \item{rater_sex}{rater's sex (female, male)} 12 | \item{rater_age}{rater's age (17.4-54.3 years)} 13 | \item{rater_sexpref}{rater's preferred sex for romantic relationships (either, men, women)} 14 | \item{face_id}{face's ID} 15 | \item{face_sex}{face's sex (female, male)} 16 | \item{face_age}{face's age (19-47 years)} 17 | \item{face_eth}{face's ethnic group (black, east_asian, west_asian, white)} 18 | \item{rating}{attractiveness rating on a scale from 1 (much less attractive than average) to 7 (much more attractive than average)} 19 | } 20 | } 21 | \source{ 22 | \url{https://figshare.com/articles/dataset/Face_Research_Lab_London_Set/5047666} 23 | } 24 | \usage{ 25 | fr4 26 | } 27 | \description{ 28 | The faceratings dataset cut down for demos to the first 4 raters of each sex 29 | and sexpref and the first 4 faces of each sex and ethnicity with non-NA ages 30 | } 31 | \keyword{datasets} 32 | -------------------------------------------------------------------------------- /man/gamma2norm.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/distribution_convertors.R 3 | \name{gamma2norm} 4 | \alias{gamma2norm} 5 | \title{Convert gamma to normal} 6 | \usage{ 7 | gamma2norm(x, mu = 0, sd = 1, shape = NULL, rate = 1, scale = 1/rate) 8 | } 9 | \arguments{ 10 | \item{x}{the gamma distributed vector} 11 | 12 | \item{mu}{the mean of the normal distribution to convert to} 13 | 14 | \item{sd}{the SD of the normal distribution to convert to} 15 | 16 | \item{shape}{gamma distribution parameter (must be positive)} 17 | 18 | \item{rate}{an alternative way to specify the scale} 19 | 20 | \item{scale}{gamma distribution parameter (must be positive)} 21 | } 22 | \value{ 23 | a vector with a normal distribution 24 | } 25 | \description{ 26 | Convert gamma to normal 27 | } 28 | \examples{ 29 | 30 | x <- rgamma(10000, 2) 31 | y <- gamma2norm(x) 32 | g <- ggplot2::ggplot() + ggplot2::geom_point(ggplot2::aes(x, y)) 33 | ggExtra::ggMarginal(g, type = "histogram") 34 | 35 | } 36 | -------------------------------------------------------------------------------- /man/get_coefs.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/get_coefs.R 3 | \name{get_coefs} 4 | \alias{get_coefs} 5 | \title{Get Coefficients from Data} 6 | \usage{ 7 | get_coefs(data, formula = NULL, fun = c("lm", "glm", "lmer", "glmer"), ...) 8 | } 9 | \arguments{ 10 | \item{data}{A dataset in long format} 11 | 12 | \item{formula}{A formula (can be extracted from datasets created by sim_design)} 13 | 14 | \item{fun}{the model function (one of "lm", "glm", "lmer", or "glmer")} 15 | 16 | \item{...}{Further arguments to the model function} 17 | } 18 | \value{ 19 | a list of the model coefficients 20 | } 21 | \description{ 22 | You need model coefficients to simulate multilevel data, and can get them from data simulated from parameters using sim_design() or rmulti(). 23 | } 24 | \examples{ 25 | # simulate some data 26 | data <- sim_design(within = 2, between = 2, 27 | mu = c(1, 0, 1, 1), 28 | long = TRUE, empirical = TRUE) 29 | 30 | # get coefs for the full factorial model 31 | get_coefs(data) 32 | 33 | # a reduced model 34 | get_coefs(data, y ~ B1 + W1) 35 | 36 | # specify a different model function 37 | data$y <- norm2binom(data$y) 38 | get_coefs(data, fun = "glm", family = binomial) 39 | } 40 | -------------------------------------------------------------------------------- /man/get_contrast_vals.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/contrasts.R 3 | \name{get_contrast_vals} 4 | \alias{get_contrast_vals} 5 | \title{Get contrast values} 6 | \usage{ 7 | get_contrast_vals(v) 8 | } 9 | \arguments{ 10 | \item{v}{a factor vector} 11 | } 12 | \value{ 13 | a data frame 14 | } 15 | \description{ 16 | Get a data frame of contrast values from a factor vector 17 | } 18 | \examples{ 19 | dat <- sim_design( 20 | between = list(group = c("A", "B")), 21 | n = 5, plot = FALSE) 22 | 23 | get_contrast_vals(dat$group) 24 | 25 | } 26 | -------------------------------------------------------------------------------- /man/get_design.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/check_design.R 3 | \name{get_design} 4 | \alias{get_design} 5 | \title{Get design} 6 | \usage{ 7 | get_design(data) 8 | } 9 | \arguments{ 10 | \item{data}{The data table to check} 11 | } 12 | \value{ 13 | list with class design 14 | } 15 | \description{ 16 | Get the design specification from a data table created in faux. This can be used to create more simulated data with the same design. 17 | } 18 | \examples{ 19 | data <- sim_design(2, 2, plot = FALSE) 20 | design <- get_design(data) 21 | data2 <- sim_design(design, plot = FALSE) 22 | } 23 | -------------------------------------------------------------------------------- /man/get_design_long.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/get_design_long.R 3 | \name{get_design_long} 4 | \alias{get_design_long} 5 | \title{Get design from long data} 6 | \usage{ 7 | get_design_long( 8 | data, 9 | dv = c(y = "score"), 10 | id = c(id = "id"), 11 | plot = faux_options("plot") 12 | ) 13 | } 14 | \arguments{ 15 | \item{data}{the data frame (in long format)} 16 | 17 | \item{dv}{the column name that identifies the DV} 18 | 19 | \item{id}{the column name(s) that identify a unit of analysis} 20 | 21 | \item{plot}{whether to show a plot of the design} 22 | } 23 | \value{ 24 | a design list 25 | } 26 | \description{ 27 | Makes a best guess at the design of a long-format data frame. 28 | } 29 | \details{ 30 | Finds all columns that contain a single value per unit of analysis (between factors), 31 | all columns that contain the same values per unit of analysis (within factors), and 32 | all columns that differ over units of analysis (dv, continuous factors) 33 | } 34 | -------------------------------------------------------------------------------- /man/get_params.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/get_params.R 3 | \name{get_params} 4 | \alias{get_params} 5 | \alias{check_sim_stats} 6 | \title{Get parameters from a data table} 7 | \usage{ 8 | get_params( 9 | data, 10 | between = NULL, 11 | within = NULL, 12 | dv = NULL, 13 | id = NULL, 14 | digits = 2 15 | ) 16 | 17 | check_sim_stats( 18 | data, 19 | between = NULL, 20 | within = NULL, 21 | dv = NULL, 22 | id = NULL, 23 | digits = 2 24 | ) 25 | } 26 | \arguments{ 27 | \item{data}{the existing tbl} 28 | 29 | \item{between}{a vector of column names for between-subject factors} 30 | 31 | \item{within}{a vector of column names for within-subject factors (if data is long)} 32 | 33 | \item{dv}{the column name(s) of the dv, if NULL all numeric columns will be selected} 34 | 35 | \item{id}{the column name(s) of the subject ID, excluded from the table even if numeric} 36 | 37 | \item{digits}{how many digits to round to (default = 2)} 38 | } 39 | \value{ 40 | a tbl of correlations, means and sds 41 | } 42 | \description{ 43 | Generates a table of the correlations and means of numeric columns in a data frame. If data was generated by \code{sim_design} and has a "design" attribute, between, within, dv and id are retrieved from that, unless overridden (use between = 0 to 44 | } 45 | \examples{ 46 | get_params(iris, "Species") 47 | } 48 | -------------------------------------------------------------------------------- /man/getcols.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/getcols.R 3 | \name{getcols} 4 | \alias{getcols} 5 | \title{Get data columns} 6 | \usage{ 7 | getcols(data, ..., as_index = FALSE) 8 | } 9 | \arguments{ 10 | \item{data}{the existing tbl} 11 | 12 | \item{...}{Columns to get} 13 | 14 | \item{as_index}{return the column indices (defaults to name)} 15 | } 16 | \value{ 17 | vector of column names or indices 18 | } 19 | \description{ 20 | Get columns from a data table by specifying the index, column name as a string, or unquoted column name. Returns the column names or indices. 21 | } 22 | \examples{ 23 | getcols(mtcars, 1, cyl, "disp", 5:7) 24 | } 25 | -------------------------------------------------------------------------------- /man/interactive_design.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/interactive.R 3 | \name{interactive_design} 4 | \alias{interactive_design} 5 | \title{Set design interactively} 6 | \usage{ 7 | interactive_design(output = c("faux"), plot = faux_options("plot")) 8 | } 9 | \arguments{ 10 | \item{output}{what type of design to output (faux)} 11 | 12 | \item{plot}{whether to show a plot of the design} 13 | } 14 | \value{ 15 | list 16 | } 17 | \description{ 18 | Set design interactively 19 | } 20 | \examples{ 21 | if(interactive()){ des <- interactive_design() } 22 | } 23 | -------------------------------------------------------------------------------- /man/is_pos_def.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/cormat.R 3 | \name{is_pos_def} 4 | \alias{is_pos_def} 5 | \title{Check a Matrix is Positive Definite} 6 | \usage{ 7 | is_pos_def(cor_mat, tol = 1e-08) 8 | } 9 | \arguments{ 10 | \item{cor_mat}{a correlation matrix} 11 | 12 | \item{tol}{the tolerance for comparing eigenvalues to 0} 13 | } 14 | \value{ 15 | logical value 16 | } 17 | \description{ 18 | \code{is_pos_def} makes a correlation matrix from a vector 19 | } 20 | \examples{ 21 | is_pos_def(matrix(c(1, .5, .5, 1), 2)) # returns TRUE 22 | is_pos_def(matrix(c(1, .9, .9, 23 | .9, 1, -.2, 24 | .9, -.2, 1), 3)) # returns FALSE 25 | } 26 | -------------------------------------------------------------------------------- /man/json_design.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/json_design.R 3 | \name{json_design} 4 | \alias{json_design} 5 | \title{Convert design to JSON} 6 | \usage{ 7 | json_design(design, filename = NULL, digits = 8, pretty = FALSE, ...) 8 | } 9 | \arguments{ 10 | \item{design}{a design list including within, between, n, mu, sd, r, dv, id} 11 | 12 | \item{filename}{option name of file to save the json to} 13 | 14 | \item{digits}{number of digits to save} 15 | 16 | \item{pretty}{whether to print condensed or readable} 17 | 18 | \item{...}{other options to send to jsonlite::toJSON} 19 | } 20 | \value{ 21 | a JSON string 22 | } 23 | \description{ 24 | Convert a design list to JSON notation for archiving (e.g. in scienceverse) 25 | } 26 | \examples{ 27 | des <- check_design(2,2) 28 | json_design(des) 29 | json_design(des, pretty = TRUE) 30 | } 31 | -------------------------------------------------------------------------------- /man/long2wide.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/long2wide.R 3 | \name{long2wide} 4 | \alias{long2wide} 5 | \title{Convert data from long to wide format} 6 | \usage{ 7 | long2wide( 8 | data, 9 | within = c(), 10 | between = c(), 11 | dv = "y", 12 | id = "id", 13 | sep = faux_options("sep") 14 | ) 15 | } 16 | \arguments{ 17 | \item{data}{the tbl in long format} 18 | 19 | \item{within}{the names of the within column(s)} 20 | 21 | \item{between}{the names of between column(s) (optional)} 22 | 23 | \item{dv}{the name of the DV (value) column} 24 | 25 | \item{id}{the names of the column(s) for grouping observations} 26 | 27 | \item{sep}{separator for factor levels} 28 | } 29 | \value{ 30 | a tbl in wide format 31 | } 32 | \description{ 33 | Convert data from long to wide format 34 | } 35 | \examples{ 36 | df_long <- sim_design(2, 2, long = TRUE) 37 | long2wide(df_long, "A", "B") 38 | 39 | } 40 | -------------------------------------------------------------------------------- /man/make_id.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/make_id.R 3 | \name{make_id} 4 | \alias{make_id} 5 | \title{Make ID} 6 | \usage{ 7 | make_id(n = 100, prefix = "S", digits = 0, suffix = "") 8 | } 9 | \arguments{ 10 | \item{n}{the number of IDs to generate (or a vector of numbers)} 11 | 12 | \item{prefix}{the prefix to the number (default "S")} 13 | 14 | \item{digits}{the number of digits to use for the numeric part. Only used if this is larger than the largest number of digits in n.} 15 | 16 | \item{suffix}{the suffix to the number (default "")} 17 | } 18 | \value{ 19 | a vector of IDs 20 | } 21 | \description{ 22 | Make IDs with fixed length and a prefix (e.g., S001, S002, ..., S100). 23 | } 24 | \examples{ 25 | 26 | make_id(20, "SUBJECT_") 27 | make_id(10:30, digits = 3) 28 | 29 | } 30 | -------------------------------------------------------------------------------- /man/message.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/messages.R 3 | \name{message} 4 | \alias{message} 5 | \title{Less scary green messages} 6 | \usage{ 7 | message(..., domain = NULL, appendLF = TRUE) 8 | } 9 | \arguments{ 10 | \item{...}{message components (see \code{\link[base]{message}})} 11 | 12 | \item{domain}{(see \code{\link[base]{message}})} 13 | 14 | \item{appendLF}{append new line? (see \code{\link[base]{message}})} 15 | } 16 | \value{ 17 | TRUE 18 | } 19 | \description{ 20 | Less scary green messages 21 | } 22 | \keyword{internal} 23 | -------------------------------------------------------------------------------- /man/messy.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/messy.R 3 | \name{messy} 4 | \alias{messy} 5 | \title{Simulate missing data} 6 | \usage{ 7 | messy(data, prop = 0, ..., replace = NA) 8 | } 9 | \arguments{ 10 | \item{data}{the tbl} 11 | 12 | \item{prop}{the proportion of data to mess up} 13 | 14 | \item{...}{the columns to mess up (as a vector of column names or numbers)} 15 | 16 | \item{replace}{the replacement value (defaults to NA)} 17 | } 18 | \value{ 19 | the messed up table 20 | } 21 | \description{ 22 | Insert NA or another replacement value for some proportion of specified 23 | columns to simulate missing data. 24 | } 25 | \examples{ 26 | messy(iris, 0.1, "Species", replace = "NO SPECIES") 27 | messy(iris, 0.5, 1:4) 28 | } 29 | -------------------------------------------------------------------------------- /man/nbinom2norm.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/distribution_convertors.R 3 | \name{nbinom2norm} 4 | \alias{nbinom2norm} 5 | \title{Convert negative binomial to normal} 6 | \usage{ 7 | nbinom2norm(x, mu = 0, sd = 1, size = NULL, prob = NULL) 8 | } 9 | \arguments{ 10 | \item{x}{the negative binomially distributed vector} 11 | 12 | \item{mu}{the mean of the normal distribution to return} 13 | 14 | \item{sd}{the SD of the normal distribution to return} 15 | 16 | \item{size}{number of trials (set to max value of x if not specified)} 17 | 18 | \item{prob}{the probability of success on each trial (set to mean probability if not specified)} 19 | } 20 | \value{ 21 | a vector with a gaussian distribution 22 | } 23 | \description{ 24 | Convert a negative binomial distribution to a normal (gaussian) distribution with specified mu and sd 25 | } 26 | \examples{ 27 | 28 | x <- rnbinom(10000, 20, 0.75) 29 | y <- nbinom2norm(x, 0, 1, 20, 0.75) 30 | g <- ggplot2::ggplot() + ggplot2::geom_point(ggplot2::aes(x, y)) 31 | ggExtra::ggMarginal(g, type = "histogram") 32 | 33 | } 34 | -------------------------------------------------------------------------------- /man/nested_list.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/nested_list.R 3 | \name{nested_list} 4 | \alias{nested_list} 5 | \title{Output a nested list in RMarkdown list format} 6 | \usage{ 7 | nested_list(x, pre = "", quote = "") 8 | } 9 | \arguments{ 10 | \item{x}{The list} 11 | 12 | \item{pre}{Text to prefix to each line (e.g., if you want all lines indented 4 spaces to start, use " ")} 13 | 14 | \item{quote}{Text to quote values with (e.g., use "`" to make sure values are not parsed as markdown} 15 | } 16 | \value{ 17 | A character string 18 | } 19 | \description{ 20 | Output a nested list in RMarkdown list format 21 | } 22 | \examples{ 23 | x <- list( 24 | a = list(a1 = "Named", a2 = "List"), 25 | b = list("Unnamed", "List"), 26 | c = c(c1 = "Named", c2 = "Vector"), 27 | d = c("Unnamed", "Vector"), 28 | e = list(e1 = list("A", "B", "C"), 29 | e2 = list(a = "A", b = "B"), 30 | e3 = c("A", "B", "C"), 31 | e4 = 100), 32 | f = "single item vector", 33 | g = list() 34 | ) 35 | nested_list(x) 36 | } 37 | -------------------------------------------------------------------------------- /man/norm2beta.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/distribution_convertors.R 3 | \name{norm2beta} 4 | \alias{norm2beta} 5 | \title{Convert normal to beta} 6 | \usage{ 7 | norm2beta(x, shape1, shape2, mu = mean(x), sd = stats::sd(x), ...) 8 | } 9 | \arguments{ 10 | \item{x}{the normally distributed vector} 11 | 12 | \item{shape1, shape2}{non-negative parameters of the distribution to return} 13 | 14 | \item{mu}{the mean of x (calculated from x if not given)} 15 | 16 | \item{sd}{the SD of x (calculated from x if not given)} 17 | 18 | \item{...}{further arguments to pass to qbeta (e.g., ncp)} 19 | } 20 | \value{ 21 | a vector with a beta distribution 22 | } 23 | \description{ 24 | Convert normal to beta 25 | } 26 | \examples{ 27 | 28 | x <- rnorm(10000) 29 | y <- norm2beta(x, 1, 3) 30 | g <- ggplot2::ggplot() + ggplot2::geom_point(ggplot2::aes(x, y)) 31 | ggExtra::ggMarginal(g, type = "histogram") 32 | 33 | } 34 | -------------------------------------------------------------------------------- /man/norm2binom.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/distribution_convertors.R 3 | \name{norm2binom} 4 | \alias{norm2binom} 5 | \title{Convert normal to binomial} 6 | \usage{ 7 | norm2binom(x, size = 1, prob = 0.5, mu = mean(x), sd = stats::sd(x)) 8 | } 9 | \arguments{ 10 | \item{x}{the normally distributed vector} 11 | 12 | \item{size}{number of trials (0 or more)} 13 | 14 | \item{prob}{the probability of success on each trial (0 to 1)} 15 | 16 | \item{mu}{the mean of x (calculated from x if not given)} 17 | 18 | \item{sd}{the SD of x (calculated from x if not given)} 19 | } 20 | \value{ 21 | a vector with a binomial distribution 22 | } 23 | \description{ 24 | Convert normal to binomial 25 | } 26 | \examples{ 27 | x <- rnorm(10000) 28 | y <- norm2binom(x) 29 | g <- ggplot2::ggplot() + ggplot2::geom_point(ggplot2::aes(x, y)) 30 | ggExtra::ggMarginal(g, type = "histogram") 31 | 32 | } 33 | -------------------------------------------------------------------------------- /man/norm2gamma.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/distribution_convertors.R 3 | \name{norm2gamma} 4 | \alias{norm2gamma} 5 | \title{Convert normal to gamma} 6 | \usage{ 7 | norm2gamma(x, shape, rate = 1, scale = 1/rate, mu = mean(x), sd = stats::sd(x)) 8 | } 9 | \arguments{ 10 | \item{x}{the normally distributed vector} 11 | 12 | \item{shape}{gamma distribution parameter (must be positive)} 13 | 14 | \item{rate}{an alternative way to specify the scale} 15 | 16 | \item{scale}{gamma distribution parameter (must be positive)} 17 | 18 | \item{mu}{the mean of x (calculated from x if not given)} 19 | 20 | \item{sd}{the SD of x (calculated from x if not given)} 21 | } 22 | \value{ 23 | a vector with a gamma distribution 24 | } 25 | \description{ 26 | Convert normal to gamma 27 | } 28 | \examples{ 29 | 30 | x <- rnorm(10000) 31 | y <- norm2gamma(x, shape = 2) 32 | g <- ggplot2::ggplot() + ggplot2::geom_point(ggplot2::aes(x, y)) 33 | ggExtra::ggMarginal(g, type = "histogram") 34 | 35 | } 36 | -------------------------------------------------------------------------------- /man/norm2likert.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/distribution_convertors.R 3 | \name{norm2likert} 4 | \alias{norm2likert} 5 | \title{Convert normal to likert} 6 | \usage{ 7 | norm2likert(x, prob, labels = names(prob), mu = mean(x), sd = stats::sd(x)) 8 | } 9 | \arguments{ 10 | \item{x}{the normally distributed vector} 11 | 12 | \item{prob}{a vector of probabilities or counts; if named, the output is a factor} 13 | 14 | \item{labels}{a vector of values, defaults to names(prob) or 1:length(prob), if numeric, the output is numeric} 15 | 16 | \item{mu}{the mean of x (calculated from x if not given)} 17 | 18 | \item{sd}{the SD of x (calculated from x if not given)} 19 | } 20 | \value{ 21 | a vector with the specified distribution 22 | } 23 | \description{ 24 | Convert normal to likert 25 | } 26 | \examples{ 27 | 28 | x <- rnorm(10000) 29 | y <- norm2likert(x, c(.1, .2, .35, .2, .1, .05)) 30 | g <- ggplot2::ggplot() + ggplot2::geom_point(ggplot2::aes(x, y)) 31 | ggExtra::ggMarginal(g, type = "histogram") 32 | 33 | y <- norm2likert(x, c(40, 30, 20, 10)) 34 | g <- ggplot2::ggplot() + ggplot2::geom_point(ggplot2::aes(x, y)) 35 | ggExtra::ggMarginal(g, type = "histogram") 36 | 37 | y <- norm2likert(x, c(lower = .5, upper = .5)) 38 | g <- ggplot2::ggplot() + ggplot2::geom_point(ggplot2::aes(x, y)) 39 | ggExtra::ggMarginal(g, type = "histogram") 40 | } 41 | -------------------------------------------------------------------------------- /man/norm2nbinom.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/distribution_convertors.R 3 | \name{norm2nbinom} 4 | \alias{norm2nbinom} 5 | \title{Convert normal to negative binomial} 6 | \usage{ 7 | norm2nbinom( 8 | x, 9 | size, 10 | prob, 11 | mu, 12 | lower.tail = TRUE, 13 | log.p = FALSE, 14 | x_mu = mean(x), 15 | x_sd = stats::sd(x) 16 | ) 17 | } 18 | \arguments{ 19 | \item{x}{the normally distributed vector} 20 | 21 | \item{size}{target for number of successful trials, or dispersion parameter (the shape parameter of the gamma mixing distribution). (size > 0)} 22 | 23 | \item{prob}{the probability of success on each trial (0 to 1)} 24 | 25 | \item{mu}{alternative parametrization via mean (only specify one of prob or mu)} 26 | 27 | \item{lower.tail}{logical; if TRUE (default), probabilities are P[$X <= x$], otherwise, P[$X > x$]} 28 | 29 | \item{log.p}{logical; if TRUE, probabilities p are given as log(p)} 30 | 31 | \item{x_mu}{the mean of x (calculated from x if not given)} 32 | 33 | \item{x_sd}{the SD of x (calculated from x if not given)} 34 | } 35 | \value{ 36 | a vector with a negative binomial distribution 37 | } 38 | \description{ 39 | See the help for `qnbinom()` for further info about prob versus mu parameter specification. Thanks for the suggested code, David Hugh-Jones! 40 | } 41 | \examples{ 42 | 43 | x <- rnorm(10000) 44 | y <- norm2nbinom(x, 1, prob = 0.5) 45 | z <- norm2nbinom(x, 1, mu = 1) 46 | g <- ggplot2::ggplot() + ggplot2::geom_point(ggplot2::aes(x, y)) 47 | ggExtra::ggMarginal(g, type = "histogram") 48 | 49 | } 50 | -------------------------------------------------------------------------------- /man/norm2norm.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/distribution_convertors.R 3 | \name{norm2norm} 4 | \alias{norm2norm} 5 | \title{Convert normal to normal} 6 | \usage{ 7 | norm2norm(x, mu = 0, sd = 1, x_mu = mean(x), x_sd = stats::sd(x)) 8 | } 9 | \arguments{ 10 | \item{x}{the uniformly distributed vector} 11 | 12 | \item{mu}{the mean of the normal distribution to return} 13 | 14 | \item{sd}{the SD of the normal distribution to return} 15 | 16 | \item{x_mu}{the mean of x (calculated from x if not given)} 17 | 18 | \item{x_sd}{the SD of x (calculated from x if not given)} 19 | } 20 | \value{ 21 | a vector with a gaussian distribution 22 | } 23 | \description{ 24 | Convert a normal distribution to a normal (gaussian) distribution with specified mu and sd 25 | } 26 | \examples{ 27 | 28 | x <- rnorm(10000) 29 | y <- norm2norm(x, 100, 10) 30 | g <- ggplot2::ggplot() + ggplot2::geom_point(ggplot2::aes(x, y)) 31 | ggExtra::ggMarginal(g, type = "histogram") 32 | 33 | } 34 | -------------------------------------------------------------------------------- /man/norm2pois.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/distribution_convertors.R 3 | \name{norm2pois} 4 | \alias{norm2pois} 5 | \title{Convert normal to poisson} 6 | \usage{ 7 | norm2pois(x, lambda, mu = mean(x), sd = stats::sd(x)) 8 | } 9 | \arguments{ 10 | \item{x}{the normally distributed vector} 11 | 12 | \item{lambda}{the mean of the distribution to return} 13 | 14 | \item{mu}{the mean of x (calculated from x if not given)} 15 | 16 | \item{sd}{the SD of x (calculated from x if not given)} 17 | } 18 | \value{ 19 | a vector with a poisson distribution 20 | } 21 | \description{ 22 | Convert normal to poisson 23 | } 24 | \examples{ 25 | 26 | x <- rnorm(10000) 27 | y <- norm2pois(x, 2) 28 | g <- ggplot2::ggplot() + ggplot2::geom_point(ggplot2::aes(x, y)) 29 | ggExtra::ggMarginal(g, type = "histogram") 30 | 31 | } 32 | -------------------------------------------------------------------------------- /man/norm2trunc.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/distribution_convertors.R 3 | \name{norm2trunc} 4 | \alias{norm2trunc} 5 | \title{Convert normal to truncated normal} 6 | \usage{ 7 | norm2trunc( 8 | x, 9 | min = -Inf, 10 | max = Inf, 11 | mu = mean(x), 12 | sd = stats::sd(x), 13 | x_mu = mean(x), 14 | x_sd = stats::sd(x) 15 | ) 16 | } 17 | \arguments{ 18 | \item{x}{the normally distributed vector} 19 | 20 | \item{min}{the minimum of the truncated distribution to return} 21 | 22 | \item{max}{the maximum of the truncated distribution to return} 23 | 24 | \item{mu}{the mean of the distribution to return (calculated from x if not given)} 25 | 26 | \item{sd}{the SD of the distribution to return (calculated from x if not given)} 27 | 28 | \item{x_mu}{the mean of x (calculated from x if not given)} 29 | 30 | \item{x_sd}{the SD of x (calculated from x if not given)} 31 | } 32 | \value{ 33 | a vector with a uniform distribution 34 | } 35 | \description{ 36 | Convert a normal (gaussian) distribution to a truncated normal distribution with specified minimum and maximum 37 | } 38 | \examples{ 39 | 40 | x <- rnorm(10000) 41 | y <- norm2trunc(x, 1, 7, 3.5, 2) 42 | g <- ggplot2::ggplot() + ggplot2::geom_point(ggplot2::aes(x, y)) 43 | ggExtra::ggMarginal(g, type = "histogram") 44 | 45 | } 46 | -------------------------------------------------------------------------------- /man/norm2unif.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/distribution_convertors.R 3 | \name{norm2unif} 4 | \alias{norm2unif} 5 | \title{Convert normal to uniform} 6 | \usage{ 7 | norm2unif(x, min = 0, max = 1, mu = mean(x), sd = stats::sd(x)) 8 | } 9 | \arguments{ 10 | \item{x}{the normally distributed vector} 11 | 12 | \item{min}{the minimum of the uniform distribution to return} 13 | 14 | \item{max}{the maximum of the uniform distribution to return} 15 | 16 | \item{mu}{the mean of x (calculated from x if not given)} 17 | 18 | \item{sd}{the SD of x (calculated from x if not given)} 19 | } 20 | \value{ 21 | a vector with a uniform distribution 22 | } 23 | \description{ 24 | Convert a normal (gaussian) distribution to a uniform distribution with specified minimum and maximum 25 | } 26 | \examples{ 27 | 28 | x <- rnorm(10000) 29 | y <- norm2unif(x) 30 | g <- ggplot2::ggplot() + ggplot2::geom_point(ggplot2::aes(x, y)) 31 | ggExtra::ggMarginal(g, type = "histogram") 32 | 33 | } 34 | -------------------------------------------------------------------------------- /man/pipe.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/utils-pipe.R 3 | \name{\%>\%} 4 | \alias{\%>\%} 5 | \title{Pipe operator} 6 | \usage{ 7 | lhs \%>\% rhs 8 | } 9 | \arguments{ 10 | \item{lhs}{A value or the magrittr placeholder.} 11 | 12 | \item{rhs}{A function call using the magrittr semantics.} 13 | } 14 | \value{ 15 | The result of applying the function in the rhs to the value in the lhs. 16 | } 17 | \description{ 18 | See \code{dplyr::\link[dplyr]{\%>\%}} for details. 19 | } 20 | \keyword{internal} 21 | -------------------------------------------------------------------------------- /man/plikert.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/distribution_convertors.R 3 | \name{plikert} 4 | \alias{plikert} 5 | \title{Likert distribution function} 6 | \usage{ 7 | plikert(q, prob, labels = names(prob)) 8 | } 9 | \arguments{ 10 | \item{q}{the vector of quantiles} 11 | 12 | \item{prob}{a vector of probabilities or counts; if named, the output is a factor} 13 | 14 | \item{labels}{a vector of values, defaults to names(prob) or 1:length(prob), if numeric, the output is numeric} 15 | } 16 | \value{ 17 | a vector of the densities 18 | } 19 | \description{ 20 | Likert distribution function 21 | } 22 | \examples{ 23 | q <- 1:5 24 | prob <- c(.1, .2, .4, .2, .1) 25 | plikert(q, prob) 26 | 27 | q <- c("A", "C", "B", "B") 28 | prob <- c(A = 10, B = 20, C = 30) 29 | plikert(q, prob) 30 | 31 | # specify labels if prob not named and not 1:length(prob) 32 | labels <- -2:2 33 | q <- labels 34 | prob <- rep(1, length(labels)) # uniform probability 35 | plikert(q, prob, labels) 36 | } 37 | -------------------------------------------------------------------------------- /man/plot_design.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/plot_design.R 3 | \name{plot_design} 4 | \alias{plot_design} 5 | \alias{plot.design} 6 | \alias{plot.faux} 7 | \title{Plot design} 8 | \usage{ 9 | plot_design(x, ..., geoms = NULL, palette = "Dark2", labeller = "label_value") 10 | 11 | \method{plot}{design}(x, ...) 12 | 13 | \method{plot}{faux}(x, ...) 14 | } 15 | \arguments{ 16 | \item{x}{A list of design parameters created by check_design() or a data tbl (in long format)} 17 | 18 | \item{...}{A list of factor names to determine visualisation (see vignette) in the order color, x, facet row(s), facet col(s)} 19 | 20 | \item{geoms}{A list of ggplot2 geoms to display, defaults to "pointrangeSD" (mean ± 1SD) for designs and c("violin", "box") for data, options are: pointrangeSD, pointrangeSE, violin, box, jitter} 21 | 22 | \item{palette}{A brewer palette, defaults to "Dark2" (see ggplot2::scale_colour_brewer)} 23 | 24 | \item{labeller}{How to label the facets (see ggplot2::facet_grid). "label_value" is used by default.} 25 | } 26 | \value{ 27 | plot 28 | } 29 | \description{ 30 | Plots the specified within and between design. See \href{../doc/plots.html}{\code{vignette("plots", package = "faux")}} for examples and details. 31 | } 32 | \section{Functions}{ 33 | \itemize{ 34 | \item \code{plot(design)}: Plotting from a faux design list 35 | 36 | \item \code{plot(faux)}: Plotting from a faux data table 37 | 38 | }} 39 | \examples{ 40 | 41 | within <- list(time = c("day", "night")) 42 | between <- list(pet = c("dog", "cat")) 43 | des <- check_design(within, between, plot = FALSE) 44 | plot_design(des) 45 | 46 | data <- sim_design(within, between, plot = FALSE) 47 | plot_design(data) 48 | 49 | } 50 | -------------------------------------------------------------------------------- /man/pos_def_limits.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/cormat.R 3 | \name{pos_def_limits} 4 | \alias{pos_def_limits} 5 | \title{Limits on Missing Value for Positive Definite Matrix} 6 | \usage{ 7 | pos_def_limits(..., steps = 0.01, tol = 1e-08) 8 | } 9 | \arguments{ 10 | \item{...}{the correlations among the variables as a vars\*(vars-1)/2 vector} 11 | 12 | \item{steps}{the tolerance for min and max values} 13 | 14 | \item{tol}{the tolerance for comparing eigenvalues to 0} 15 | } 16 | \value{ 17 | dataframe with min and max values 18 | } 19 | \description{ 20 | \code{pos_def_limits} returns min and max possible values for a positive definite matrix with a specified missing value 21 | } 22 | \examples{ 23 | pos_def_limits(.8, .2, NA) 24 | } 25 | -------------------------------------------------------------------------------- /man/print.design.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/check_design.R 3 | \name{print.design} 4 | \alias{print.design} 5 | \title{Print Design List} 6 | \usage{ 7 | \method{print}{design}(x, ...) 8 | } 9 | \arguments{ 10 | \item{x}{The design list} 11 | 12 | \item{...}{Additional parameters for print} 13 | } 14 | \value{ 15 | Prints x and returns it invisibly 16 | } 17 | \description{ 18 | Print Design List 19 | } 20 | \keyword{internal} 21 | -------------------------------------------------------------------------------- /man/print.nested_list.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/nested_list.R 3 | \name{print.nested_list} 4 | \alias{print.nested_list} 5 | \title{Print Nested List} 6 | \usage{ 7 | \method{print}{nested_list}(x, ...) 8 | } 9 | \arguments{ 10 | \item{x}{The nested_list string} 11 | 12 | \item{...}{Additional parameters for print} 13 | } 14 | \value{ 15 | Prints x and returns it invisibly 16 | } 17 | \description{ 18 | Print Nested List 19 | } 20 | \keyword{internal} 21 | -------------------------------------------------------------------------------- /man/print.psychds_codebook.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/codebook.R 3 | \name{print.psychds_codebook} 4 | \alias{print.psychds_codebook} 5 | \title{Print Codebook Object} 6 | \usage{ 7 | \method{print}{psychds_codebook}(x, ...) 8 | } 9 | \arguments{ 10 | \item{x}{The psychds_codebook list} 11 | 12 | \item{...}{Additional parameters for print} 13 | } 14 | \value{ 15 | Prints x and returns it invisibly 16 | } 17 | \description{ 18 | Print Codebook Object 19 | } 20 | \keyword{internal} 21 | -------------------------------------------------------------------------------- /man/qlikert.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/distribution_convertors.R 3 | \name{qlikert} 4 | \alias{qlikert} 5 | \title{Likert quantile function} 6 | \usage{ 7 | qlikert(p, prob, labels = names(prob)) 8 | } 9 | \arguments{ 10 | \item{p}{the vector of probabilities} 11 | 12 | \item{prob}{a vector of probabilities or counts; if named, the output is a factor} 13 | 14 | \item{labels}{a vector of values, defaults to names(prob) or 1:length(prob), if numeric, the output is numeric} 15 | } 16 | \value{ 17 | a vector of the quantiles 18 | } 19 | \description{ 20 | Likert quantile function 21 | } 22 | \examples{ 23 | p <- seq(0, 1, .1) 24 | prob <- c(.1, .2, .4, .2, .1) 25 | qlikert(p, prob) 26 | 27 | p <- seq(0, 1, .1) 28 | prob <- c(A = 10, B = 20, C = 30) 29 | qlikert(p, prob) 30 | 31 | # specify labels if prob not named and not 1:length(prob) 32 | labels <- -2:2 33 | p <- seq(0, 1, .1) 34 | prob <- rep(1, length(labels)) # uniform probability 35 | qlikert(p, prob, labels) 36 | } 37 | -------------------------------------------------------------------------------- /man/readline_check.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/readline_check.R 3 | \name{readline_check} 4 | \alias{readline_check} 5 | \title{Check readline input} 6 | \usage{ 7 | readline_check( 8 | prompt, 9 | type = c("numeric", "integer", "length", "grep"), 10 | min = -Inf, 11 | max = Inf, 12 | warning = NULL, 13 | default = NULL, 14 | ... 15 | ) 16 | } 17 | \arguments{ 18 | \item{prompt}{the prompt for readline} 19 | 20 | \item{type}{what type of check to perform, one of c("numeric", "integer", "length", "grep")} 21 | 22 | \item{min}{the minimum value} 23 | 24 | \item{max}{the maximum value} 25 | 26 | \item{warning}{an optional custom warning message} 27 | 28 | \item{default}{the default option to return if the entry is blank, NULL allows no default, the default value will be displayed after the text as [default]} 29 | 30 | \item{...}{other arguments to pass to grep} 31 | } 32 | \value{ 33 | the validated result of readline 34 | } 35 | \description{ 36 | Check readline input 37 | } 38 | \examples{ 39 | if(interactive()){ 40 | readline_check("Type a number: ", "numeric") 41 | readline_check("Type two characters: ", "length", min = 2, max = 2) 42 | readline_check("Type at least 3 characters: ", "length", min = 3) 43 | readline_check("Type no more than 4 characters: ", "length", max = 44) 44 | readline_check("Type a letter and a number: ", "grep", pattern = "^[a-zA-Z]\\\\d$") 45 | } 46 | } 47 | -------------------------------------------------------------------------------- /man/rlikert.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/distribution_convertors.R 3 | \name{rlikert} 4 | \alias{rlikert} 5 | \title{Random Likert distribution} 6 | \usage{ 7 | rlikert(n, prob, labels = names(prob)) 8 | } 9 | \arguments{ 10 | \item{n}{the number of observations} 11 | 12 | \item{prob}{a vector of probabilities or counts; if named, the output is a factor} 13 | 14 | \item{labels}{a vector of values, defaults to names(prob) or 1:length(prob), if numeric, the output is numeric} 15 | } 16 | \value{ 17 | a vector sampled from a likert distribution with the specified parameters 18 | } 19 | \description{ 20 | Random Likert distribution 21 | } 22 | \examples{ 23 | # no names or labels returns integer vector of values 1:length(prob) 24 | prob <- c(.1, .2, .4, .2, .1) 25 | rlikert(10, prob) 26 | 27 | # named prob returns factor 28 | prob <- c(A = 10, B = 20, C = 30) 29 | rlikert(10, prob) 30 | 31 | # specify labels if prob not named and not 1:length(prob) 32 | labels <- -2:2 33 | prob <- rep(1, length(labels)) # uniform probability 34 | rlikert(10, prob, labels) 35 | } 36 | -------------------------------------------------------------------------------- /man/rmulti.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/norta.R 3 | \name{rmulti} 4 | \alias{rmulti} 5 | \title{Multiple correlated distributions} 6 | \usage{ 7 | rmulti( 8 | n = 100, 9 | dist = c(A = "norm", B = "norm"), 10 | params = list(), 11 | r = 0, 12 | empirical = FALSE, 13 | as.matrix = FALSE 14 | ) 15 | } 16 | \arguments{ 17 | \item{n}{the number of samples required} 18 | 19 | \item{dist}{A named vector of the distributions of each variable} 20 | 21 | \item{params}{A list of lists of the arguments to pass to each distribution function} 22 | 23 | \item{r}{the correlations among the variables (can be a single number, vars\*vars matrix, vars\*vars vector, or a vars\*(vars-1)/2 vector)} 24 | 25 | \item{empirical}{logical. If true, params specify the sample parameters, not the population parameters} 26 | 27 | \item{as.matrix}{logical. If true, returns a matrix} 28 | } 29 | \value{ 30 | a tbl of vars vectors 31 | } 32 | \description{ 33 | Multiple correlated distributions 34 | } 35 | \examples{ 36 | dist <- c(A = "norm", 37 | B = "pois", 38 | C = "binom") 39 | params <- list(A = list(mean = 100, sd = 10), 40 | B = list(lambda = 5), 41 | C = list(size = 10, prob = 0.5)) 42 | x <- rmulti(100, dist, params, c(0.2, 0.4, 0.6), empirical = TRUE) 43 | get_params(x) 44 | } 45 | -------------------------------------------------------------------------------- /man/rnorm_multi.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/rnorm_multi.R 3 | \name{rnorm_multi} 4 | \alias{rnorm_multi} 5 | \title{Multiple correlated normal distributions} 6 | \usage{ 7 | rnorm_multi( 8 | n = 100, 9 | vars = NULL, 10 | mu = 0, 11 | sd = 1, 12 | r = 0, 13 | varnames = NULL, 14 | empirical = FALSE, 15 | as.matrix = FALSE, 16 | seed = NULL 17 | ) 18 | } 19 | \arguments{ 20 | \item{n}{the number of samples required} 21 | 22 | \item{vars}{the number of variables to return} 23 | 24 | \item{mu}{a vector giving the means of the variables (numeric vector of length 1 or vars)} 25 | 26 | \item{sd}{the standard deviations of the variables (numeric vector of length 1 or vars)} 27 | 28 | \item{r}{the correlations among the variables (can be a single number, vars\*vars matrix, vars\*vars vector, or a vars\*(vars-1)/2 vector)} 29 | 30 | \item{varnames}{optional names for the variables (string vector of length vars) defaults if r is a matrix with column names} 31 | 32 | \item{empirical}{logical. If true, mu, sd and r specify the empirical not population mean, sd and covariance} 33 | 34 | \item{as.matrix}{logical. If true, returns a matrix} 35 | 36 | \item{seed}{DEPRECATED use set.seed() instead before running this function} 37 | } 38 | \value{ 39 | a tbl of vars vectors 40 | } 41 | \description{ 42 | Make normally distributed vectors with specified relationships. See \href{../doc/rnorm_multi.html}{\code{vignette("rnorm_multi", package = "faux")}} for details. 43 | } 44 | \examples{ 45 | # 4 10-item vectors each correlated r = .5 46 | rnorm_multi(10, 4, r = 0.5) 47 | 48 | # set r with the upper right triangle 49 | b <- rnorm_multi(100, 3, c(0, .5, 1), 1, 50 | r = c(0.2, -0.5, 0.5), 51 | varnames=c("A", "B", "C")) 52 | cor(b) 53 | 54 | # set r with a correlation matrix and column names from mu names 55 | c <- rnorm_multi( 56 | n = 100, 57 | mu = c(A = 0, B = 0.5, C = 1), 58 | r = c( 1, 0.2, -0.5, 59 | 0.2, 1, 0.5, 60 | -0.5, 0.5, 1) 61 | ) 62 | cor(c) 63 | 64 | } 65 | -------------------------------------------------------------------------------- /man/rnorm_pre.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/rnorm_pre.R 3 | \name{rnorm_pre} 4 | \alias{rnorm_pre} 5 | \title{Make a normal vector correlated to existing vectors} 6 | \usage{ 7 | rnorm_pre(x, mu = 0, sd = 1, r = 0, empirical = FALSE, threshold = 1e-12) 8 | } 9 | \arguments{ 10 | \item{x}{the existing vector or data table of all vectors} 11 | 12 | \item{mu}{desired mean of returned vector} 13 | 14 | \item{sd}{desired SD of returned vector} 15 | 16 | \item{r}{desired correlation(s) between existing and returned vectors} 17 | 18 | \item{empirical}{logical. If true, mu, sd and r specify the empirical not population mean, sd and covariance} 19 | 20 | \item{threshold}{for checking correlation matrix} 21 | } 22 | \value{ 23 | vector 24 | } 25 | \description{ 26 | \code{rnorm_pre} Produces a random normally distributed vector with the specified correlation to one or more existing vectors 27 | } 28 | \examples{ 29 | v1 <- rnorm(10) 30 | v2 <- rnorm_pre(v1, 0, 1, 0.5) 31 | cor(v1, v2) 32 | 33 | x <- rnorm_multi(50, 2, .5) 34 | x$y <- rnorm_pre(x, r = c(0.5, 0.25)) 35 | cor(x) 36 | } 37 | -------------------------------------------------------------------------------- /man/sample_from_pop.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/rnorm_pre.R 3 | \name{sample_from_pop} 4 | \alias{sample_from_pop} 5 | \title{Sample Parameters from Population Parameters} 6 | \usage{ 7 | sample_from_pop(n = 100, mu = 0, sd = 1, r = 0) 8 | } 9 | \arguments{ 10 | \item{n}{sample size} 11 | 12 | \item{mu}{population mean} 13 | 14 | \item{sd}{population SD} 15 | 16 | \item{r}{population r} 17 | } 18 | \value{ 19 | list of sample parameters (mu, sd, r) 20 | } 21 | \description{ 22 | Sample Parameters from Population Parameters 23 | } 24 | \examples{ 25 | sample_from_pop(10) 26 | } 27 | -------------------------------------------------------------------------------- /man/set_design.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/check_design.R 3 | \name{set_design} 4 | \alias{set_design} 5 | \title{Set design} 6 | \usage{ 7 | set_design(data, design) 8 | } 9 | \arguments{ 10 | \item{data}{The data table} 11 | 12 | \item{design}{The design list} 13 | } 14 | \value{ 15 | A data frame with a design attribute 16 | } 17 | \description{ 18 | Add a design specification to a data table 19 | } 20 | \examples{ 21 | design <- check_design() 22 | data <- data.frame(id = 1:100, y = rnorm(100)) \%>\% 23 | set_design(design) 24 | } 25 | -------------------------------------------------------------------------------- /man/sim_data.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/sim_design.R 3 | \name{sim_data} 4 | \alias{sim_data} 5 | \title{Simulate data from design (internal)} 6 | \usage{ 7 | sim_data( 8 | design, 9 | empirical = FALSE, 10 | long = faux_options("long"), 11 | rep = 1, 12 | nested = TRUE, 13 | seed = NULL 14 | ) 15 | } 16 | \arguments{ 17 | \item{design}{A list of design parameters created by check_design()} 18 | 19 | \item{empirical}{logical. If true, mu, sd and r specify the empirical not population mean, sd and covariance} 20 | 21 | \item{long}{Whether the returned tbl is in wide (default = FALSE) or long (TRUE) format} 22 | 23 | \item{rep}{the number of data frames to return (default 1); if greater than 1, the returned data frame is nested by rep} 24 | 25 | \item{nested}{Whether to nest data frames by rep if rep > 1} 26 | 27 | \item{seed}{DEPRECATED use set.seed() instead before running this function} 28 | } 29 | \value{ 30 | a tbl 31 | } 32 | \description{ 33 | Simulate data from design (internal) 34 | } 35 | \keyword{internal} 36 | -------------------------------------------------------------------------------- /man/sim_design.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/sim_design.R 3 | \name{sim_design} 4 | \alias{sim_design} 5 | \title{Simulate data from design} 6 | \usage{ 7 | sim_design( 8 | within = list(), 9 | between = list(), 10 | n = 100, 11 | mu = 0, 12 | sd = 1, 13 | r = 0, 14 | empirical = FALSE, 15 | long = faux_options("long"), 16 | dv = list(y = "value"), 17 | id = list(id = "id"), 18 | vardesc = list(), 19 | plot = faux_options("plot"), 20 | interactive = FALSE, 21 | design = NULL, 22 | rep = 1, 23 | nested = TRUE, 24 | seed = NULL, 25 | sep = faux_options("sep") 26 | ) 27 | } 28 | \arguments{ 29 | \item{within}{a list of the within-subject factors} 30 | 31 | \item{between}{a list of the between-subject factors} 32 | 33 | \item{n}{the number of samples required} 34 | 35 | \item{mu}{the means of the variables} 36 | 37 | \item{sd}{the standard deviations of the variables} 38 | 39 | \item{r}{the correlations among the variables (can be a single number, full correlation matrix as a matrix or vector, or a vector of the upper right triangle of the correlation matrix} 40 | 41 | \item{empirical}{logical. If true, mu, sd and r specify the empirical not population mean, sd and covariance} 42 | 43 | \item{long}{Whether the returned tbl is in wide or long format (defaults to value of `faux_options("long")`)} 44 | 45 | \item{dv}{the name of the dv for long plots (defaults to y)} 46 | 47 | \item{id}{the name of the id column (defaults to id)} 48 | 49 | \item{vardesc}{a list of variable descriptions having the names of the within- and between-subject factors} 50 | 51 | \item{plot}{whether to show a plot of the design} 52 | 53 | \item{interactive}{whether to run the function interactively} 54 | 55 | \item{design}{a design list including within, between, n, mu, sd, r, dv, id, and vardesc} 56 | 57 | \item{rep}{the number of data frames to return (default 1); if greater than 1, the returned data frame is nested by rep (if nested = TRUE)} 58 | 59 | \item{nested}{Whether to nest data frames by rep if rep > 1} 60 | 61 | \item{seed}{DEPRECATED use set.seed() instead before running this function} 62 | 63 | \item{sep}{separator for factor levels} 64 | } 65 | \value{ 66 | a tbl 67 | } 68 | \description{ 69 | Generates a data table with a specified within and between design. See \href{https://debruine.github.io/faux/articles/sim_design.html}{\code{vignette("sim_design", package = "faux")}} for examples and details. 70 | } 71 | -------------------------------------------------------------------------------- /man/sim_df.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/sim_df.R 3 | \name{sim_df} 4 | \alias{sim_df} 5 | \title{Simulate an existing dataframe} 6 | \usage{ 7 | sim_df( 8 | data, 9 | n = 100, 10 | within = c(), 11 | between = c(), 12 | id = "id", 13 | dv = "value", 14 | empirical = FALSE, 15 | long = faux_options("long"), 16 | seed = NULL, 17 | missing = FALSE, 18 | sep = faux_options("sep") 19 | ) 20 | } 21 | \arguments{ 22 | \item{data}{the existing tbl} 23 | 24 | \item{n}{the number of samples to return per group} 25 | 26 | \item{within}{a list of the within-subject factor columns (if long format)} 27 | 28 | \item{between}{a list of the between-subject factor columns} 29 | 30 | \item{id}{the names of the column(s) for grouping observations} 31 | 32 | \item{dv}{the name of the DV (value) column} 33 | 34 | \item{empirical}{Should the returned data have these exact parameters? (versus be sampled from a population with these parameters)} 35 | 36 | \item{long}{whether to return the data table in long format} 37 | 38 | \item{seed}{DEPRECATED use set.seed() instead before running this function} 39 | 40 | \item{missing}{simulate missing data?} 41 | 42 | \item{sep}{separator for factor levels} 43 | } 44 | \value{ 45 | a tbl 46 | } 47 | \description{ 48 | Produces a data table with the same distributions and correlations 49 | as an existing data table Only returns numeric columns and simulates all numeric variables from a continuous normal distribution (for now). 50 | } 51 | \details{ 52 | See \href{../doc/sim_df.html}{\code{vignette("sim_df", package = "faux")}} for details. 53 | } 54 | \examples{ 55 | iris100 <- sim_df(iris, 100) 56 | iris_species <- sim_df(iris, 100, between = "Species") 57 | 58 | # set the names of within factors and (the separator character) 59 | # if you want to return a long version 60 | longdf <- sim_df(iris, 61 | between = "Species", 62 | within = c("type", "dim"), 63 | sep = ".", 64 | long = TRUE) 65 | 66 | # or if you are simulating data from a table in long format 67 | widedf <- sim_df(longdf, 68 | between = "Species", 69 | within = c("type", "dim"), 70 | sep = ".") 71 | } 72 | -------------------------------------------------------------------------------- /man/sim_joint_dist.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/sim_joint_dist.R 3 | \name{sim_joint_dist} 4 | \alias{sim_joint_dist} 5 | \title{Simulate category joint distribution} 6 | \usage{ 7 | sim_joint_dist(data, ..., n = 100, empirical = FALSE) 8 | } 9 | \arguments{ 10 | \item{data}{the existing tbl} 11 | 12 | \item{...}{columns to calculate the joint distribution from, if none are chosen, all columns with 10 or fewer unique values will be chosen} 13 | 14 | \item{n}{the number of total observations to return} 15 | 16 | \item{empirical}{Should the returned data have the exact same distribution of conditions? (versus be sampled from a population with this distribution)} 17 | } 18 | \value{ 19 | data table 20 | } 21 | \description{ 22 | This function is mainly used internally, such as for simulating missing data patterns, but is available in case anyone finds it useful. 23 | } 24 | \examples{ 25 | sim_joint_dist(ggplot2::diamonds, cut, color, n = 10) 26 | } 27 | -------------------------------------------------------------------------------- /man/sim_mixed_cc.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/sim_mixed_cc.R 3 | \name{sim_mixed_cc} 4 | \alias{sim_mixed_cc} 5 | \title{Generate a cross-classified sample} 6 | \usage{ 7 | sim_mixed_cc( 8 | sub_n = 100, 9 | item_n = 20, 10 | grand_i = 0, 11 | sub_sd = 1, 12 | item_sd = 1, 13 | error_sd = 1, 14 | empirical = FALSE, 15 | seed = NULL 16 | ) 17 | } 18 | \arguments{ 19 | \item{sub_n}{the number of subjects} 20 | 21 | \item{item_n}{the number of items} 22 | 23 | \item{grand_i}{the grand intercept (overall mean)} 24 | 25 | \item{sub_sd}{the SD of subject random intercepts (or a sub_n-length named vector of random intercepts for each subject)} 26 | 27 | \item{item_sd}{the SD of item random intercepts (or an item_n-length named vector of random intercepts for each item)} 28 | 29 | \item{error_sd}{the SD of the error term} 30 | 31 | \item{empirical}{Should the returned data have these exact parameters? (versus be sampled from a population with these parameters)} 32 | 33 | \item{seed}{DEPRECATED use set.seed() instead before running this function} 34 | } 35 | \value{ 36 | a tbl 37 | } 38 | \description{ 39 | Makes a basic cross-classified design with random intercepts for subjects and items. See \href{../doc/sim_mixed.html}{\code{vignette("sim_mixed", package = "faux")}} for examples and details. 40 | } 41 | \examples{ 42 | 43 | sim_mixed_cc(10, 10) 44 | } 45 | -------------------------------------------------------------------------------- /man/sim_mixed_df.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/sim_mixed_df.R 3 | \name{sim_mixed_df} 4 | \alias{sim_mixed_df} 5 | \title{Generate a mixed design from existing data} 6 | \usage{ 7 | sim_mixed_df( 8 | data, 9 | sub_n = NULL, 10 | item_n = NULL, 11 | dv = "y", 12 | sub_id = "sub_id", 13 | item_id = "item_id" 14 | ) 15 | } 16 | \arguments{ 17 | \item{data}{the existing tbl} 18 | 19 | \item{sub_n}{the number of subjects to simulate (if NULL, returns data for the same subjects)} 20 | 21 | \item{item_n}{the number of items to simulate (if NULL, returns data for the same items)} 22 | 23 | \item{dv}{the column name or index containing the DV} 24 | 25 | \item{sub_id}{the column name or index for the subject IDs} 26 | 27 | \item{item_id}{the column name or index for the item IDs} 28 | } 29 | \value{ 30 | a tbl 31 | } 32 | \description{ 33 | \code{sim_mixed_df()} produces a data table with the same distributions of 34 | by-subject and by-item random intercepts as an existing data table. 35 | } 36 | \examples{ 37 | \donttest{sim_mixed_df(faceratings, 10, 10, "rating", "rater_id", "face_id")} 38 | } 39 | -------------------------------------------------------------------------------- /man/std_alpha2average_r.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/distribution_convertors.R 3 | \name{std_alpha2average_r} 4 | \alias{std_alpha2average_r} 5 | \title{Standardized Alpha to Average R} 6 | \usage{ 7 | std_alpha2average_r(std_alpha, n) 8 | } 9 | \arguments{ 10 | \item{std_alpha}{The standarized alpha} 11 | 12 | \item{n}{The number of items} 13 | } 14 | \value{ 15 | The average inter-item correlation 16 | } 17 | \description{ 18 | Standardized Alpha to Average R 19 | } 20 | \examples{ 21 | std_alpha2average_r(.8, 10) 22 | } 23 | -------------------------------------------------------------------------------- /man/trunc2norm.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/distribution_convertors.R 3 | \name{trunc2norm} 4 | \alias{trunc2norm} 5 | \title{Convert truncated normal to normal} 6 | \usage{ 7 | trunc2norm(x, min = NULL, max = NULL, mu = mean(x), sd = stats::sd(x)) 8 | } 9 | \arguments{ 10 | \item{x}{the truncated normally distributed vector} 11 | 12 | \item{min}{the minimum of the truncated distribution (calculated from x if not given)} 13 | 14 | \item{max}{the maximum of the truncated distribution (calculated from x if not given)} 15 | 16 | \item{mu}{the mean of the distribution to return (calculated from x if not given)} 17 | 18 | \item{sd}{the SD of the distribution to return (calculated from x if not given)} 19 | } 20 | \value{ 21 | a vector with a uniform distribution 22 | } 23 | \description{ 24 | Convert a truncated normal distribution to a normal (gaussian) distribution 25 | } 26 | \examples{ 27 | 28 | x <- truncnorm::rtruncnorm(10000, 1, 7, 3.5, 2) 29 | y <- trunc2norm(x, 1, 7) 30 | g <- ggplot2::ggplot() + ggplot2::geom_point(ggplot2::aes(x, y)) 31 | ggExtra::ggMarginal(g, type = "histogram") 32 | 33 | } 34 | -------------------------------------------------------------------------------- /man/unif2norm.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/distribution_convertors.R 3 | \name{unif2norm} 4 | \alias{unif2norm} 5 | \title{Convert uniform to normal} 6 | \usage{ 7 | unif2norm(x, mu = 0, sd = 1, min = NULL, max = NULL) 8 | } 9 | \arguments{ 10 | \item{x}{the uniformly distributed vector} 11 | 12 | \item{mu}{the mean of the normal distribution to return} 13 | 14 | \item{sd}{the SD of the normal distribution to return} 15 | 16 | \item{min}{the minimum possible value of x (calculated from x if not given)} 17 | 18 | \item{max}{the maximum possible value of x (calculated from x if not given)} 19 | } 20 | \value{ 21 | a vector with a gaussian distribution 22 | } 23 | \description{ 24 | Convert a uniform distribution to a normal (gaussian) distribution with specified mu and sd 25 | } 26 | \examples{ 27 | 28 | x <- runif(10000) 29 | y <- unif2norm(x) 30 | g <- ggplot2::ggplot() + ggplot2::geom_point(ggplot2::aes(x, y)) 31 | ggExtra::ggMarginal(g, type = "histogram") 32 | 33 | } 34 | -------------------------------------------------------------------------------- /man/unique_pairs.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/interactive.R 3 | \name{unique_pairs} 4 | \alias{unique_pairs} 5 | \title{Make unique pairs of level names for correlations} 6 | \usage{ 7 | unique_pairs(v) 8 | } 9 | \arguments{ 10 | \item{v}{a vector of level names or a number of levels} 11 | } 12 | \value{ 13 | a vector of all unique pairs 14 | } 15 | \description{ 16 | Make unique pairs of level names for correlations 17 | } 18 | \examples{ 19 | unique_pairs(c("O", "C", "E", "A", "N")) 20 | unique_pairs(3) 21 | } 22 | -------------------------------------------------------------------------------- /man/wide2long.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/wide2long.R 3 | \name{wide2long} 4 | \alias{wide2long} 5 | \title{Convert data from wide to long format} 6 | \usage{ 7 | wide2long( 8 | data, 9 | within_factors = c(), 10 | within_cols = c(), 11 | dv = "y", 12 | id = "id", 13 | sep = faux_options("sep") 14 | ) 15 | } 16 | \arguments{ 17 | \item{data}{the tbl in wide format} 18 | 19 | \item{within_factors}{the names of the within factors} 20 | 21 | \item{within_cols}{the names (or indices) of the within-subject (value) columns} 22 | 23 | \item{dv}{the name of the dv column (defaults to "y")} 24 | 25 | \item{id}{the name of the ID column(s) if they don't exist, a new column will be made (defaults to ("id")} 26 | 27 | \item{sep}{separator for within-columns (to be used in strsplit, so can be regex), defaults to "_"} 28 | } 29 | \value{ 30 | a tbl in long format 31 | } 32 | \description{ 33 | Convert data from wide to long format 34 | } 35 | \examples{ 36 | wide2long(iris, c("Feature", "Measure"), 1:4, sep = "\\\\.") 37 | 38 | } 39 | -------------------------------------------------------------------------------- /mess/codebook.Rmd: -------------------------------------------------------------------------------- 1 | --- 2 | title: "Codebook" 3 | output: rmarkdown::html_vignette 4 | vignette: > 5 | %\VignetteIndexEntry{Codebook} 6 | %\VignetteEngine{knitr::rmarkdown} 7 | %\VignetteEncoding{UTF-8} 8 | --- 9 | 10 | ```{r, include = FALSE} 11 | knitr::opts_chunk$set( 12 | collapse = TRUE, 13 | comment = "#>" 14 | ) 15 | ``` 16 | 17 | ```{r setup} 18 | library(faux) 19 | ``` 20 | 21 | The `codebook()` function creates a [PyschDS]()-formatted codebook from your data. 22 | 23 | ```{r} 24 | between <- list( 25 | pet = c(cat = "Has a cat", dog = "Has a dog") 26 | ) 27 | within <- list( 28 | time = c("day", "night") 29 | ) 30 | df <- sim_design(within, between, 31 | mu = 1:4, sd = 1, 32 | dv = "score", 33 | long = TRUE) 34 | ``` 35 | 36 | Just running `codebook(df)` gives you a basic codebook generated from the data in your data frame. 37 | 38 | ```{r} 39 | codebook(df) 40 | ``` 41 | 42 | If you want to give more into about the columns, describe the columns using a named vector. 43 | 44 | ```{r} 45 | 46 | coldesc <- c(id = "Participant ID", 47 | pet = "Kind of pet this participant has", 48 | time = "Time of day tested", 49 | score = "Score on a happiness questionnaire") 50 | 51 | codebook(df, coldesc) 52 | ``` 53 | 54 | If you set `interactive = TRUE` and run the command in the console (not in an Rmd script), you will be prompted to name each column and factor level. 55 | 56 | ```{r, eval = FALSE} 57 | cb <- codebook(df, interactive = TRUE) 58 | ``` 59 | 60 | 61 | -------------------------------------------------------------------------------- /mess/dist_test.R: -------------------------------------------------------------------------------- 1 | #devtools::install_github("debruine/faux") 2 | library(faux) 3 | 4 | # compare the correlations between simulated normally distributed data and the likert-scale version 5 | check_likert <- function(n = 100, r = 0.5, 6 | prob = c(.05, .1, .2, .3, .2, .1, .05)) { 7 | df <- faux::rnorm_multi(n, 2, 0, 1, r) %>% 8 | dplyr::mutate( 9 | L1 = norm2likert(X1, prob, 0, 1), 10 | L2 = norm2likert(X2, prob, 0, 1) 11 | ) 12 | list(norm = cor(df$X1, df$X2), 13 | likert = cor(df$L1, df$L2)) 14 | } 15 | 16 | # compare the correlations between simulated normally distributed data and the truncated version 17 | check_trunc <- function(n = 100, mu = 0, sd = 1, r = 0.5, 18 | min = -Inf, max = Inf) { 19 | df <- rnorm_multi(n, 2, mu, sd, r) %>% 20 | dplyr::mutate( 21 | T1 = norm2trunc(X1, min, max, mu, sd), 22 | T2 = norm2trunc(X2, min, max, mu, sd) 23 | ) 24 | list(norm = cor(df$X1, df$X2), 25 | trunc = cor(df$T1, df$T2)) 26 | } 27 | 28 | # symmetric normal-ish likert distribution 29 | x <- purrr::map_df(1:1000, ~check_likert()) 30 | plot(x$norm, x$likert) 31 | cor(x$norm, x$likert) 32 | 33 | # symmetric low-n likert 34 | x <- purrr::map_df(1:1000, ~check_likert(prob = c(.1, .2, .4, .2, .1))) 35 | plot(x$norm, x$likert) 36 | cor(x$norm, x$likert) 37 | 38 | # asymmetric likert 39 | x <- purrr::map_df(1:1000, ~check_likert(prob = c(.05, .1, .15, .2, .2, .25, .05))) 40 | plot(x$norm, x$likert) 41 | cor(x$norm, x$likert) 42 | 43 | # asymmetric low-n likert 44 | x <- purrr::map_df(1:1000, ~check_likert(prob = c(.1, .2, .3, .4))) 45 | plot(x$norm, x$likert) 46 | cor(x$norm, x$likert) 47 | 48 | # truncated to 1 SD 49 | x <- purrr::map_df(1:1000, ~check_trunc()) 50 | plot(x$norm, x$trunc) 51 | cor(x$norm, x$trunc) 52 | 53 | # truncated to N(3.5, 2) to 1-7 54 | x <- purrr::map_df(1:1000, ~check_trunc(100, 3.5, 2, 0.5, 1, 7)) 55 | plot(x$norm, x$trunc) 56 | cor(x$norm, x$trunc) 57 | 58 | 59 | ## check limits of typical rtruncnorm by n 60 | library(ggplot2) 61 | 62 | ns <- c(seq(10, 90, 10), seq(100, 1000, 100), seq(2000, 10000, 1000)) 63 | y <- purrr::map_df(rep(ns, 1000), function(n) { 64 | x <- truncnorm::rtruncnorm(n) 65 | list(n = n, min = min(x), max = max(x)) 66 | }) 67 | 68 | y %>% 69 | dplyr::group_by(n) %>% 70 | dplyr::summarise( 71 | mean_min = mean(min), 72 | sd_min = sd(min), 73 | mean_max = mean(max), 74 | sd_max = sd(max) 75 | ) %>% 76 | tidyr::gather(stat, val, mean_min:sd_max) %>% 77 | tidyr::separate(stat, c("stat", "minmax")) %>% 78 | ggplot(aes(n, val, color = minmax)) + 79 | geom_line() + 80 | facet_wrap(~stat) 81 | 82 | y %>% 83 | tidyr::gather(stat, val, min:max) %>% 84 | ggplot(aes(log2(n), val, color = stat)) + 85 | stat_summary( 86 | fun = mean, 87 | fun.max = function(x) {mean(x) + sd(x)}, 88 | fun.min = function(x) {mean(x) - sd(x)}, 89 | geom="pointrange" 90 | ) + 91 | ylim(-4, 4) 92 | 93 | lm(max ~ log2(n), data = y) %>% coef() 94 | lm(min ~ log2(n), data = y) %>% coef() 95 | 96 | n <- 100 97 | mu <- 0 98 | sd <- 1 99 | min <- mu - (1.5*sd + 0.22*sd*log2(n)) 100 | max <- mu + (1.5*sd + 0.22*sd*log2(n)) 101 | -------------------------------------------------------------------------------- /mess/faux2ANOVA_design.R: -------------------------------------------------------------------------------- 1 | #' Convert faux design to Superpower ANOVA_design 2 | #' 3 | #' @param design faux design list (e.g., from check_design) 4 | #' @param plot whether to show the plot from Superpower::ANOVA_design 5 | #' 6 | #' @return a design list for Superpower 7 | #' @export 8 | #' 9 | #' @examples 10 | #' within <- list(pet = c(dog = "Dog Owners", cat = "Cat Owners")) 11 | #' between <- list(time = c("day" = "Before 7pm", "night" = "After 7pm")) 12 | #' faux_des <- check_design(within, between, n = 50, mu = 1:4, sd = 2, r = 0.5) 13 | #' apower_des <- faux2ANOVA_design(faux_des) 14 | #' 15 | faux2ANOVA_design <- function(design, plot = TRUE) { 16 | if (!requireNamespace("Superpower", quietly = TRUE)) { 17 | stop("Package \"Superpower\" needed for this function to work. Please install it.", 18 | call. = FALSE) 19 | } 20 | 21 | factors <- c(design$between, design$within) 22 | if (length(factors) < 1) { 23 | stop("You need at least one factor to use Superpower") 24 | } else if (length(factors) > 3) { 25 | stop("You can't use Superpower with more than 3 factors") 26 | } 27 | 28 | b <- design$between %>% lapply(length) %>% lapply(paste0, "b") 29 | w <- design$within %>% lapply(length) %>% lapply(paste0, "w") 30 | string <- c(b, w) %>% paste(collapse = "*") 31 | 32 | # warn about n 33 | n <- design$n %>% unlist() %>% unique() 34 | if (length(n) > 1) { 35 | n <- design$n %>% unlist() %>% mean() %>% round() 36 | warning("Your design has different n for the between-subject factors. Superpower does not support this, so will use the mean n of ", n) 37 | } 38 | 39 | # labelnames 40 | ln <- c() 41 | for (i in 1:length(factors)) { 42 | fctr <- names(factors)[i] 43 | lvls <- names(factors[[i]]) 44 | ln <- c(ln, fctr, lvls) 45 | } 46 | 47 | # correlation matrix 48 | n_cells <- lapply(factors, length) %>% unlist() %>% prod() 49 | big_r <- matrix(rep(0, n_cells^2), nrow = n_cells) 50 | 51 | if (length(design$r)) { # skip if no within-subject factors 52 | for (i in 1:length(design$r)) { 53 | mat <- design$r[[i]] 54 | offset <- (i-1) * nrow(mat) 55 | for (r in 1:nrow(mat)) { 56 | for (c in 1:ncol(mat)) { 57 | big_r[(r+offset), (c+offset)] <- mat[r, c] 58 | } 59 | } 60 | } 61 | } 62 | 63 | ap <- list( 64 | design = string, 65 | n = n[[1]], # update when they vary n 66 | mu = unlist(design$mu) %>% unname(), 67 | sd = unlist(design$sd) %>% unname(), 68 | r = big_r[upper.tri(big_r, diag = FALSE)], 69 | labelnames = ln, 70 | plot = plot 71 | ) 72 | 73 | do.call(Superpower::ANOVA_design, ap) 74 | } 75 | -------------------------------------------------------------------------------- /mess/sims: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/debruine/faux/94dc8cecd26f1a5c7c0a1574ac648d04b0cddcfe/mess/sims -------------------------------------------------------------------------------- /mess/sims.rds: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/debruine/faux/94dc8cecd26f1a5c7c0a1574ac648d04b0cddcfe/mess/sims.rds -------------------------------------------------------------------------------- /mess/speed_tests.R: -------------------------------------------------------------------------------- 1 | library(faux) 2 | library(tidyverse) 3 | 4 | 5 | # speed test ---- 6 | 7 | 8 | within <- list( 9 | "W" = c("W1", "W2"), 10 | "X" = c("X1", "X2") 11 | ) 12 | 13 | between <- list() 14 | 15 | mu <- c(W1_X1 = 10, W1_X2 = 12, W2_X1 = 10, W2_X2 = 10) 16 | 17 | rep <- 1000 18 | system.time( 19 | df <- sim_design(within, between, n = 20, mu = mu, sd = 4, 20 | long = TRUE, plot = FALSE, rep = rep) 21 | ) 22 | 23 | system.time( 24 | df <- purrr::map_df(1:rep, ~sim_design(within, between, n = 20, mu = mu, sd = 4, 25 | long = TRUE, plot = FALSE, rep = 1)) 26 | ) 27 | 28 | 29 | anova_func <- function(i, v = "afex") { 30 | #utils::setTxtProgressBar(pb, i) 31 | df <- sim_design(within, between, n = 20, mu = mu, sd = 4, 32 | long = TRUE, plot = FALSE, rep = 2) 33 | 34 | if (v == "afex") { 35 | afex::aov_4(y~(X*W|id), data = df, return = "aov") %>% 36 | broom::tidy() 37 | } else if (v == "aov") { 38 | aov(y~(X*W)+Error(id/(X*W)), data = df, contrasts = NULL) %>% 39 | broom::tidy() 40 | } 41 | } 42 | 43 | 44 | anova_func() 45 | reps <- 100 46 | #pb <- utils::txtProgressBar(max = reps) 47 | system.time( 48 | sims_afex <- purrr::map_df(1:reps, anova_func, v = "afex") 49 | ) 50 | system.time( 51 | sims_aov <- purrr::map_df(1:reps, anova_func, v = "aov") 52 | ) 53 | #close(pb) 54 | 55 | sims_afex %>% 56 | filter(term != "Residuals") %>% 57 | group_by(term) %>% 58 | summarise(power = mean(p.value < .05)) 59 | 60 | sims_aov %>% 61 | filter(term != "Residuals") %>% 62 | group_by(term) %>% 63 | summarise(power = mean(p.value < .05)) 64 | 65 | 66 | alpha <- 0.05 67 | 68 | power <- sims %>% 69 | dplyr::group_by(factor) %>% 70 | dplyr::summarise(power = mean(`Pr(>F)` < alpha)) 71 | 72 | sims %>% 73 | select(factor, p = `Pr(>F)`) %>% 74 | ggplot(aes(p, fill = factor)) + 75 | facet_grid(~factor) + 76 | geom_histogram(binwidth = alpha, color = "black", boundary = 0) 77 | 78 | 79 | ##------ Sun Apr 28 20:43:15 2019 ------## 80 | # df <- purrr::map(1:1e4, ~sim_design(within, between, n = 20)) 81 | ##------ Sun Apr 28 20:44:48 2019 ------## 82 | 83 | ##------ Mon Apr 29 16:59:53 2019 ------## 84 | # > sims <- purrr::map_df(1:1e4, anova_func) 85 | ##------ Mon Apr 29 17:02:51 2019 ------## 86 | 87 | system.time( 88 | 89 | ) -------------------------------------------------------------------------------- /mess/speed_tests2.R: -------------------------------------------------------------------------------- 1 | # benchmark rep speed 2 | 3 | between <- list(pet = c("cat", "dog")) 4 | within <- list(time = c("day", "night")) 5 | vardesc <- c(pet = "Type of Pet", 6 | time = "Time of Day") 7 | design <- check_design(within, between, n = 100, 8 | mu = 1:4, sd = 1:4, r = 0.5, 9 | vardesc = vardesc, plot = FALSE) 10 | 11 | sim_data_bm <- system.time({ 12 | sim_data_data <- purrr::map_df(1:1000, ~sim_data(design)) 13 | }) 14 | 15 | sim_design_bm <- system.time({ 16 | sim_design_data <- purrr::map_df(1:1000, ~sim_design(within, between, n = 100, 17 | mu = 1:4, sd = 1:4, r = 0.5, 18 | vardesc = vardesc, plot = FALSE)) 19 | }) 20 | 21 | rep_design_bm <- system.time({ 22 | rep_design_data <- sim_design(design, rep = 1000, plot = FALSE) 23 | }) 24 | 25 | rep_data_bm <- system.time({ 26 | rep_data_data <- sim_data(design, rep = 1000) 27 | }) 28 | -------------------------------------------------------------------------------- /mess/test-sample_from_pop.R: -------------------------------------------------------------------------------- 1 | context("sample_from_pop") 2 | 3 | # sample_from_pop ---- 4 | test_that("calculations for sample_from_pop", { 5 | skip("just proving something to myself") 6 | 7 | reps <- 1000 8 | tol <- 0.01 9 | 10 | # SD of sample correlations = sqrt(1/n) * (1-r^2) 11 | sim_r <- function(n, r) { 12 | r_sd <- purrr::map_dbl(1:(reps/10), ~{ 13 | x <- rnorm_multi(n, 2, 0, 1, r) 14 | cor(x$X1, x$X2) 15 | }) %>% sd() 16 | data.frame(n = n, r = r, r_sd = r_sd) 17 | } 18 | 19 | ns <- c(50, 100, 200) %>% rep(each = 6) 20 | rs <- seq(0, .5, by = 0.1) %>% rep(times = 3) 21 | sim_r_df <- purrr::map2_df(ns, rs, sim_r) 22 | 23 | r_diff <- sim_r_df %>% 24 | dplyr::mutate(pred = sqrt(1/n) * (1-r^2), 25 | diff = abs(r_sd - pred)) %>% 26 | dplyr::pull(diff) %>% 27 | mean() 28 | 29 | expect_equal(r_diff, 0, tolerance = tol , check.environment=FALSE) 30 | 31 | 32 | # SD of sample means = sd / sqrt(n) 33 | sim_m <- function(n, sd) { 34 | mu_sd <- purrr::map_dbl(1:reps, ~rnorm(n, 100, sd) %>% mean()) %>% sd() 35 | data.frame(n = n, sd = sd, mu_sd = mu_sd) 36 | } 37 | 38 | ns <- c(50, 100, 200, 400) %>% rep(each = 3) 39 | sds <- 1:3 %>% rep(times = 4) 40 | sim_m_df <- purrr::map2_df(ns, sds, sim_m) 41 | 42 | mu_diff <- sim_m_df %>% 43 | dplyr::mutate(pred = sd / sqrt(n), 44 | diff = abs(mu_sd - pred)) %>% 45 | dplyr::pull(diff) %>% 46 | mean() 47 | 48 | expect_equal(mu_diff, 0, tolerance = tol , check.environment=FALSE) 49 | 50 | # SD of sample SDs = sd / sqrt(2*n) 51 | sim_sd <- function(n, sd) { 52 | sd_sd <- purrr::map_dbl(1:reps, ~rnorm(n, 1, sd) %>% sd()) %>% sd() 53 | data.frame(n = n, sd = sd, sd_sd = sd_sd) 54 | } 55 | 56 | sim_sd_df <- purrr::map2_df(ns, sds, sim_sd) 57 | 58 | sd_diff <- sim_sd_df %>% 59 | dplyr::mutate(pred = sd / sqrt(2*n), 60 | diff = abs(sd_sd - pred)) %>% 61 | dplyr::pull(diff) %>% 62 | mean() 63 | 64 | expect_equal(sd_diff, 0, tolerance = tol, check.environment=FALSE) 65 | 66 | }) -------------------------------------------------------------------------------- /mess/test.R: -------------------------------------------------------------------------------- 1 | library(tidyverse) 2 | library(faux) 3 | 4 | des <- check_design(list(time = c("morning", "noon", "night"), 5 | pet = c("dog", "cat", "ferret"), 6 | condition = c("A", "B")), 7 | mu = rep(1:6, 3), 8 | sd = 1) 9 | 10 | 11 | within <- list( 12 | time = c("morning", "night"), 13 | condition = c("A", "B", "C") 14 | ) 15 | between <- list( 16 | pet = c("dog", "cat"), 17 | x = c("X1", "X2")) 18 | 19 | r <- list( 20 | dog_X1 = seq(.1, by = .025, length.out = 15), 21 | dog_X2 = seq(.2, by = .025, length.out = 15), 22 | cat_X1 = seq(.3, by = .025, length.out = 15), 23 | cat_X2 = seq(.4, by = .025, length.out = 15) 24 | ) 25 | 26 | w <- tidyr::crossing(time, condition) %>% 27 | unite(w, 1:ncol(.)) %>% 28 | pull(w) 29 | 30 | design <- tidyr::crossing(pet, time, condition) 31 | for (wc in w) { 32 | design[wc] <- 0 33 | } 34 | design$mu <- 1:8 35 | design$sd <- 1 36 | 37 | 38 | 39 | jsonlite::toJSON(design, pretty = TRUE) 40 | -------------------------------------------------------------------------------- /mess/todo.md: -------------------------------------------------------------------------------- 1 | # To Do 2 | 3 | ## Coding 4 | 5 | * handle underscores in variable names better 6 | * non-normal DVs 7 | * mixed designs 8 | * generic power (from scienceverse) 9 | * shiny app 10 | 11 | ## Other 12 | 13 | * workshop test (advertise on Twitter?) 14 | * integrate with other R packages 15 | * more vignettes 16 | 17 | -------------------------------------------------------------------------------- /mess/y: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/debruine/faux/94dc8cecd26f1a5c7c0a1574ac648d04b0cddcfe/mess/y -------------------------------------------------------------------------------- /pkgdown/_pkgdown.yml: -------------------------------------------------------------------------------- 1 | url: https://debruine.github.io/faux 2 | 3 | development: 4 | mode: auto 5 | 6 | home: 7 | title: Simulation for Factorial Designs 8 | description: Create datasets with factorial structure through simulation by specifying variable parameters. 9 | 10 | template: 11 | bootstrap: 5 12 | opengraph: 13 | image: 14 | src: man/figures/card.png 15 | alt: "Rainbow hexagon with the word FAUX" 16 | twitter: 17 | creator: "@lisadebruine" 18 | site: "@lisadebruine" 19 | card: summary_large_image 20 | 21 | articles: 22 | - title: Demos 23 | navbar: ~ 24 | contents: 25 | - sim_design 26 | - articles/rnorm_multi 27 | - articles/norta 28 | - articles/sim_df 29 | - articles/continuous 30 | - plots 31 | - articles/sim_mixed 32 | - articles/random_reports 33 | - articles/distributions 34 | - articles/codebook 35 | - articles/contrasts 36 | 37 | reference: 38 | - title: Simulation functions 39 | desc: ~ 40 | contents: 41 | - '`rmulti`' 42 | - '`rnorm_multi`' 43 | - '`rnorm_pre`' 44 | - '`sim_design`' 45 | - '`sim_df`' 46 | - '`sim_joint_dist`' 47 | - title: Mixed effects functions 48 | desc: ~ 49 | contents: 50 | - '`add_random`' 51 | - '`add_within`' 52 | - '`add_between`' 53 | - '`add_recode`' 54 | - '`add_ranef`' 55 | - '`sim_mixed_cc`' 56 | - '`sim_mixed_df`' 57 | - title: Contrasts 58 | desc: ~ 59 | contents: 60 | - '`add_contrast`' 61 | - '`contr_code_treatment`' 62 | - '`contr_code_anova`' 63 | - '`contr_code_sum`' 64 | - '`contr_code_difference`' 65 | - '`contr_code_helmert`' 66 | - '`contr_code_poly`' 67 | - title: Other useful functions 68 | desc: ~ 69 | contents: 70 | - '`codebook`' 71 | - '`get_params`' 72 | - '`json_design`' 73 | - '`make_id`' 74 | - '`messy`' 75 | - '`long2wide`' 76 | - '`wide2long`' 77 | - '`faux_options`' 78 | - title: Datasets 79 | desc: ~ 80 | contents: 81 | - '`faceratings`' 82 | - '`fr4`' 83 | - title: Helper functions 84 | desc: ~ 85 | contents: 86 | - '`average_r2tau_0`' 87 | - '`check_design`' 88 | - '`check_mixed_design`' 89 | - '`cormat`' 90 | - '`cormat_from_triangle`' 91 | - '`faux`' 92 | - '`fix_name_labels`' 93 | - '`get_coefs`' 94 | - '`get_contrast_vals`' 95 | - '`get_design`' 96 | - '`get_design_long`' 97 | - '`getcols`' 98 | - '`interactive_design`' 99 | - '`is_pos_def`' 100 | - '`nested_list`' 101 | - '`plot_design`' 102 | - '`pos_def_limits`' 103 | - '`readline_check`' 104 | - '`sample_from_pop`' 105 | - '`set_design`' 106 | - '`unique_pairs`' 107 | - title: Distribution functions 108 | desc: ~ 109 | contents: 110 | - '`std_alpha2average_r`' 111 | - '`convert_r`' 112 | - '`distfuncs`' 113 | - '`fh_bounds`' 114 | - '`rlikert`' 115 | - '`dlikert`' 116 | - '`plikert`' 117 | - '`qlikert`' 118 | - '`norm2likert`' 119 | - '`norm2beta`' 120 | - '`norm2binom`' 121 | - '`norm2gamma`' 122 | - '`norm2nbinom`' 123 | - '`norm2norm`' 124 | - '`norm2pois`' 125 | - '`norm2trunc`' 126 | - '`trunc2norm`' 127 | - '`norm2unif`' 128 | - '`beta2norm`' 129 | - '`binom2norm`' 130 | - '`gamma2norm`' 131 | - '`nbinom2norm`' 132 | - '`unif2norm`' 133 | -------------------------------------------------------------------------------- /pkgdown/favicon/apple-touch-icon-120x120.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/debruine/faux/94dc8cecd26f1a5c7c0a1574ac648d04b0cddcfe/pkgdown/favicon/apple-touch-icon-120x120.png -------------------------------------------------------------------------------- /pkgdown/favicon/apple-touch-icon-152x152.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/debruine/faux/94dc8cecd26f1a5c7c0a1574ac648d04b0cddcfe/pkgdown/favicon/apple-touch-icon-152x152.png -------------------------------------------------------------------------------- /pkgdown/favicon/apple-touch-icon-180x180.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/debruine/faux/94dc8cecd26f1a5c7c0a1574ac648d04b0cddcfe/pkgdown/favicon/apple-touch-icon-180x180.png -------------------------------------------------------------------------------- /pkgdown/favicon/apple-touch-icon-60x60.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/debruine/faux/94dc8cecd26f1a5c7c0a1574ac648d04b0cddcfe/pkgdown/favicon/apple-touch-icon-60x60.png -------------------------------------------------------------------------------- /pkgdown/favicon/apple-touch-icon-76x76.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/debruine/faux/94dc8cecd26f1a5c7c0a1574ac648d04b0cddcfe/pkgdown/favicon/apple-touch-icon-76x76.png -------------------------------------------------------------------------------- /pkgdown/favicon/apple-touch-icon.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/debruine/faux/94dc8cecd26f1a5c7c0a1574ac648d04b0cddcfe/pkgdown/favicon/apple-touch-icon.png -------------------------------------------------------------------------------- /pkgdown/favicon/favicon-16x16.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/debruine/faux/94dc8cecd26f1a5c7c0a1574ac648d04b0cddcfe/pkgdown/favicon/favicon-16x16.png -------------------------------------------------------------------------------- /pkgdown/favicon/favicon-32x32.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/debruine/faux/94dc8cecd26f1a5c7c0a1574ac648d04b0cddcfe/pkgdown/favicon/favicon-32x32.png -------------------------------------------------------------------------------- /pkgdown/favicon/favicon.ico: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/debruine/faux/94dc8cecd26f1a5c7c0a1574ac648d04b0cddcfe/pkgdown/favicon/favicon.ico -------------------------------------------------------------------------------- /pkgdown/man/figures/plot-design-1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/debruine/faux/94dc8cecd26f1a5c7c0a1574ac648d04b0cddcfe/pkgdown/man/figures/plot-design-1.png -------------------------------------------------------------------------------- /pkgdown/man/figures/plot-iris-sim-1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/debruine/faux/94dc8cecd26f1a5c7c0a1574ac648d04b0cddcfe/pkgdown/man/figures/plot-iris-sim-1.png -------------------------------------------------------------------------------- /pkgdown/man/figures/plot-sim-design-1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/debruine/faux/94dc8cecd26f1a5c7c0a1574ac648d04b0cddcfe/pkgdown/man/figures/plot-sim-design-1.png -------------------------------------------------------------------------------- /tests/testthat.R: -------------------------------------------------------------------------------- 1 | library(testthat) 2 | library(faux) 3 | 4 | expect_equal <- function(...) { 5 | testthat::expect_equal(..., check.environment=FALSE) 6 | } 7 | 8 | test_check("faux") 9 | -------------------------------------------------------------------------------- /tests/testthat/Rplots.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/debruine/faux/94dc8cecd26f1a5c7c0a1574ac648d04b0cddcfe/tests/testthat/Rplots.pdf -------------------------------------------------------------------------------- /tests/testthat/test-add_dv.R: -------------------------------------------------------------------------------- 1 | # test_that("errors", { 2 | # dat <- sim_design(2, 2, long = TRUE) 3 | # expect_error(add_dv(dat, y ~ x), regexp = ": x$") 4 | # expect_error(add_dv(dat, y ~ age), regexp = ": age$") 5 | # expect_error(add_dv(dat, y ~ x*age), regexp = ": x, age$") 6 | # 7 | # expect_warning(add_dv(dat, W1 ~ B1), "The column W1 will be overwritten") 8 | # }) 9 | # 10 | # test_that("basic", { 11 | # dat <- add_random(rater = 5) 12 | # 13 | # # default 14 | # dat1 <- add_dv(dat) 15 | # expect_equal(c("rater", "y"), colnames(dat1)) 16 | # expect_equal(rep(0, 5), dat1$y) 17 | # 18 | # # change intercept 19 | # dat1 <- add_dv(dat, intercept = 10) 20 | # expect_equal(c("rater", "y"), colnames(dat1)) 21 | # expect_equal(rep(10, 5), dat1$y) 22 | # 23 | # # change dv name using formula 24 | # dat2 <- add_dv(dat, dv ~ 1) 25 | # expect_equal(c("rater", "dv"), colnames(dat2)) 26 | # expect_equal(rep(0, 5), dat2$dv) 27 | # 28 | # # change dv name using text 29 | # dat3 <- add_dv(dat, "dv ~ 1") 30 | # expect_equal(c("rater", "dv"), colnames(dat3)) 31 | # expect_equal(rep(0, 5), dat3$dv) 32 | # }) 33 | # 34 | # test_that("categorical IVs", { 35 | # dat <- add_random(rater = 6) |> 36 | # add_between("rater", x = c("A", "B")) 37 | # 38 | # dat1 <- add_dv(dat, y ~ x, list(x = 1)) 39 | # expect_equal(dat1$y, rep(0:1, 3)) 40 | # }) 41 | -------------------------------------------------------------------------------- /tests/testthat/test-cell_combos.R: -------------------------------------------------------------------------------- 1 | context("test-cell_combos") 2 | 3 | user_opts <- faux_options("sep", "verbose", "plot", "connection") 4 | on.exit(faux_options(user_opts)) 5 | 6 | test_that("0 factors", { 7 | expect_equal(cell_combos(list()), "y") 8 | expect_equal(cell_combos(list(), "DV"), "DV") 9 | }) 10 | 11 | test_that("1 factor", { 12 | fac <- list(c(A = "A", B = "B", C = "C")) 13 | expect_equal(cell_combos(fac), LETTERS[1:3]) 14 | 15 | fac <- list(pet = c(cat = "Has a Cat", dog = "Has a Dog")) 16 | expect_equal(cell_combos(fac), c("cat", "dog")) 17 | }) 18 | 19 | 20 | test_that("2 factors", { 21 | factors <- list(pet = c(cat = "a cat", dog = "a dog"), 22 | time = c(day = "the day", night = "the night")) 23 | cells <- cell_combos(factors) 24 | expect_equal(cells, c("cat_day", "cat_night", "dog_day", "dog_night")) 25 | }) 26 | 27 | test_that("3 factors", { 28 | factors <- list(pet = c(dog = "a dog", cat = "a cat"), 29 | time = c(day = "the day", night = "the night"), 30 | condition = c(A = "AA", B = "BB")) 31 | cells <- cell_combos(factors) 32 | expect_equal(cells, c("dog_day_A", "dog_day_B", 33 | "dog_night_A", "dog_night_B", 34 | "cat_day_A", "cat_day_B", 35 | "cat_night_A", "cat_night_B")) 36 | }) 37 | 38 | test_that("sep", { 39 | faux_options(sep = ".") 40 | factors <- list(pet = c(dog = "a dog", cat = "a cat"), 41 | time = c(day = "the day", night = "the night"), 42 | condition = c(A = "AA", B = "BB")) 43 | cells <- cell_combos(factors) 44 | expect_equal(cells, c("dog.day.A", "dog.day.B", 45 | "dog.night.A", "dog.night.B", 46 | "cat.day.A", "cat.day.B", 47 | "cat.night.A", "cat.night.B")) 48 | 49 | factors <- list(A = c(A.1 = "A.1", A.2 = "A.2"), 50 | B = c(B_1 = "B_1", B_2 = "B_2")) 51 | cells <- cell_combos(factors) 52 | expect_equal(cells, c("A.1.B_1", "A.1.B_2", "A.2.B_1", "A.2.B_2")) 53 | 54 | faux_options(sep = "_") 55 | cells <- cell_combos(factors) 56 | expect_equal(cells, c("A.1_B_1", "A.1_B_2", "A.2_B_1", "A.2_B_2")) 57 | }) 58 | -------------------------------------------------------------------------------- /tests/testthat/test-check_mixed_design.R: -------------------------------------------------------------------------------- 1 | test_that("errors", { 2 | err <- "data must be a data frame or matrix" 3 | expect_error(check_mixed_design(1), err) 4 | expect_error(check_mixed_design("A"), err) 5 | expect_error(check_mixed_design(FALSE), err) 6 | expect_error(check_mixed_design(1:10), err) 7 | }) 8 | 9 | test_that("matrix", { 10 | des <- check_mixed_design(fr4[,1:3], "rating", "rater_id", "face_id") 11 | fr4mat <- fr4[,1:3] %>% dplyr::mutate( 12 | rater_id = gsub("S", "", rater_id) %>% as.numeric(), 13 | face_id = gsub("I", "", face_id) %>% as.numeric() 14 | ) %>% as.matrix() 15 | des2 <- check_mixed_design(fr4mat, 1, 2, 3) 16 | 17 | expect_equal(des$grand_i, des2$grand_i) 18 | expect_equal(des$sub_sd, des2$sub_sd) 19 | expect_equal(des$item_sd, des2$item_sd) 20 | expect_equal(des$error_sd, des2$error_sd) 21 | }) 22 | 23 | test_that("faceratings", { 24 | des <- check_mixed_design(fr4, "rating", "rater_id", "face_id") 25 | 26 | expect_equal(des$grand_i, mean(fr4$rating), tolerance = 1e-06) 27 | expect_equal(des$sub_sd, 0.8959721, tolerance = 1e-06) 28 | expect_equal(des$item_sd, 0.6545743, tolerance = 1e-06) 29 | expect_equal(des$error_sd, 1.04295, tolerance = 1e-06) 30 | expect_equal(des$random_effects$rater_id$`(Intercept)` %>% length(), 24) 31 | expect_equal(des$random_effects$face_id$`(Intercept)` %>% length(), 32) 32 | }) 33 | 34 | 35 | test_that("formula", { 36 | fm <- "rating ~ face_sex + (1 | face_id) + (1 | rater_id)" 37 | des <- check_mixed_design(fr4, "rating", "rater_id", "face_id", fm) 38 | 39 | expect_equal(des$grand_i, 2.854167, tolerance = 1e-06) 40 | expect_equal(des$sub_sd, 0.8959708, tolerance = 1e-06) 41 | expect_equal(des$item_sd, 0.640946, tolerance = 1e-06) 42 | expect_equal(des$error_sd, 1.04295, tolerance = 1e-06) 43 | expect_equal(des$random_effects$rater_id %>% names(), "(Intercept)") 44 | expect_equal(des$random_effects$face_id %>% names(), "(Intercept)") 45 | }) 46 | -------------------------------------------------------------------------------- /tests/testthat/test-cormat.R: -------------------------------------------------------------------------------- 1 | context("test-cormat") 2 | 3 | test_that("errors", { 4 | expect_error( 5 | cormat(matrix("A", 3, 3)), 6 | "cors matrix not numeric" 7 | ) 8 | expect_error( 9 | cormat(matrix(0.5, 4, 2)), 10 | "cors matrix wrong dimensions" 11 | ) 12 | 13 | m <- matrix(c(1, .5, .5, .5, 1, .5, .5, .75, 1), 3) 14 | expect_error( 15 | cormat(m), 16 | "cors matrix not symmetric" 17 | ) 18 | 19 | m <- matrix(c(1, .5, .5, .5, 1, .5, .5, .5, 0), 3) 20 | expect_error( 21 | cormat(m), 22 | "correlation matrix not positive definite" 23 | ) 24 | 25 | cors <- c(-0.06826927, -0.89756943, -0.45636273) 26 | expect_error( 27 | cormat(cors), 28 | "correlation matrix not positive definite" 29 | ) 30 | }) 31 | 32 | test_that("correct matrix", { 33 | # specify by single value 34 | mat1 <- cormat(.5, 3) 35 | compmat1 <- matrix(c(1, .5, .5, .5, 1, .5, .5, .5, 1), 3) 36 | expect_equal(mat1, compmat1) 37 | 38 | # specify by vars*vars vector 39 | mat2 <- cormat(c( 1, .2, .3, .4, 40 | .2, 1, .5, .6, 41 | .3, .5, 1, .7, 42 | .4, .6, .7, 1), 4) 43 | # specify by vars*(vars-1)/2 vector 44 | mat3 <- cormat(c(.2, .3, .4, .5, .6, .7), 4) 45 | expect_equal(mat2, mat3) 46 | 47 | compmat2 <- matrix(c( 1, .2, .3, .4, 48 | .2, 1, .5, .6, 49 | .3, .5, 1, .7, 50 | .4, .6, .7, 1), 4) 51 | expect_equal(mat2, compmat2) 52 | 53 | # larger vector 54 | mat4 <- cormat(c(.2, .3, .4, -.45, .5, .6, -.65, .7, -.75, -.85), 5) 55 | compmat4 <- matrix(c( 1, .2, .3, .4, -.45, 56 | .2, 1, .5, .6, -.65, 57 | .3, .5, 1, .7, -.75, 58 | .4, .6, .7, 1, -.85, 59 | -.45,-.65,-.75,-.85, 1), 5) 60 | expect_equal(mat4, compmat4) 61 | 62 | # specify by matrix 63 | mat5 <- cormat(compmat4, 5) 64 | expect_equal(mat5, compmat4) 65 | }) 66 | 67 | -------------------------------------------------------------------------------- /tests/testthat/test-cormat_from_triangle.R: -------------------------------------------------------------------------------- 1 | context("test-cormat_from_triangle") 2 | 3 | test_that("errors", { 4 | expect_error( 5 | cormat_from_triangle(c(.8, .8, .8, .8)), 6 | "you don't have the right number of correlations" 7 | ) 8 | }) 9 | 10 | test_that("from triangle", { 11 | mat <- cormat_from_triangle(c(.2, .3, .4, .5, .6, .7)) 12 | 13 | compmat <- matrix(c(1, .2, .3, .4, 14 | .2, 1, .5, .6, 15 | .3, .5, 1, .7, 16 | .4, .6, .7, 1), 4) 17 | expect_equal(mat, compmat) 18 | }) 19 | 20 | -------------------------------------------------------------------------------- /tests/testthat/test-faux_options.R: -------------------------------------------------------------------------------- 1 | context("faux_options") 2 | 3 | user_opts <- faux_options("long", "sep", "verbose", "plot", "connection") 4 | on.exit(faux_options(user_opts)) 5 | 6 | faux_options(list(long = FALSE, 7 | sep = "_", 8 | verbose = TRUE, 9 | plot = TRUE, 10 | connection = stdin())) 11 | 12 | test_that("default", { 13 | o <- faux_options() 14 | expect_equal(names(o), c("connection", "long", "plot", "sep", "verbose")) 15 | expect_equal(o$plot, TRUE) 16 | expect_equal(o$sep, "_") 17 | expect_equal(o$verbose, TRUE) 18 | expect_equal(o$long, FALSE) 19 | expect_equal(class(o$connection), c("terminal", "connection")) 20 | }) 21 | 22 | test_that("set", { 23 | user_sep <- faux_options("sep") 24 | on.exit(faux_options(sep = user_sep)) 25 | 26 | faux_options(sep = ".") 27 | expect_equal(faux_options("sep"), ".") 28 | 29 | faux_options(list(sep = "|", verbose = FALSE)) 30 | expect_equal(faux_options("sep"), "|") 31 | expect_equal(faux_options("verbose"), FALSE) 32 | expect_equal(getOption("faux.sep"), "|") 33 | expect_equal(getOption("faux.verbose"), FALSE) 34 | 35 | faux_options(sep = "x", plot = TRUE) 36 | expect_equal(faux_options("sep"), "x") 37 | expect_equal(faux_options("plot"), TRUE) 38 | 39 | faux_options(list(sep = "_", verbose = TRUE, plot = FALSE)) 40 | expect_equal(faux_options("sep"), "_") 41 | expect_equal(faux_options("verbose"), TRUE) 42 | }) 43 | 44 | test_that("get", { 45 | expect_equal(faux_options("sep"), "_") 46 | expect_equal(faux_options("sep", "verbose"), 47 | list(sep = "_", verbose = TRUE)) 48 | expect_equal(faux_options(c("sep", "verbose")), 49 | list(sep = "_", verbose = TRUE)) 50 | }) 51 | 52 | test_that("error", { 53 | err = "Format lists with names like list(sep = '.', verbose = FALSE)" 54 | expect_error(faux_options(list("sep", "verbose")), err, fixed = TRUE) 55 | }) 56 | -------------------------------------------------------------------------------- /tests/testthat/test-get_coefs.R: -------------------------------------------------------------------------------- 1 | test_that("errors", { 2 | data <- sim_design(within = 2, between = 2, 3 | mu = c(1, 0, 1, 1), 4 | r = 0.5, 5 | long = TRUE, empirical = TRUE, plot = FALSE) %>% 6 | add_contrast("W1", "anova", colnames = "W1") %>% 7 | add_contrast("B1", "anova", colnames = "B1") 8 | 9 | coef <- get_coefs(data) 10 | expect_equal(coef, c("(Intercept)" = 0.75, W1 = -0.5, B1 = 0.5, "W1:B1" = 1.0)) 11 | 12 | coef <- get_coefs(data, y ~ W1 * B1) 13 | expect_equal(coef, c("(Intercept)" = 0.75, W1 = -0.5, B1 = 0.5, "W1:B1" = 1.0)) 14 | 15 | coef <- get_coefs(data, y ~ B1 * W1) 16 | expect_equal(coef, c("(Intercept)" = 0.75, B1 = 0.5, W1 = -0.5, "B1:W1" = 1.0)) 17 | 18 | coef <- get_coefs(data, y ~ W1 + B1) 19 | expect_equal(coef, c("(Intercept)" = 0.75, W1 = -0.5, B1 = 0.5)) 20 | 21 | coef <- get_coefs(data, y ~ B1) 22 | expect_equal(coef, c("(Intercept)" = 0.75, B1 = 0.5)) 23 | 24 | data$y <- norm2binom(data$y) 25 | mod <- lme4::glmer(y ~ W1*B1 + (1 | id), data, family = binomial) 26 | coef <- get_coefs(data, fun = "glm", family = binomial) 27 | expect_equivalent(coef, lme4::fixef(mod)) 28 | }) 29 | -------------------------------------------------------------------------------- /tests/testthat/test-get_design_long.R: -------------------------------------------------------------------------------- 1 | user_opts <- faux_options("sep", "verbose", "plot", "connection") 2 | on.exit(faux_options(user_opts)) 3 | 4 | faux_options(plot = FALSE) 5 | 6 | # 2w ---- 7 | test_that("2w", { 8 | within <- list(time = c("day", "night")) 9 | between <- list() 10 | mu <- c(1,2) 11 | d <- check_design(within, between, mu = mu) 12 | data <- sim_data(d, long = TRUE, empirical= TRUE) 13 | d2 <- get_design_long(data) 14 | 15 | expect_equal(d$within, d2$within) 16 | expect_equivalent(d$between, d2$between) 17 | expect_equal(d$n, d2$n) 18 | expect_equal(d$mu, d2$mu) 19 | expect_equal(d$sd, d2$sd) 20 | expect_equal(d$r, d2$r) 21 | }) 22 | 23 | # get_design_long ---- 24 | test_that("get_design_long", { 25 | design <- check_design(2, 2, n = 10, mu = 5, sd = 2, r = 0.5) 26 | df_long <- sim_design(design = design, long = TRUE, empirical = TRUE) 27 | d <- get_design_long(df_long) 28 | 29 | n <- list(B1a = 10, B1b = 10) 30 | mu <- list(B1a = list(W1a = 5, W1b = 5), B1b = list(W1a = 5, W1b = 5)) 31 | sd <- list(B1a = list(W1a = 2, W1b = 2), B1b = list(W1a = 2, W1b = 2)) 32 | r <- data.frame(W1a = c(1, .5), W1b = c(.5, 1), row.names = c("W1a", "W1b")) %>% as.matrix() 33 | 34 | expect_equal(d$within, list(W1 = list(W1a="W1a", W1b="W1b"))) 35 | expect_equal(d$between, list(B1 = list(B1a="B1a", B1b="B1b"))) 36 | expect_equal(d$n, n) 37 | expect_equal(d$mu, mu) 38 | expect_equal(d$sd, sd) 39 | expect_equal(d$r$B1a, r) 40 | expect_equal(d$r$B1b, r) 41 | 42 | df_long <- sim_design(c(2, 2, 2), c(2, 2, 2), long = TRUE, 43 | empirical = TRUE) 44 | d <- get_design_long(df_long) 45 | 46 | expect_equal(d$mu[[1]] %>% names(), 47 | c("W1a_W2a_W3a", "W1a_W2a_W3b", "W1a_W2b_W3a", "W1a_W2b_W3b", 48 | "W1b_W2a_W3a", "W1b_W2a_W3b", "W1b_W2b_W3a", "W1b_W2b_W3b")) 49 | expect_equal(d$mu %>% names(), 50 | c("B1a_B2a_B3a", "B1a_B2a_B3b", "B1a_B2b_B3a", "B1a_B2b_B3b", 51 | "B1b_B2a_B3a", "B1b_B2a_B3b", "B1b_B2b_B3a", "B1b_B2b_B3b")) 52 | expect_equal(d$n %>% unlist() %>% unname(), rep(100, 8)) 53 | expect_equal(d$mu %>% unlist() %>% unname(), rep(0, 64)) 54 | expect_equal(d$sd %>% unlist() %>% unname(), rep(1, 64)) 55 | expect_equal(d$r[[1]] %>% sum(), 8) 56 | }) 57 | 58 | # 2w*2b ---- 59 | test_that("2w*2b", { 60 | within <- list(time = c("night", "day")) 61 | between <- list(pet = c("dog", "cat")) 62 | mu <- list( 63 | dog = c(1,2), 64 | cat = c(2,3) 65 | ) 66 | d <- check_design(within, between, mu = mu) 67 | data <- sim_design(within, between, mu = mu, long = TRUE, 68 | empirical = TRUE) 69 | d2 <- get_design_long(data) 70 | expect_equal(d$within, d2$within) 71 | expect_equivalent(d$between, d2$between) 72 | expect_equal(d$n, d2$n) 73 | expect_equal(d$mu, d2$mu) 74 | expect_equal(d$sd, d2$sd) 75 | expect_equal(d$r, d2$r) 76 | }) 77 | 78 | # complex ---- 79 | test_that("complex", { 80 | within <- c(2, 3) 81 | between <- c(2, 3) 82 | id <- c(sub_id = "ID") 83 | dv <- c(dv = "My DV") 84 | d <- check_design(within, between, dv = dv, id = id) 85 | data <- sim_design(within, between, dv = dv, id = id, 86 | empirical = TRUE, long = TRUE) 87 | d2 <- get_design_long(data, dv = dv, id = id) 88 | expect_equal(d, d2) 89 | }) 90 | -------------------------------------------------------------------------------- /tests/testthat/test-getcols.R: -------------------------------------------------------------------------------- 1 | # not erroring on CRAN ? 2 | # test_that("error", { 3 | # expect_error(getcols()) 4 | # expect_null(getcols(mtcars)) 5 | # expect_error(getcols(mtcars, 100)) 6 | # expect_error(getcols(mtcars, "no")) 7 | # expect_error(getcols(mtcars, no)) 8 | # }) 9 | 10 | 11 | test_that("basic", { 12 | expect_equal(getcols(mtcars, 1), "mpg") 13 | expect_equal(getcols(mtcars, 1L), "mpg") 14 | expect_equal(getcols(mtcars, "mpg"), "mpg") 15 | expect_equal(getcols(mtcars, mpg), "mpg") 16 | expect_equal(getcols(mtcars, 1:2), c("mpg", "cyl")) 17 | 18 | m <- "mpg" 19 | expect_equal(getcols(mtcars, !!m), "mpg") 20 | }) -------------------------------------------------------------------------------- /tests/testthat/test-json_design.R: -------------------------------------------------------------------------------- 1 | context("test-json_design") 2 | 3 | # defaults ---- 4 | test_that("defaults", { 5 | des <- check_design(mu = 1.123456789, plot = FALSE) 6 | json <- json_design(des) 7 | txt <- '{"within":[],"between":[],"dv":{"y":"value"},"id":{"id":"id"},"vardesc":[],"n":{"y":100},"mu":{"y":{"y":1.12345679}},"sd":{"y":{"y":1}},"r":[],"sep":"_"}' 8 | class(txt) <- "json" 9 | 10 | expect_equal(json, txt) 11 | 12 | des <- check_design(2,2, plot = FALSE) 13 | json <- json_design(des) 14 | txt <- '{"within":{"W1":{"W1a":"W1a","W1b":"W1b"}},"between":{"B1":{"B1a":"B1a","B1b":"B1b"}},"dv":{"y":"value"},"id":{"id":"id"},"vardesc":{"W1":"W1","B1":"B1"},"n":{"B1a":100,"B1b":100},"mu":{"B1a":{"W1a":0,"W1b":0},"B1b":{"W1a":0,"W1b":0}},"sd":{"B1a":{"W1a":1,"W1b":1},"B1b":{"W1a":1,"W1b":1}},"r":{"B1a":[[1,0],[0,1]],"B1b":[[1,0],[0,1]]},"sep":"_"}' 15 | class(txt) <- "json" 16 | 17 | expect_equal(json, txt) 18 | }) 19 | 20 | # filename ---- 21 | test_that("filename", { 22 | testfile <- tempfile(fileext = ".json") 23 | des <- check_design(plot = FALSE) 24 | json <- json_design(des, testfile) 25 | des2 <- jsonlite::read_json(testfile) 26 | json2 <- jsonlite::toJSON(des2, auto_unbox = TRUE) 27 | des$params <- NULL 28 | expect_equivalent(des, des2) 29 | expect_equal(json, json2) 30 | 31 | file.remove(testfile) 32 | 33 | # no .json suffix 34 | testfile <- tempfile() 35 | testfile_json <- paste0(testfile, ".json") 36 | json <- json_design(des, testfile) 37 | des2 <- jsonlite::read_json(testfile_json) 38 | json2 <- jsonlite::toJSON(des2, auto_unbox = TRUE) 39 | des$params <- NULL 40 | expect_equivalent(des, des2) 41 | expect_equal(json, json2) 42 | 43 | file.remove(testfile_json) 44 | }) 45 | 46 | # digits ---- 47 | test_that("digits", { 48 | des <- check_design(mu = 1.123456789, plot = FALSE) 49 | json <- json_design(des, digits = 3) 50 | txt <- '{"within":[],"between":[],"dv":{"y":"value"},"id":{"id":"id"},"vardesc":[],"n":{"y":100},"mu":{"y":{"y":1.123}},"sd":{"y":{"y":1}},"r":[],"sep":"_"}' 51 | class(txt) <- "json" 52 | 53 | expect_equal(json, txt) 54 | 55 | json <- json_design(des, digits = 4) 56 | txt <- '{"within":[],"between":[],"dv":{"y":"value"},"id":{"id":"id"},"vardesc":[],"n":{"y":100},"mu":{"y":{"y":1.1235}},"sd":{"y":{"y":1}},"r":[],"sep":"_"}' 57 | class(txt) <- "json" 58 | 59 | expect_equal(json, txt) 60 | }) 61 | 62 | # pretty ---- 63 | test_that("pretty", { 64 | des <- check_design(plot = FALSE) 65 | json <- json_design(des, pretty = TRUE) 66 | txt <- '{ 67 | "within": [], 68 | "between": [], 69 | "dv": { 70 | "y": "value" 71 | }, 72 | "id": { 73 | "id": "id" 74 | }, 75 | "vardesc": [], 76 | "n": { 77 | "y": 100 78 | }, 79 | "mu": { 80 | "y": { 81 | "y": 0 82 | } 83 | }, 84 | "sd": { 85 | "y": { 86 | "y": 1 87 | } 88 | }, 89 | "r": [], 90 | "sep": "_" 91 | }' 92 | 93 | class(txt) <- "json" 94 | expect_equal(json, txt) 95 | }) 96 | 97 | -------------------------------------------------------------------------------- /tests/testthat/test-make_id.R: -------------------------------------------------------------------------------- 1 | test_that("errors", { 2 | expect_error(make_id(LETTERS), "n must be numeric") 3 | }) 4 | 5 | test_that("default", { 6 | ids <- make_id() 7 | 8 | expect_equal(length(ids), 100) 9 | expect_equal(ids[1], "S001") 10 | expect_equal(ids[100], "S100") 11 | }) 12 | 13 | test_that("unnamed arguments", { 14 | ids <- make_id(10, "P_", 6, "!") 15 | 16 | expect_equal(length(ids), 10) 17 | expect_equal(ids[1], "P_000001!") 18 | expect_equal(ids[10], "P_000010!") 19 | }) 20 | 21 | test_that("named arguments", { 22 | ids <- make_id(digits = 6, n = 10, suffix = "!", prefix = "P_") 23 | 24 | expect_equal(length(ids), 10) 25 | expect_equal(ids[1], "P_000001!") 26 | expect_equal(ids[10], "P_000010!") 27 | }) 28 | 29 | test_that("vector n", { 30 | ids <- make_id(c(1:10, 21:30)) 31 | 32 | expect_equal(length(ids), 20) 33 | expect_equal(ids[1], "S01") 34 | expect_equal(ids[11], "S21") 35 | expect_equal(ids[20], "S30") 36 | }) 37 | 38 | test_that("decimals", { 39 | ids <- make_id(seq(1,2,.1)) 40 | 41 | expect_equal(length(ids), 11) 42 | expect_equal(ids[1], "S1.0") 43 | expect_equal(ids[11], "S2.0") 44 | }) 45 | -------------------------------------------------------------------------------- /tests/testthat/test-messages.R: -------------------------------------------------------------------------------- 1 | context("test-messages") 2 | 3 | test_that("check", { 4 | expect_message(message("green"), "\033[32mgreen\033[39m", fixed = 1) 5 | expect_message(message("pipes?", "no!"), "\033[32mpipes?no!\033[39m", fixed = 1) 6 | }) 7 | 8 | # test_that("not knit", { 9 | # # renders without green text marker when knitting 10 | # 11 | # txt <- "---\ntitle: 'Test'\n---\n\n```{r}\nfaux:::message('hi')\n```" 12 | # find <- '
## hi
' 13 | # 14 | # write(txt, "tmp.Rmd") 15 | # rmarkdown::render("tmp.Rmd", quiet = TRUE) 16 | # html <- readLines("tmp.html") 17 | # found <- grep(find, html, fixed = TRUE) 18 | # expect_true(length(found) == 1) 19 | # 20 | # # cleanup 21 | # file.remove("tmp.Rmd") 22 | # file.remove("tmp.html") 23 | # 24 | # }) 25 | -------------------------------------------------------------------------------- /tests/testthat/test-messy.R: -------------------------------------------------------------------------------- 1 | test_that("errors", { 2 | expect_error(messy()) 3 | expect_error(messy(mtcars, 2)) 4 | expect_error(messy(mtcars, -1)) 5 | expect_error(messy(mtcars, 0.5, "none")) 6 | }) 7 | 8 | test_that("messy", { 9 | iris2 <- messy(iris, 1, "Species") 10 | 11 | expect_equal(iris2[,1:4], iris[,1:4]) 12 | expect_equal(iris2$Species, rep(NA, 150) %>% factor(levels = levels(iris$Species))) 13 | 14 | iris3 <- messy(iris, 0.5, 1:2) 15 | 16 | expect_equal(is.na(iris3[[1]]) %>% sum(), 75) 17 | expect_equal(is.na(iris3[[2]]) %>% sum(), 75) 18 | expect_equal(is.na(iris3[[3]]) %>% sum(), 0) 19 | expect_equal(is.na(iris3[[4]]) %>% sum(), 0) 20 | 21 | iris4 <- messy(iris, 0.5, "Species", replace = "NOPE") 22 | 23 | expect_equal(sum(iris4$Species == "NOPE"), 75) 24 | }) 25 | 26 | test_that("sym", { 27 | iris2 <- messy(iris, .5, Sepal.Length, Sepal.Width) 28 | 29 | prop2 <- iris2[1:4] %>% 30 | dplyr::mutate_all(is.na) %>% 31 | dplyr::summarise_all(mean) %>% 32 | unlist() %>% unname() 33 | 34 | expect_equal(prop2, c(.5, .5, 0, 0)) 35 | }) 36 | 37 | test_that("proportions", { 38 | prop <- c(.1, .2, .3, .4) 39 | iris2 <- messy(iris, prop, 40 | "Sepal.Length", 41 | "Sepal.Width", 42 | "Petal.Length", 43 | "Petal.Width") 44 | 45 | prop2 <- iris2[1:4] %>% 46 | dplyr::mutate_all(is.na) %>% 47 | dplyr::summarise_all(mean) %>% 48 | unlist() %>% unname() 49 | 50 | expect_equal(prop, prop2) 51 | }) 52 | -------------------------------------------------------------------------------- /tests/testthat/test-pos_def_limits.R: -------------------------------------------------------------------------------- 1 | context("test-pos_def_limits") 2 | 3 | test_that("pos_def_limits", { 4 | expect_error( 5 | pos_def_limits(.8, .2, .4, NA), 6 | "you don't have the right number of correlations" 7 | ) 8 | expect_error( 9 | pos_def_limits(.8, NA, NA), 10 | "cors needs to have exactly 1 NA" 11 | ) 12 | 13 | pdl <- pos_def_limits(.8, -.5, NA, steps = .1) 14 | expect_equal(pdl$min, -0.9) 15 | expect_equal(pdl$max, 0.1) 16 | 17 | pdl <- pos_def_limits(.8, .2, NA) 18 | expect_equal(pdl$min, -0.42) 19 | expect_equal(pdl$max, 0.74) 20 | 21 | pdl <- pos_def_limits(.8, .2, 0, NA, 0, 0) 22 | expect_equal(pdl$min, -0.42) 23 | expect_equal(pdl$max, 0.74) 24 | 25 | pdl <- pos_def_limits(.8, .2, NA, -.7, 0, 0) 26 | expect_equal(pdl$min, NA) 27 | expect_equal(pdl$max, NA) 28 | }) -------------------------------------------------------------------------------- /tests/testthat/test-rnorm_pre.R: -------------------------------------------------------------------------------- 1 | set.seed(90210) 2 | tol <- 0.1 3 | 4 | test_that("error messages", { 5 | expect_error(rnorm_pre(rnorm(2)), "x must have length > 2") 6 | }) 7 | 8 | test_that("correct default parameters", { 9 | n <- sample(10:100, 1) 10 | v1 <- rnorm(n) 11 | v2 <- rnorm_pre(v1, empirical = TRUE) 12 | 13 | rho <- cor(v2, v1) 14 | ysd <- sd(v2) 15 | ymean <- mean(v2) 16 | 17 | expect_equal(rho, 0, tol = 0.01) 18 | expect_equal(ymean, 0) 19 | expect_equal(ysd, 1) 20 | }) 21 | 22 | test_that("correct default parameters multi", { 23 | n <- sample(10:100, 1) 24 | v1 <- rnorm_multi(n, 3) 25 | v2 <- rnorm_pre(v1, empirical = TRUE) 26 | 27 | rho <- cor(v2, v1) 28 | ysd <- sd(v2) 29 | ymean <- mean(v2) 30 | 31 | expect_equal(rho[1], 0, tol = 0.01) 32 | expect_equal(rho[2], 0, tol = 0.01) 33 | expect_equal(rho[3], 0, tol = 0.01) 34 | expect_equal(ymean, 0) 35 | expect_equal(ysd, 1) 36 | 37 | n <- sample(10:100, 1) 38 | r = c(0, .5, -0.5) 39 | v1 <- rnorm_multi(n, 3, r = 0.2) 40 | v2 <- rnorm_pre(v1, 100, 10, r, empirical = TRUE) 41 | 42 | rho <- cor(v2, v1) 43 | ysd <- sd(v2) 44 | ymean <- mean(v2) 45 | 46 | expect_equal(rho[1], r[1], tol = tol) 47 | expect_equal(rho[2], r[2], tol = tol) 48 | expect_equal(rho[3], r[3], tol = tol) 49 | expect_equal(ymean, 100, tol = tol) 50 | expect_equal(ysd, 10, tol = tol) 51 | }) 52 | 53 | test_that("correct specified parameters", { 54 | n <- sample(10:100, 1) 55 | v1 <- rnorm(n) 56 | rho <- runif(1) * sample(c(-1, 1), 1) 57 | ymean <- rnorm(1, 0, 100) 58 | ysd <- runif(1, 0.001, 100) 59 | v2 <- rnorm_pre(v1, ymean, ysd, rho, empirical = TRUE) 60 | 61 | testrho <- cor(v1, v2) 62 | testymean <- mean(v2) 63 | testysd <- sd(v2) 64 | 65 | expect_equal(rho, testrho, tolerance = tol) 66 | expect_equal(ymean, testymean, tolerance = tol) 67 | expect_equal(ysd, testysd, tolerance = tol) 68 | }) 69 | 70 | # empirical = FALSE ---- 71 | test_that("empirical = FALSE", { 72 | n <- 100 73 | r <- 0 74 | mu <- 0 75 | sd <- 1 76 | simdat <- purrr::map_df(1:100, ~{ 77 | v1 <- rnorm(n) 78 | v2 <- rnorm_pre(v1, mu, sd, r) 79 | 80 | data.frame( 81 | sd = sd(v2), 82 | mu = mean(v2), 83 | r = cor(v1, v2) 84 | ) 85 | }) 86 | 87 | expect_equal(mean(simdat$mu), mu, tolerance = tol) 88 | expect_equal(mean(simdat$sd), sd, tolerance = tol) 89 | expect_equal(mean(simdat$r), r, tolerance = tol) 90 | 91 | expect_equal(sd(simdat$mu), sd / sqrt(n), tolerance = tol) 92 | expect_equal(sd(simdat$sd), sd / sqrt(2*n), tolerance = tol) 93 | expect_equal(sd(simdat$r), sqrt(1/n) * (1-r^2), tolerance = tol) 94 | }) 95 | 96 | -------------------------------------------------------------------------------- /tests/testthat/test-sim_joint_dist.R: -------------------------------------------------------------------------------- 1 | test_that("errors", { 2 | expect_error(sim_joint_dist()) 3 | expect_error(sim_joint_dist(mtcars, A), 4 | "Some columns were not in the data table: A", fixed = TRUE) 5 | }) 6 | 7 | # cols ---- 8 | test_that("cols", { 9 | mtnew <- sim_joint_dist(mtcars, cyl, vs) 10 | expect_equal(names(mtnew), c("cyl", "vs")) 11 | expect_equal(nrow(mtnew), 100) 12 | 13 | mtnew <- sim_joint_dist(mtcars, "cyl", "vs", n = 20) 14 | expect_equal(names(mtnew), c("cyl", "vs")) 15 | expect_equal(nrow(mtnew), 20) 16 | 17 | mtnew <- sim_joint_dist(mtcars, "cyl", vs, n = 20) 18 | expect_equal(names(mtnew), c("cyl", "vs")) 19 | expect_equal(nrow(mtnew), 20) 20 | 21 | var <- "vs" 22 | mtnew <- sim_joint_dist(mtcars, "cyl", !!var, n = 20) 23 | expect_equal(names(mtnew), c("cyl", "vs")) 24 | expect_equal(nrow(mtnew), 20) 25 | }) 26 | 27 | # empirical ---- 28 | test_that("empirical", { 29 | data <- data.frame( 30 | A = rep(1:2, each = 10), 31 | B = rep(1:2, 10) 32 | ) 33 | 34 | set.seed(1) 35 | not_emp <- sim_joint_dist(data) 36 | n <- dplyr::count(not_emp, A, B)$n 37 | expect_equal(n == c(25, 25, 25, 25), c(F, F, F, F)) 38 | 39 | set.seed(1) 40 | not_emp2 <- sim_joint_dist(data, empirical = FALSE) 41 | n <- dplyr::count(not_emp2, A, B)$n 42 | expect_equal(n == c(25, 25, 25, 25), c(F, F, F, F)) 43 | 44 | set.seed(1) 45 | emp <- sim_joint_dist(data, empirical = TRUE) 46 | n <- dplyr::count(emp, A, B)$n 47 | expect_equal(n, c(25, 25, 25, 25)) 48 | 49 | # more categories than n 50 | set.seed(1) 51 | data <- expand.grid(A = 1:10, B = 1:10) 52 | emp <- sim_joint_dist(data, A, B, n = 10, empirical = TRUE) 53 | n <- dplyr::count(emp, A, B)$n 54 | expect_equal(n, rep(1, 10)) 55 | 56 | # samples differently each time 57 | emp2 <- sim_joint_dist(data, A, B, n = 10, empirical = TRUE) 58 | expect_false(all(emp$A == emp2$A)) 59 | }) -------------------------------------------------------------------------------- /tests/testthat/test-sim_mixed_cc.R: -------------------------------------------------------------------------------- 1 | # default ---- 2 | test_that("default", { 3 | data <- sim_mixed_cc() 4 | 5 | expect_equal(nrow(data), 2000) 6 | expect_equal(ncol(data), 7) 7 | expect_equal(names(data), c("sub_id", "item_id", "y", "grand_i", "sub_i", "item_i", "err")) 8 | 9 | res <- lme4::lmer(y ~ 1 + (1 | sub_id) + (1 | item_id), data = data) %>% 10 | broom.mixed::tidy(effects = "ran_pars") 11 | 12 | expect_equal(res$estimate, c(1,1,1), tolerance = 0.4) 13 | }) 14 | 15 | # n ---- 16 | test_that("n", { 17 | data <- sim_mixed_cc(100, 100) 18 | 19 | expect_equal(nrow(data), 10000) 20 | expect_equal(ncol(data), 7) 21 | expect_equal(names(data), c("sub_id", "item_id", "y", "grand_i", "sub_i", "item_i", "err")) 22 | 23 | res <- lme4::lmer(y ~ 1 + (1 | sub_id) + (1 | item_id), data = data) %>% 24 | broom.mixed::tidy(effects = "ran_pars") 25 | 26 | expect_equal(res$estimate, c(1,1,1), tolerance = 0.1) 27 | }) 28 | 29 | # seed ---- 30 | test_that("seed", { 31 | # # setting seed returns same DF, but is reset 32 | # set.seed(1) 33 | # rnd0 <- rnorm(1) 34 | # df1 <- sim_mixed_cc(seed = 910210) 35 | # rnd1 <- rnorm(1) 36 | # df2 <- sim_mixed_cc(seed = 910210) 37 | # rnd2 <- rnorm(1) 38 | # set.seed(1) 39 | # rnd0b <- rnorm(1) 40 | # rnd1b <- rnorm(1) 41 | # rnd2b <- rnorm(1) 42 | # df3 <- sim_mixed_cc(seed = 8675309) 43 | # 44 | # expect_equal(df1, df2) 45 | # expect_false(rnd1 == rnd2) 46 | # expect_equal(rnd0, rnd0b) 47 | # expect_equal(rnd1, rnd1b) 48 | # expect_equal(rnd2, rnd2b) 49 | # expect_true(!identical(df1, df3)) 50 | 51 | # user sets seed externally 52 | set.seed(1) 53 | df4 <- sim_mixed_cc() 54 | set.seed(1) 55 | df5 <- sim_mixed_cc() 56 | expect_equal(df4, df5) 57 | }) 58 | 59 | # fixed intercepts ---- 60 | test_that("fixed intercepts", { 61 | # unnamed vectors 62 | data <- sim_mixed_cc(3, 3, 0, 1:3, 4:6) 63 | 64 | sub_ids <- unique(data$sub_id) %>% as.vector() 65 | item_ids <- unique(data$item_id) %>% as.vector() 66 | sub_is <- unique(data$sub_i) %>% as.vector() 67 | item_is <- unique(data$item_i) %>% as.vector() 68 | 69 | expect_equal(sub_ids, c("S1", "S2", "S3")) 70 | expect_equal(item_ids, c("I1", "I2", "I3")) 71 | expect_equal(sub_is, 1:3) 72 | expect_equal(item_is, 4:6) 73 | 74 | # named vectors 75 | sub_sd <- c("A" = 1, "B" = 2, "C" = 3) 76 | item_sd <- c("D" = 4, "E" = 5, "F" = 6) 77 | 78 | data <- sim_mixed_cc(3, 3, 0, sub_sd, item_sd) 79 | 80 | sub_ids <- unique(data$sub_id) %>% as.vector() 81 | item_ids <- unique(data$item_id) %>% as.vector() 82 | sub_is <- unique(data$sub_i) %>% as.vector() 83 | item_is <- unique(data$item_i) %>% as.vector() 84 | 85 | expect_equal(sub_ids, LETTERS[1:3]) 86 | expect_equal(item_ids, LETTERS[4:6]) 87 | expect_equal(sub_is, 1:3) 88 | expect_equal(item_is, 4:6) 89 | }) 90 | -------------------------------------------------------------------------------- /tests/testthat/test-sim_mixed_df.R: -------------------------------------------------------------------------------- 1 | # specified dv and IDs ---- 2 | test_that("specified dv and IDs", { 3 | s <- sim_mixed_df(fr4, 10, 10, "rating", "rater_id", "face_id") 4 | default_names <- c("sub_id", "item_id", "y", "grand_i", "sub_i", "item_i", "err") 5 | 6 | expect_equal(nrow(s), 100) 7 | expect_equal(ncol(s), 7) 8 | expect_equal(names(s), default_names) 9 | }) 10 | 11 | test_that("numeric spec", { 12 | s <- sim_mixed_df(fr4, dv = 1, sub_id = 2, item_id = 3) 13 | default_names <- c("sub_id", "item_id", "y", "grand_i", "sub_i", "item_i", "err") 14 | 15 | expect_equal(nrow(s), nrow(fr4)) 16 | expect_equal(ncol(s), 7) 17 | expect_equal(names(s), default_names) 18 | }) 19 | 20 | # seed ---- 21 | # test_that("seed", { 22 | # df1 <- sim_mixed_df(fr4, 10, 10, "rating", "rater_id", "face_id", seed = 1) 23 | # df2 <- sim_mixed_df(fr4, 10, 10, "rating", "rater_id", "face_id", seed = 1) 24 | # 25 | # expect_equal(df1, df2) 26 | # 27 | # df3 <- sim_mixed_df(fr4, 10, 10, "rating", "rater_id", "face_id", seed = 90210) 28 | # 29 | # expect_true(!identical(df1, df3)) 30 | # }) 31 | 32 | # exact items ---- 33 | test_that("exact items", { 34 | check <- check_mixed_design(fr4, "rating", "rater_id", "face_id") 35 | 36 | # 20 new subjects with same 10 items 37 | df_items <- sim_mixed_df(fr4, sub_n = 20, item_n = NULL, "rating", "rater_id", "face_id") 38 | items <- dplyr::count(df_items, item_id, item_i) 39 | check_items <- check$random_effects$face_id 40 | 41 | expect_equal(items$item_i, check_items[,1]) 42 | 43 | # 20 new items with same 10 subjects 44 | df_subs <- sim_mixed_df(fr4, sub_n = NULL, item_n = 20, "rating", "rater_id", "face_id") 45 | subs <- dplyr::count(df_subs, sub_id, sub_i) 46 | check_subs <- check$random_effects$rater_id 47 | 48 | expect_equal(subs$sub_i, check_subs[,1]) 49 | }) 50 | 51 | -------------------------------------------------------------------------------- /tests/testthat/test-unique_pairs.R: -------------------------------------------------------------------------------- 1 | context("test_unique_pairs") 2 | 3 | test_that("number", { 4 | expect_equal(unique_pairs(2), "A-B") 5 | expect_equal(unique_pairs(3), c("A-B", "A-C", "B-C")) 6 | expect_equal(unique_pairs(4), c("A-B", "A-C", "A-D", "B-C", "B-D", "C-D")) 7 | expect_error(unique_pairs(1), "There must be at least 2 levels") 8 | }) 9 | 10 | test_that("levels", { 11 | expect_equal(unique_pairs(c("dog", "cat")), "dog-cat") 12 | expect_equal(unique_pairs(c("Z", "A", "P")), c("Z-A", "Z-P", "A-P")) 13 | expect_equal(unique_pairs(4:2), c("4-3", "4-2", "3-2")) 14 | expect_equal(unique_pairs(c("first", "next", "last")), c("first-next", "first-last", "next-last")) 15 | expect_equal(unique_pairs(c("a.name", "another.name")), "a.name-another.name") 16 | expect_error(unique_pairs(c("same", "same")), "You have duplicate levels") 17 | expect_error(unique_pairs(c("one")), "There must be at least 2 levels") 18 | }) 19 | -------------------------------------------------------------------------------- /tests/testthat/test-zzz.R: -------------------------------------------------------------------------------- 1 | test_that("loading", { 2 | # # set to something wierd to make sure they're reset later 3 | # faux_options(connection = "a", 4 | # sep = "b", 5 | # verbose = "c", 6 | # plot = "d") 7 | # 8 | # detach("package:faux", unload=TRUE) 9 | #expect_error(sim_design(), 'could not find function "sim_design"', fixed = TRUE) 10 | # options(faux.connection = NULL) 11 | # options(faux.sep = NULL) 12 | # options(faux.verbose = NULL) 13 | # options(faux.plot = NULL) 14 | # expect_equal(options("faux.connection")[[1]], NULL) 15 | # expect_equal(options("faux.sep")[[1]], NULL) 16 | # expect_equal(options("faux.verbose")[[1]], NULL) 17 | # expect_equal(options("faux.plot")[[1]], NULL) 18 | # 19 | # startup <- "************ 20 | # Welcome to faux. For support and examples visit: 21 | # http://debruine.github.io/faux/ 22 | # - Get and set global package options with: faux_options() 23 | # ************" 24 | # 25 | # expect_message(library("faux"), startup, fixed = TRUE) 26 | 27 | expect_equal(options("faux.connection")[[1]], stdin()) 28 | expect_equal(options("faux.sep")[[1]], "_") 29 | expect_equal(options("faux.verbose")[[1]], TRUE) 30 | expect_equal(options("faux.plot")[[1]], TRUE) 31 | }) 32 | -------------------------------------------------------------------------------- /vignettes/.gitignore: -------------------------------------------------------------------------------- 1 | *.html 2 | *.R 3 | -------------------------------------------------------------------------------- /vignettes/articles/.gitignore: -------------------------------------------------------------------------------- 1 | *.html 2 | *.R 3 | -------------------------------------------------------------------------------- /vignettes/articles/template_instructions.txt: -------------------------------------------------------------------------------- 1 | === Reproducible Report for {student_id} === 2 | 3 | Your questionnaire measures {topic}. Your research question is to determine if the {topic} score differs by {iv} for the subset of the sample where {subset} is {level}. 4 | 5 | The {quest_n} {topic} questionnaire items are on a scale from 1 (low) to 7 (high), but some of the items need to be reverse-coded. This is indicated by the letter R in the question column name. You create the {topic} score by summing the questions. 6 | 7 | Watch out for missing data. You can decide whether to omit subjects with missing data or replace the missing data; just explain your choice and its consequences in the report. 8 | 9 | The report should be written like a summary document for your PI. You don't need to show your code in the rendered report. Include summary tables and/or plots with subject demographics from both the full data set and the subset you'll analyse. Visualise the relationship of interest. Conduct a GLM analysis to answer the research question above. Finally, do a power analysis to determine the sample size you would need to have {power}% power to detect a 0.5-point difference between the levels of {iv} with an alpha criterion of {alpha}. 10 | --------------------------------------------------------------------------------