├── .Rbuildignore ├── .github ├── .gitignore └── workflows │ ├── R-CMD-check.yaml │ ├── pr-commands.yaml │ └── test-coverage.yaml ├── .gitignore ├── CONDUCT.md ├── DESCRIPTION ├── DeclareDesign.Rproj ├── LICENSE ├── NAMESPACE ├── NEWS.md ├── R ├── DeclareDesign-deprecated.R ├── DeclareDesign.R ├── aaa.R ├── compare_designs.R ├── compare_diagnoses.R ├── construct_design.R ├── declare_assignment.R ├── declare_diagnosands.R ├── declare_estimator.R ├── declare_inquiry.R ├── declare_measurement.R ├── declare_model.R ├── declare_population.R ├── declare_potential_outcomes.R ├── declare_reveal.R ├── declare_sampling.R ├── declare_step.R ├── declare_test.R ├── design_helper_functions.R ├── design_print_summary.R ├── diagnose_design.R ├── diagnosis_helper_functions.R ├── draw_functions.R ├── expand_design.R ├── get_functions.R ├── modify_design.R ├── modify_edit.R ├── ops.R ├── redesign.R ├── set_citation.R ├── set_diagnosands.R ├── simulate_design.R ├── tidy_try.R └── utilities.R ├── README.Rmd ├── README.md ├── _pkgdown.yml ├── codecov.yml ├── cran-comments.md ├── inst └── CITATION ├── man ├── DeclareDesign-deprecated.Rd ├── DeclareDesign.Rd ├── cite_design.Rd ├── compare_diagnoses.Rd ├── compare_functions.Rd ├── declare_assignment.Rd ├── declare_design.Rd ├── declare_diagnosands.Rd ├── declare_estimator.Rd ├── declare_inquiry.Rd ├── declare_measurement.Rd ├── declare_model.Rd ├── declare_population.Rd ├── declare_potential_outcomes.Rd ├── declare_reveal.Rd ├── declare_sampling.Rd ├── declare_step.Rd ├── declare_test.Rd ├── diagnose_design.Rd ├── diagnosis_helpers.Rd ├── draw_functions.Rd ├── edit.Rd ├── expand_conditions.Rd ├── expand_design.Rd ├── get_functions.Rd ├── modify_design.Rd ├── pop.var.Rd ├── post_design.Rd ├── redesign.Rd ├── reexports.Rd ├── reshape_diagnosis.Rd ├── run_design.Rd ├── set_citation.Rd ├── set_diagnosands.Rd ├── simulate_design.Rd ├── tidy.diagnosis.Rd └── tidy_try.Rd ├── tests ├── testthat.R └── testthat │ ├── test-allow-custom-functions.R │ ├── test-alternative-df-compatibility.R │ ├── test-assignment.R │ ├── test-attrition.R │ ├── test-bootstrap-diagnosands.R │ ├── test-citation.R │ ├── test-compare-designs.R │ ├── test-compare-diagnoses.R │ ├── test-conduct-custom.R │ ├── test-continuous-pos.R │ ├── test-custom-functions.R │ ├── test-declare-design.R │ ├── test-declare-step.R │ ├── test-demo.R │ ├── test-deprecated.R │ ├── test-describe_variable.R │ ├── test-design-library.R │ ├── test-design-summary.R │ ├── test-diagnosands.R │ ├── test-diagnose-design.R │ ├── test-environment-issues.R │ ├── test-estimands.R │ ├── test-estimators.R │ ├── test-expand-design.R │ ├── test-factorial.R │ ├── test-fanout.R │ ├── test-get-estimates.R │ ├── test-get-star.R │ ├── test-labels.R │ ├── test-measurement.R │ ├── test-model-summary.R │ ├── test-model.R │ ├── test-modify-design.R │ ├── test-multiple-coefficients.R │ ├── test-multiple-estimands-one-estimator.R │ ├── test-multiple-estimators.R │ ├── test-multiple-pos.R │ ├── test-name-steps.R │ ├── test-names-and-labels.R │ ├── test-noncompliance.R │ ├── test-paper.R │ ├── test-plus.R │ ├── test-population.R │ ├── test-potential-outcomes.R │ ├── test-print-code.R │ ├── test-quick-design.R │ ├── test-redesign.R │ ├── test-reshape-diagnosis.R │ ├── test-reveal-outcomes.R │ ├── test-run-design.R │ ├── test-sampling.R │ ├── test-save-reload-redesign.R │ ├── test-scaffolding.R │ ├── test-sims-independent.R │ ├── test-simulate-design.R │ ├── test-subset.R │ ├── test-sugar.R │ ├── test-test.R │ └── test-utilities.R └── vignettes ├── custom_functions.Rmd └── design_declaration_in_other_languages.Rmd /.Rbuildignore: -------------------------------------------------------------------------------- 1 | ^CRAN-RELEASE$ 2 | ^\.travis\.yml$ 3 | README.md 4 | README.Rmd 5 | index.Rmd 6 | index.md 7 | ^.*\.Rproj$ 8 | ^\.Rproj\.user$ 9 | builtin_objects 10 | appveyor.yml 11 | ^appveyor\.yml$ 12 | builtin_diagnosands 13 | CONDUCT.md 14 | ^docs$ 15 | ^docs/templates/.*$ 16 | _pkgdown.yml 17 | deploy.sh 18 | install.R 19 | paper.pdf 20 | ^_pkgdown\.yml$ 21 | ^vignettes/.*\.RDS$ 22 | ^DeclareDesign_.*\.tar\.gz$ 23 | ^cran-comments\.md$ 24 | vignettes 25 | ^\.github$ 26 | ^pkgdown$ 27 | ^CRAN-SUBMISSION$ 28 | ^codecov\.yml$ 29 | -------------------------------------------------------------------------------- /.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 | 8 | name: R-CMD-check.yaml 9 | 10 | permissions: read-all 11 | 12 | jobs: 13 | R-CMD-check: 14 | runs-on: ${{ matrix.config.os }} 15 | 16 | name: ${{ matrix.config.os }} (${{ matrix.config.r }}) 17 | 18 | strategy: 19 | fail-fast: false 20 | matrix: 21 | config: 22 | - {os: macos-latest, r: 'release'} 23 | - {os: windows-latest, r: 'release'} 24 | - {os: ubuntu-latest, r: 'devel', http-user-agent: 'release'} 25 | - {os: ubuntu-latest, r: 'release'} 26 | - {os: ubuntu-latest, r: 'oldrel-1'} 27 | 28 | env: 29 | GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }} 30 | R_KEEP_PKG_SOURCE: yes 31 | 32 | steps: 33 | - uses: actions/checkout@v4 34 | 35 | - uses: r-lib/actions/setup-pandoc@v2 36 | 37 | - uses: r-lib/actions/setup-r@v2 38 | with: 39 | r-version: ${{ matrix.config.r }} 40 | http-user-agent: ${{ matrix.config.http-user-agent }} 41 | use-public-rspm: true 42 | 43 | - uses: r-lib/actions/setup-r-dependencies@v2 44 | with: 45 | extra-packages: any::rcmdcheck 46 | needs: check 47 | 48 | - uses: r-lib/actions/check-r-package@v2 49 | with: 50 | upload-snapshots: true 51 | build_args: 'c("--no-manual","--compact-vignettes=gs+qpdf")' 52 | -------------------------------------------------------------------------------- /.github/workflows/pr-commands.yaml: -------------------------------------------------------------------------------- 1 | on: 2 | issue_comment: 3 | types: [created] 4 | name: Commands 5 | jobs: 6 | document: 7 | if: startsWith(github.event.comment.body, '/document') 8 | name: document 9 | runs-on: macOS-latest 10 | steps: 11 | - uses: actions/checkout@v2 12 | - uses: r-lib/actions/pr-fetch@master 13 | with: 14 | repo-token: ${{ secrets.GITHUB_TOKEN }} 15 | - uses: r-lib/actions/setup-r@master 16 | - name: Install dependencies 17 | run: Rscript -e 'install.packages(c("remotes", "roxygen2"))' -e 'remotes::install_deps(dependencies = TRUE)' 18 | - name: Document 19 | run: Rscript -e 'roxygen2::roxygenise()' 20 | - name: commit 21 | run: | 22 | git add man/\* NAMESPACE 23 | git commit -m 'Document' 24 | - uses: r-lib/actions/pr-push@master 25 | with: 26 | repo-token: ${{ secrets.GITHUB_TOKEN }} 27 | style: 28 | if: startsWith(github.event.comment.body, '/style') 29 | name: style 30 | runs-on: macOS-latest 31 | steps: 32 | - uses: actions/checkout@v2 33 | - uses: r-lib/actions/pr-fetch@master 34 | with: 35 | repo-token: ${{ secrets.GITHUB_TOKEN }} 36 | - uses: r-lib/actions/setup-r@master 37 | - name: Install dependencies 38 | run: Rscript -e 'install.packages("styler")' 39 | - name: Style 40 | run: Rscript -e 'styler::style_pkg()' 41 | - name: commit 42 | run: | 43 | git add \*.R 44 | git commit -m 'Style' 45 | - uses: r-lib/actions/pr-push@master 46 | with: 47 | repo-token: ${{ secrets.GITHUB_TOKEN }} 48 | -------------------------------------------------------------------------------- /.github/workflows/test-coverage.yaml: -------------------------------------------------------------------------------- 1 | on: 2 | push: 3 | branches: 4 | - main 5 | pull_request: 6 | branches: 7 | - main 8 | 9 | name: test-coverage 10 | 11 | jobs: 12 | test-coverage: 13 | runs-on: macOS-latest 14 | env: 15 | GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }} 16 | steps: 17 | - uses: actions/checkout@v3 18 | 19 | - uses: r-lib/actions/setup-r@v2 20 | 21 | - uses: r-lib/actions/setup-pandoc@v2 22 | 23 | - name: Query dependencies 24 | run: | 25 | install.packages('remotes') 26 | saveRDS(remotes::dev_package_deps(dependencies = TRUE), ".github/depends.Rds", version = 2) 27 | writeLines(sprintf("R-%i.%i", getRversion()$major, getRversion()$minor), ".github/R-version") 28 | shell: Rscript {0} 29 | 30 | - name: Cache R packages 31 | uses: actions/cache@v3 32 | with: 33 | path: ${{ env.R_LIBS_USER }} 34 | key: ${{ runner.os }}-${{ hashFiles('.github/R-version') }}-1-${{ hashFiles('.github/depends.Rds') }} 35 | restore-keys: ${{ runner.os }}-${{ hashFiles('.github/R-version') }}-1- 36 | 37 | - name: Install dependencies 38 | run: | 39 | install.packages(c("remotes")) 40 | remotes::install_deps(dependencies = TRUE) 41 | remotes::install_cran("covr") 42 | shell: Rscript {0} 43 | 44 | - name: Test coverage 45 | run: covr::codecov() 46 | shell: Rscript {0} 47 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | # History files 2 | .Rhistory 3 | .Rapp.history 4 | # Example code in package build process 5 | *-Ex.R 6 | # RStudio files 7 | .Rproj.user/ 8 | # produced vignettes 9 | vignettes/*.html 10 | vignettes/*.pdf 11 | vignettes/*.R 12 | vignettes/.* 13 | .Rproj.user 14 | tests/testthat/*.pdf 15 | .DS_Store 16 | inst/doc 17 | *.tar.gz 18 | docs 19 | -------------------------------------------------------------------------------- /CONDUCT.md: -------------------------------------------------------------------------------- 1 | # Contributor Covenant Code of Conduct 2 | 3 | ## Our Pledge 4 | 5 | In the interest of fostering an open and welcoming environment, we as 6 | contributors and maintainers pledge to making participation in our project and 7 | our community a harassment-free experience for everyone, regardless of age, body 8 | size, disability, ethnicity, gender identity and expression, level of experience, 9 | nationality, personal appearance, race, religion, or sexual identity and 10 | orientation. 11 | 12 | ## Our Standards 13 | 14 | Examples of behavior that contributes to creating a positive environment 15 | include: 16 | 17 | * Using welcoming and inclusive language 18 | * Being respectful of differing viewpoints and experiences 19 | * Gracefully accepting constructive criticism 20 | * Focusing on what is best for the community 21 | * Showing empathy towards other community members 22 | 23 | Examples of unacceptable behavior by participants include: 24 | 25 | * The use of sexualized language or imagery and unwelcome sexual attention or 26 | advances 27 | * Trolling, insulting/derogatory comments, and personal or political attacks 28 | * Public or private harassment 29 | * Publishing others' private information, such as a physical or electronic 30 | address, without explicit permission 31 | * Other conduct which could reasonably be considered inappropriate in a 32 | professional setting 33 | 34 | ## Our Responsibilities 35 | 36 | Project maintainers are responsible for clarifying the standards of acceptable 37 | behavior and are expected to take appropriate and fair corrective action in 38 | response to any instances of unacceptable behavior. 39 | 40 | Project maintainers have the right and responsibility to remove, edit, or 41 | reject comments, commits, code, wiki edits, issues, and other contributions 42 | that are not aligned to this Code of Conduct, or to ban temporarily or 43 | permanently any contributor for other behaviors that they deem inappropriate, 44 | threatening, offensive, or harmful. 45 | 46 | ## Scope 47 | 48 | This Code of Conduct applies both within project spaces and in public spaces 49 | when an individual is representing the project or its community. Examples of 50 | representing a project or community include using an official project e-mail 51 | address, posting via an official social media account, or acting as an appointed 52 | representative at an online or offline event. Representation of a project may be 53 | further defined and clarified by project maintainers. 54 | 55 | ## Enforcement 56 | 57 | Instances of abusive, harassing, or otherwise unacceptable behavior may be 58 | reported by contacting the project team at [abuse@declaredesign.org](mailto:abuse@declaredesign.org). All 59 | complaints will be reviewed and investigated and will result in a response that 60 | is deemed necessary and appropriate to the circumstances. The project team is 61 | obligated to maintain confidentiality with regard to the reporter of an incident. 62 | Further details of specific enforcement policies may be posted separately. 63 | 64 | Project maintainers who do not follow or enforce the Code of Conduct in good 65 | faith may face temporary or permanent repercussions as determined by other 66 | members of the project's leadership. 67 | 68 | ## Attribution 69 | 70 | This Code of Conduct is adapted from the [Contributor Covenant][homepage], version 1.4, 71 | available at [http://contributor-covenant.org/version/1/4][version] 72 | 73 | [homepage]: http://contributor-covenant.org 74 | [version]: http://contributor-covenant.org/version/1/4/ 75 | -------------------------------------------------------------------------------- /DESCRIPTION: -------------------------------------------------------------------------------- 1 | Package: DeclareDesign 2 | Title: Declare and Diagnose Research Designs 3 | Version: 1.0.8 4 | Authors@R: c(person("Graeme", "Blair", email = "graeme.blair@gmail.com", role = c("aut", "cre"), comment = c(ORCID = "0000-0001-9164-2102")), 5 | person("Jasper", "Cooper", email = "jaspercooper@gmail.com", role = c("aut"), comment = c(ORCID = "0000-0002-8639-3188")), 6 | person("Alexander", "Coppock", email = "acoppock@gmail.com", role = c("aut"), comment = c(ORCID = "0000-0002-5733-2386")), 7 | person("Macartan", "Humphreys", email = "macartan@gmail.com", role = c("aut"), comment = c(ORCID = "0000-0001-7029-2326")), 8 | person("Neal", "Fultz", email = "nfultz@gmail.com", role = c("aut"))) 9 | Description: Researchers can characterize and learn about the properties of 10 | research designs before implementation using `DeclareDesign`. Ex ante 11 | declaration and diagnosis of designs can help researchers clarify the 12 | strengths and limitations of their designs and to improve their 13 | properties, and can help readers evaluate a research strategy prior 14 | to implementation and without access to results. It can also make it 15 | easier for designs to be shared, replicated, and critiqued. 16 | Depends: 17 | R (>= 3.5.0), 18 | randomizr (>= 0.20.0), 19 | fabricatr (>= 0.10.0), 20 | estimatr (>= 0.20.0) 21 | Imports: 22 | rlang, generics, methods 23 | License: MIT + file LICENSE 24 | URL: https://declaredesign.org/r/declaredesign/, https://github.com/DeclareDesign/DeclareDesign 25 | BugReports: https://github.com/DeclareDesign/DeclareDesign/issues 26 | Encoding: UTF-8 27 | RoxygenNote: 7.3.1 28 | Suggests: 29 | testthat, 30 | knitr, 31 | rmarkdown, 32 | AER, 33 | diffobj, 34 | dplyr, 35 | data.table, 36 | tibble, 37 | ggplot2, 38 | future, 39 | future.apply, 40 | broom, 41 | MASS, 42 | Matching, 43 | betareg, 44 | biglm, 45 | gam, 46 | sf, 47 | reshape2, 48 | DesignLibrary, 49 | coin, 50 | margins, 51 | psych 52 | -------------------------------------------------------------------------------- /DeclareDesign.Rproj: -------------------------------------------------------------------------------- 1 | Version: 1.0 2 | ProjectId: 7807cd06-e8c6-403f-8e42-3db32e8a3b20 3 | 4 | RestoreWorkspace: No 5 | SaveWorkspace: No 6 | AlwaysSaveHistory: No 7 | 8 | EnableCodeIndexing: Yes 9 | UseSpacesForTab: Yes 10 | NumSpacesForTab: 2 11 | Encoding: UTF-8 12 | 13 | RnwWeave: knitr 14 | LaTeX: XeLaTeX 15 | 16 | BuildType: Package 17 | PackageUseDevtools: Yes 18 | PackageInstallArgs: --no-multiarch --with-keep.source 19 | PackageRoxygenize: rd,collate,namespace 20 | 21 | QuitChildProcessesOnExit: Yes 22 | DisableExecuteRprofile: Yes 23 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | YEAR: 2015-2017 2 | COPYRIGHT HOLDER: Graeme Blair, Jasper Cooper, Alexander Coppock, and Macartan Humphreys 3 | -------------------------------------------------------------------------------- /NEWS.md: -------------------------------------------------------------------------------- 1 | # DeclareDesign 1.0.8 2 | 3 | * Bug fix of parallel processing that caused in rare cases simulations to be identical across multiple calls to simulate_design or diagnose_design. 4 | 5 | # DeclareDesign 1.0.6 6 | 7 | * Documentation update to stay current on CRAN. 8 | 9 | # DeclareDesign 1.0.4 10 | 11 | * Documentation improvements. 12 | * Citation updates. 13 | 14 | # DeclareDesign 1.0.2 15 | 16 | * Bug fixes. 17 | 18 | # DeclareDesign 1.0.0 19 | 20 | * Allow diagnoses to group by outcomes. 21 | * Simplify print(design). 22 | * Launch version 1. 23 | 24 | # DeclareDesign 0.30.0 25 | 26 | * New tidy(diagnosis) function to construct a tidy data frame of diagnosand estimates and summary statistics including bootstrapped standard error and confidence intervals. 27 | * Remove draw_assignment and draw_sample function. 28 | * Added diagnosis duration to summary function. 29 | * Bug fixes. 30 | 31 | # DeclareDesign 0.28.0 32 | 33 | * To simplify output of diagnoses, we changed the names of the variables from design_label to design, inquiry_label to inquiry, and estimator_label to estimator. 34 | * declare_assignment() and declare_sampling() have the default values for legacy set to FALSE. You can still use the legacy versions of these functions by manually setting legacy = TRUE for some time, but this functionality will later be removed. 35 | 36 | # DeclareDesign 0.26.0 37 | 38 | * Rapid development phase is beginning to prepare for DeclareDesign 1.0. 39 | * Add new step `declare_model` for defining the model of the world including sample size, levels of the data, and variables. 40 | * Add new step `declare_inquiry` to replace `declare_estimand`. `declare_estimand` is still available but deprecated. 41 | * Soft-introduce new syntax for declare_assignment and declare_sampling. Old syntax is still available with legacy = TRUE, the current default. To use the new syntax, set legacy = FALSE. In future versions of DeclareDesign, the default will be set to FALSE. 42 | * `reveal_outcomes`, created in 0.24.0, has been removed as a step. 43 | * Change labels produced in diagnoses and `run_design` output to be `inquiry_label` rather than `estimand_label`. 44 | * Allow estimands to be functions of other estimands. 45 | 46 | # DeclareDesign 0.24.0 47 | 48 | * Add new step `declare_measurement` for measuring outcome variables. 49 | * Add `declare_test` to enable hypothesis testing where no estimand is targeted. For example, `declare_test` could be used for a K-S test of distributional equality and `declare_estimator` for a difference-in-means estimate of an average treatment effect. 50 | * Add `model_summary` option to `declare_estimator`, to enable specifying a model and then a separate post-estimation function to extract coefficient estimates (e.g., estimate of a treatment effect) or model summary statistics (e.g., R^2 or the result of an F-test from a regression). 51 | * Simplify `declare_diagnosands` functionality. `diagnose_design()` by default runs an internal function with a set of default diagnosands, including power, RMSE, bias, type S rate, coverage, mean estimate, and mean estimand. 52 | * Improve compatibility with dplyr verbs as handlers. `filter` now works. 53 | * Rename `declare_reveal` to `reveal_outcomes`. Both continue to work. 54 | 55 | # DeclareDesign 0.22.0 56 | 57 | * Fix ability to set `sampling_variable` in `declare_sampling`. 58 | * Add ability to retain nonsampled data after sampling via `drop_nonsampled` flag in `declare_sampling`. 59 | 60 | # DeclareDesign 0.20.0 61 | 62 | * Add `compare_diagnoses` function to compare two designs on the basis of their design diagnoses. 63 | * Compatibility with `rlang` 0.4.0 64 | * Bug fixes 65 | 66 | # DeclareDesign 0.18.0 67 | 68 | * Add `compare_designs` functions to compare the code and output of designs side-by-side. 69 | * Bug fixes 70 | 71 | # DeclareDesign 0.16.0 72 | 73 | * Add `draw_assignment` function to draw an assignment vector(s) given data 74 | * Add `draw_sample` function to draw a sample or multiple sequential samples from data 75 | * Rewrite `draw_data` to optionally take a data argument. `draw_data` now can be used to draw data for the full design, or for subsets of it. `start` and `end` flags are added to select which portions of the design to run 76 | * Bug fixes 77 | 78 | # DeclareDesign 0.14.0 79 | 80 | * Improved generics interoperability 81 | * Bug fixes 82 | 83 | # DeclareDesign 0.12.0 84 | 85 | * Add ability to use `get_estimates` with data, useful for example for getting estimates after data is collected for a study. To draw estimates or estimands from simulated data, now use renamed `draw_estimates` and `draw_estimands` functions. 86 | * Documentation improvements 87 | * Bug fixes 88 | 89 | # DeclareDesign 0.10.0 90 | 91 | * First CRAN version 92 | -------------------------------------------------------------------------------- /R/DeclareDesign-deprecated.R: -------------------------------------------------------------------------------- 1 | ## DeclareDesign-deprecated.r 2 | #' @title Deprecated functions in package \pkg{DeclareDesign}. 3 | #' @description The functions listed below are deprecated and will be defunct in 4 | #' the near future. When possible, alternative functions with similar 5 | #' functionality are also mentioned. Help pages for deprecated functions are 6 | #' available at \code{help("-deprecated")}. 7 | #' @name DeclareDesign-deprecated 8 | #' @keywords internal 9 | NULL 10 | 11 | draw_assignment <- function(design, data = NULL, start = 1, end = length(design)) { 12 | .Deprecated() 13 | } 14 | 15 | draw_sample <- function(design, data = NULL, start = 1, end = length(design)) { 16 | .Deprecated() 17 | } 18 | -------------------------------------------------------------------------------- /R/DeclareDesign.R: -------------------------------------------------------------------------------- 1 | #' DeclareDesign package 2 | #' 3 | #' The four main types of functions are to declare a step, to combine steps into designs, 4 | #' and to manipulate designs and designers (functions that return designs). 5 | #' 6 | #' @section Design Steps: 7 | #' \describe{ 8 | #' \item{\code{\link{declare_model}}}{Model step} 9 | #' \item{\code{\link{declare_inquiry}}}{Inquiry step} 10 | #' \item{\code{\link{declare_sampling}}}{Data strategy step (sampling)} 11 | #' \item{\code{\link{declare_assignment}}}{Data strategy step (assignment)} 12 | #' \item{\code{\link{declare_measurement}}}{Data strategy step (measurement)} 13 | #' \item{\code{\link{declare_estimator}}}{Answer strategy step (Estimator)} 14 | #' \item{\code{\link{declare_test}}}{Answer strategy step (Testing function)} 15 | #' } 16 | #' 17 | #' @section Design Objects: 18 | #' \describe{ 19 | #' \item{+}{Add steps to create a design} 20 | #' \item{\code{\link{redesign}}}{Change design parameters} 21 | #' \item{\code{\link{draw_data}}}{Draw a simulated dataset} 22 | #' \item{\code{\link{run_design}}}{Draw one set of inquiry values and estimates} 23 | #' \item{\code{\link{diagnose_design}}}{Diagnose a design} 24 | #' \item{\code{\link{cite_design}}}{Cite a design} 25 | #' } 26 | #' 27 | #' 28 | #' @section Design Editing: 29 | #' \describe{ 30 | #' \item{\code{\link{modify_design}}}{Add, delete or replace a step} 31 | #' \item{\code{\link{redesign}}}{Modify local variables within a design (advanced)} 32 | #' } 33 | #' 34 | #' 35 | #' @section Designers: 36 | #' \describe{ 37 | #' \item{\code{\link{expand_design}}}{Generate designs from a designer} 38 | #' \item{designs}{See also the \code{DesignLibrary} package for designers to use} 39 | #' } 40 | #' 41 | #' 42 | #' @docType package 43 | #' @importFrom stats glm lm var vcov sd aggregate anova aov as.formula confint coef df.residual pt qt rbinom rnorm rmultinom update.formula 44 | #' @importFrom utils data capture.output 45 | #' @name DeclareDesign 46 | "_PACKAGE" 47 | 48 | utils::globalVariables(c("Y", "Z", "S", "N", "conf.low", "conf.high", "estimate", "inquiry", "p.value", "std.error", "term")) 49 | -------------------------------------------------------------------------------- /R/declare_measurement.R: -------------------------------------------------------------------------------- 1 | #' Declare measurement procedure 2 | #' 3 | #' This function adds measured data columns that can be functions of unmeasured data columns. 4 | #' 5 | #' It is also possible to include measured variables in your declare_model call or to add variables using declare_step. However, putting latent variables in declare_model and variables-as-measured in declare_measurement helps communicate which parts of your research design are in M and which parts are in D. 6 | #' 7 | #' @inheritParams declare_internal_inherit_params 8 | #' @return A function that returns a data.frame. 9 | #' @export 10 | #' @importFrom fabricatr fabricate 11 | #' 12 | #' @examples 13 | #' 14 | #' # declare_measurement in use 15 | #' ## Two-arm randomized experiment 16 | #' design <- 17 | #' declare_model( 18 | #' N = 500, 19 | #' X = rep(c(0, 1), each = N / 2), 20 | #' U = rnorm(N, sd = 0.25), 21 | #' potential_outcomes(Y ~ 0.2 * Z + X + U) 22 | #' ) + 23 | #' declare_inquiry(ATE = mean(Y_Z_1 - Y_Z_0)) + 24 | #' declare_sampling(S = complete_rs(N = N, n = 200)) + 25 | #' declare_assignment(Z = complete_ra(N = N, m = 100)) + 26 | #' declare_measurement(Y = reveal_outcomes(Y ~ Z)) + 27 | #' declare_estimator(Y ~ Z, inquiry = "ATE") 28 | #' 29 | #' run_design(design) 30 | #' 31 | #' # Reveal potential outcomes according to treatment assignment 32 | #' design <- 33 | #' declare_model(N = 100, 34 | #' potential_outcomes(Y ~ rbinom( 35 | #' N, size = 1, prob = 0.1 * Z + 0.5 36 | #' ))) + 37 | #' declare_assignment(Z = complete_ra(N, m = 50)) + 38 | #' declare_measurement(Y = reveal_outcomes(Y ~ Z)) 39 | #' 40 | #' head(draw_data(design)) 41 | #' 42 | #' # Generate observed measurement from a latent value 43 | #' design <- 44 | #' declare_model(N = 100, latent = runif(N)) + 45 | #' declare_measurement(observed = rbinom(N, 1, prob = latent)) 46 | #' 47 | #' head(draw_data(design)) 48 | #' 49 | #' # Index creation 50 | #' library(psych) 51 | #' 52 | #' design <- 53 | #' declare_model( 54 | #' N = 500, 55 | #' X = rep(c(0, 1), each = N / 2), 56 | #' Y_1 = 0.2 * X + rnorm(N, sd = 0.25), 57 | #' Y_2 = 0.3 * X + 0.5 * rnorm(N, sd = 0.50), 58 | #' Y_3 = 0.1 * X + 0.4 * rnorm(N, sd = 0.75)) + 59 | #' declare_measurement( 60 | #' index = fa( 61 | #' r = cbind(Y_1, Y_2, Y_3), 62 | #' nfactors = 1, 63 | #' rotate = "varimax" 64 | #' )$scores 65 | #' ) 66 | #' 67 | #' draw_data(design) 68 | declare_measurement <- make_declarations(measurement_handler, "measurement") 69 | 70 | #' @param data A data.frame. 71 | #' @importFrom rlang quos !!! 72 | #' @importFrom fabricatr fabricate 73 | #' @rdname declare_measurement 74 | measurement_handler <- function(data, ...) { 75 | 76 | options <- quos(...) 77 | 78 | fabricate(data = data, !!!options, ID_label = NA) 79 | 80 | } 81 | -------------------------------------------------------------------------------- /R/declare_population.R: -------------------------------------------------------------------------------- 1 | #' Declare the size and features of the population 2 | #' 3 | #' Deprecated. Please use declare_model instead. 4 | #' 5 | #' @inheritParams declare_internal_inherit_params 6 | #' @return A potential outcomes declaration, which is a function that returns a data.frame. 7 | #' @export 8 | #' @importFrom fabricatr fabricate 9 | #' 10 | #' @keywords internal 11 | #' 12 | declare_population <- make_declarations(fabricate, "population") 13 | -------------------------------------------------------------------------------- /R/declare_step.R: -------------------------------------------------------------------------------- 1 | #' Declare a custom step 2 | #' 3 | #' With declare_step, you can include any function that takes data as one of its arguments and returns data in a design declaration. The first argument is always a "handler", which is the name of the data-in, data-out function. 4 | #' For handy data manipulations use \code{declare_step(fabricate, ...)}. 5 | #' @inheritParams declare_internal_inherit_params 6 | #' @return A function that returns a data.frame. 7 | #' @export 8 | #' @examples 9 | #' 10 | #' population <- declare_model(N = 5, noise = rnorm(N)) 11 | #' manipulate <- declare_step(fabricate, noise_squared = noise^2, zero = 0) 12 | #' 13 | #' design <- population + manipulate 14 | #' draw_data(design) 15 | #' 16 | declare_step <- make_declarations(function(data, ...f, ...) ...f(data, ...), "custom") 17 | -------------------------------------------------------------------------------- /R/draw_functions.R: -------------------------------------------------------------------------------- 1 | #' Draw data, estimates, and inquiries from a design 2 | #' 3 | #' @param design A design object, typically created using the + operator 4 | #' @param data A data.frame object with sufficient information to get the data, estimates, inquiries, an assignment vector, or a sample. 5 | #' @param start (Defaults to 1) a scalar indicating which step in the design to begin with. By default all data steps are drawn, from step 1 to the last step of the design. 6 | #' @param end (Defaults to \code{length(design)}) a scalar indicating which step in the design to finish drawing data by. 7 | #' 8 | #' @name draw_functions 9 | #' 10 | #' @examples 11 | #' 12 | #' # Two-arm randomized experiment 13 | #' design <- 14 | #' declare_model( 15 | #' N = 500, 16 | #' gender = rbinom(N, 1, 0.5), 17 | #' X = rep(c(0, 1), each = N / 2), 18 | #' U = rnorm(N, sd = 0.25), 19 | #' potential_outcomes(Y ~ 0.2 * Z + X + U) 20 | #' ) + 21 | #' declare_inquiry(ATE = mean(Y_Z_1 - Y_Z_0)) + 22 | #' declare_sampling(S = complete_rs(N = N, n = 200)) + 23 | #' declare_assignment(Z = complete_ra(N = N, m = 100)) + 24 | #' declare_measurement(Y = reveal_outcomes(Y ~ Z)) + 25 | #' declare_estimator(Y ~ Z, inquiry = "ATE") 26 | #' 27 | #' # Use draw_data to create a dataset using a design 28 | #' dat <- draw_data(design) 29 | #' 30 | #' # Use end argument to draw data up to a certain design component 31 | #' dat_no_sampling <- draw_data(design, end = 3) 32 | #' 33 | #' # Use draw_estimands to extract value of inquiry 34 | #' draw_estimands(design) 35 | #' 36 | #' # Use draw_estimates to extract value of estimator 37 | #' draw_estimates(design) 38 | #' 39 | #' @export 40 | draw_data <- function(design, data = NULL, start = 1, end = length(design)) { 41 | data_internal <- data 42 | if(is.null(data_internal)) { 43 | data_internal <- -9 44 | } 45 | get_function_internal( 46 | design, data_internal, start, end, function(x) attr(x, "causal_type") %in% "dgp") 47 | } 48 | 49 | #' @param ... A design or set of designs typically created using the + operator 50 | #' @rdname draw_functions 51 | #' 52 | #' @export 53 | draw_estimand <- function(...) apply_on_design_dots(draw_estimands_single_design, ...) 54 | 55 | #' @param ... A design or set of designs typically created using the + operator 56 | #' @rdname draw_functions 57 | #' 58 | #' @export 59 | draw_estimands <- draw_estimand 60 | 61 | #' @rdname draw_functions 62 | #' 63 | #' @export 64 | draw_estimates <- function(...) apply_on_design_dots(draw_estimates_single_design, ...) 65 | 66 | draw_estimates_single_design <- function(design) { 67 | get_function_internal( 68 | design, -9, 1, length(design), function(x) TRUE, 69 | list("estimator" = vector("list", length(design))), "estimates_df", step_type = "estimator") 70 | } 71 | 72 | draw_estimands_single_design <- function(design) { 73 | get_function_internal( 74 | design, -9, 1, length(design), function(x) TRUE, 75 | list("inquiry" = vector("list", length(design))), "inquiries_df", step_type = "inquiry") 76 | } 77 | 78 | -------------------------------------------------------------------------------- /R/expand_design.R: -------------------------------------------------------------------------------- 1 | #' Declare a design via a designer 2 | #' 3 | #' \code{expand_design} easily generates a set of design from a designer function. 4 | #' 5 | 6 | #' @param designer a function which yields a design 7 | #' @param ... Options sent to the designer 8 | #' @param expand boolean - if true, form the crossproduct of the ..., otherwise recycle them 9 | #' @param prefix prefix for the names of the designs, i.e. if you create two designs they would be named prefix_1, prefix_2 10 | #' 11 | #' @return if set of designs is size one, the design, otherwise a `by`-list of designs. Designs are given a parameters attribute with the values of parameters assigned by expand_design. 12 | #' 13 | #' @examples 14 | #' 15 | #' \dontrun{ 16 | #' 17 | #' # in conjunction with DesignLibrary 18 | #' 19 | #' library(DesignLibrary) 20 | #' 21 | #' designs <- expand_design(multi_arm_designer, outcome_means = list(c(3,2,4), c(1,4,1))) 22 | #' 23 | #' diagnose_design(designs) 24 | #' 25 | #' # with a custom designer function 26 | #' 27 | #' designer <- function(N) { 28 | #' design <- 29 | #' declare_model( 30 | #' N = N, 31 | #' U = rnorm(N), 32 | #' potential_outcomes(Y ~ 0.20 * Z + U) 33 | #' ) + 34 | #' declare_inquiry(ATE = mean(Y_Z_1 - Y_Z_0)) + 35 | #' declare_assignment(Z = complete_ra(N, m = N/2)) + 36 | #' declare_measurement(Y = reveal_outcomes(Y ~ Z)) + 37 | #' declare_estimator(Y ~ Z, inquiry = "ATE") 38 | #' return(design) 39 | #' } 40 | #' 41 | #' # returns list of eight designs 42 | #' designs <- expand_design(designer, N = seq(30, 100, 10)) 43 | #' 44 | #' # diagnose a list of designs created by expand_design or redesign 45 | #' diagnosis <- diagnose_design(designs, sims = 50) 46 | #' 47 | #' # returns a single design 48 | #' large_design <- expand_design(designer, N = 200) 49 | #' 50 | #' diagnose_large_design <- diagnose_design(large_design, sims = 50) 51 | #' 52 | #' } 53 | #' 54 | #' @export 55 | expand_design <- function(designer, ..., expand = TRUE, prefix = "design") { 56 | dots_quos <- quos(...) 57 | 58 | if (length(dots_quos) == 0) return(designer()) 59 | 60 | # transpose 61 | transp <- function(zx,ix) do.call(mapply, 62 | append(mapply(`[`, zx, ix, SIMPLIFY = FALSE), 63 | list(FUN = list, SIMPLIFY = FALSE), 64 | after = 0) 65 | ) 66 | 67 | args <- list(...) 68 | args <- lapply(args, function(x) if(is.function(x)) list(x) else x) 69 | 70 | ix <- lapply(args, seq_along) 71 | ix <- if(expand) expand.grid(ix) else data.frame(ix) 72 | 73 | designs <- lapply(transp(args, ix), do.call, what = designer) 74 | 75 | args_names <- lapply(dots_quos, expand_args_names) 76 | 77 | designs <- mapply(structure, 78 | designs, 79 | parameters = transp(args_names, ix), 80 | SIMPLIFY = FALSE) 81 | 82 | 83 | if (length(designs) == 1) { 84 | designs <- designs[[1]] 85 | } else { 86 | names(designs) <- paste0(prefix, "_", seq_along(designs)) 87 | } 88 | 89 | designs 90 | } 91 | 92 | 93 | 94 | #' @importFrom rlang quo_squash is_call call_args 95 | expand_args_names <- function(x) { 96 | x_expr <- quo_squash(x) 97 | is_list_c <- expr_text(as.list(x_expr)[[1]]) %in% c("c", "list") 98 | x <- if (is_list_c) call_args(x_expr) 99 | else if (is_call(x_expr)) eval_tidy(x) 100 | else x_expr 101 | as.character(x) 102 | } 103 | 104 | 105 | -------------------------------------------------------------------------------- /R/get_functions.R: -------------------------------------------------------------------------------- 1 | #' Get estimates, inquiries, assignment vectors, or samples from a design given data 2 | #' 3 | #' @param design A design object, typically created using the + operator 4 | #' @param data A data.frame object with sufficient information to get the data, estimates, inquiries, an assignment vector, or a sample. 5 | #' @param start (Defaults to 1) a scalar indicating which step in the design to begin with. By default all data steps are drawn, from step 1 to the last step of the design. 6 | #' @param end (Defaults to \code{length(design)}) a scalar indicating which step in the design to finish with. 7 | #' 8 | #' @examples 9 | #' 10 | #' design <- 11 | #' declare_model( 12 | #' N = 100, 13 | #' U = rnorm(N), 14 | #' potential_outcomes(Y ~ Z + U) 15 | #' ) + 16 | #' declare_inquiry(ATE = mean(Y_Z_1 - Y_Z_0)) + 17 | #' declare_sampling(S = complete_rs(N, n = 75)) + 18 | #' declare_assignment(Z = complete_ra(N, m = 50)) + 19 | #' declare_measurement(Y = reveal_outcomes(Y ~ Z)) + 20 | #' declare_estimator(Y ~ Z, inquiry = "ATE") 21 | #' 22 | #' dat <- draw_data(design) 23 | #' 24 | #' draw_data(design, data = dat, start = 2) 25 | #' 26 | #' get_estimates(design, data = dat) 27 | #' 28 | #' @name get_functions 29 | 30 | #' @rdname get_functions 31 | #' @export 32 | get_estimates <- function(design, data = NULL, start = 1, end = length(design)) { 33 | 34 | if(is.null(data)){ 35 | stop("Please provide a data frame to the data argument. If you would like to get estimates from simulated data, use draw_estimates to draw data and get estimates in one step.") 36 | } 37 | 38 | get_function_internal( 39 | design, data, start, end, function(x) attr(x, "causal_type") %in% "estimator", NULL, "estimates_df", step_type = "estimator") 40 | } 41 | 42 | # utilities 43 | 44 | check_design_class_single <- function(design) { 45 | if(!inherits(design, "design")) 46 | stop("Please send a single design object to the design argument, typically created using the + operator.", call. = FALSE) 47 | } 48 | 49 | check_has_step_type <- function(design, step_type) { 50 | if(!is.null(step_type)){ 51 | step_types <- sapply(design, function(x) attr(x, "step_type")) 52 | if(!any(step_types %in% step_type)) 53 | stop(paste0("The design does not include any ", step_type, " steps."), call. = FALSE) 54 | } 55 | } 56 | 57 | get_function_internal <- function(design, data = NULL, start, end, pred, results = list(current_df = 0), what = "current_df", step_type = NULL) { 58 | 59 | check_design_class_single(design) 60 | 61 | if(identical(data, -9)){ 62 | # Special NULL for draw_data 63 | data <- NULL 64 | } else if (!is.data.frame(data)) { 65 | stop("Please provide a data.frame to the data argument") 66 | } 67 | 68 | if(start < 1 || start > length(design)){ 69 | stop("Please provide a starting step as a number between 1 and the total number of steps in the design.") 70 | } 71 | 72 | if(end < 1 || end > length(design)){ 73 | stop("Please provide an end step as a number between 1 and the total number of steps in the design.") 74 | } 75 | 76 | design_subset <- Filter(pred, design[start:end]) 77 | 78 | check_has_step_type(design_subset, step_type) 79 | 80 | ret <- run_design_internal.design(design_subset, current_df = data, results = results)[[what]] 81 | 82 | if(what == "estimates_df" && !is.null(ret$estimator) && typeof(ret$estimator) != "character"){ 83 | warning("The estimator label should be a character, but it is a ", 84 | class(ret$estimator), 85 | ". Try using handler = tidy_estimator(your_estimator_function)", call. = FALSE) 86 | } 87 | 88 | if(what == "inquiries_df" && !is.null(ret$inquiry) && typeof(ret$inquiry) != "character"){ 89 | warning("The inquiry label should be a character, but it is a ", 90 | class(ret$inquiry), 91 | ". You may need stringsAsFactors = FALSE in your inquiry function.", call. = FALSE) 92 | } 93 | 94 | ret 95 | 96 | } -------------------------------------------------------------------------------- /R/modify_edit.R: -------------------------------------------------------------------------------- 1 | #' Override environment via shim 2 | #' 3 | #' @rdname edit 4 | #' @keywords internal 5 | #' @examples 6 | #' \dontrun{ 7 | #' here_i_am <- "foo" 8 | #' dot <- quo(here_i_am) 9 | #' dot2 <- DeclareDesign:::clone_dot_edit_env(dot, here_i_am = "some_message", xyxyx = "bar") 10 | #' rlang::eval_tidy(dot) 11 | #' rlang::eval_tidy(dot2) 12 | #' } 13 | clone_dot_edit_env <- function(dot, ..., to_replace = list(...)) { 14 | if (is.null(environment(dot))) { 15 | return(dot) 16 | } 17 | environment(dot) <- list2env(to_replace, parent = environment(dot)) 18 | 19 | dot 20 | } 21 | 22 | #' @rdname edit 23 | #' @keywords internal 24 | #' @examples 25 | #' \dontrun{ 26 | #' N <- 50 27 | #' 28 | #' pop50 <- declare_model(N=N, noise=rnorm(N)) 29 | #' nrow(pop50()) 30 | #' 31 | #' pop100 <- DeclareDesign:::clone_step_edit(pop50, N=100) 32 | #' nrow(pop100()) 33 | #' nrow(pop50()) 34 | #' 35 | #' } 36 | clone_step_edit <- function(step, ..., to_replace = list(...)) { 37 | step_attributes <- attributes(step) 38 | 39 | step_attributes$dots[] <- lapply(step_attributes$dots, clone_dot_edit_env, to_replace = to_replace) 40 | 41 | f <- with(step_attributes, currydata(handler, dots)) 42 | attributes(f) <- step_attributes 43 | f 44 | } 45 | 46 | #' @rdname edit 47 | #' @keywords internal 48 | clone_design_edit <- function(design, ..., to_replace = list(...)) { 49 | design[] <- lapply(design, clone_step_edit, to_replace = to_replace) 50 | 51 | design 52 | } 53 | -------------------------------------------------------------------------------- /R/ops.R: -------------------------------------------------------------------------------- 1 | 2 | `%i%` <- intersect 3 | 4 | `%icn%` <- function(e1, e2) e1 %i% colnames(e2) 5 | -------------------------------------------------------------------------------- /R/redesign.R: -------------------------------------------------------------------------------- 1 | #' Redesign 2 | #' 3 | #' \code{redesign} quickly generates a design from an existing one by resetting symbols used in design handler parameters in a step's environment (Advanced). 4 | #' 5 | #' Warning: \code{redesign} will edit any symbol in your design, but if the symbol you attempt to change does not exist in a step's environment no changes will be made and no error or warning will be issued. 6 | #' 7 | #' Please note that \code{redesign} functionality is experimental and may be changed in future versions. 8 | #' 9 | #' @param design An object of class design. 10 | #' @param ... Arguments to redesign e.g., \code{n = 100.} If redesigning multiple arguments, they must be specified as a named list. 11 | #' @param expand If TRUE, redesign using the crossproduct of \code{...}, otherwise recycle them. 12 | #' @return A design, or, in the case of multiple values being passed onto \code{...}, a `by`-list of designs. 13 | #' @examples 14 | #' 15 | #' # Two-arm randomized experiment 16 | #' n <- 500 17 | #' 18 | #' design <- 19 | #' declare_model( 20 | #' N = 1000, 21 | #' gender = rbinom(N, 1, 0.5), 22 | #' X = rep(c(0, 1), each = N / 2), 23 | #' U = rnorm(N, sd = 0.25), 24 | #' potential_outcomes(Y ~ 0.2 * Z + X + U) 25 | #' ) + 26 | #' declare_inquiry(ATE = mean(Y_Z_1 - Y_Z_0)) + 27 | #' declare_sampling(S = complete_rs(N = N, n = n)) + 28 | #' declare_assignment(Z = complete_ra(N = N, m = n/2)) + 29 | #' declare_measurement(Y = reveal_outcomes(Y ~ Z)) + 30 | #' declare_estimator(Y ~ Z, inquiry = "ATE") 31 | #' 32 | #' # Use redesign to return a single modified design 33 | #' modified_design <- redesign(design, n = 200) 34 | #' 35 | #' # Use redesign to return a series of modified designs 36 | #' ## Sample size is varied while the rest of the design remains 37 | #' ## constant 38 | #' design_vary_N <- redesign(design, n = c(100, 500, 900)) 39 | #' 40 | #' \dontrun{ 41 | #' # redesign can be used in conjunction with diagnose_designs 42 | #' # to optimize the design for specific diagnosands 43 | #' diagnose_designs(design_vary_N) 44 | #' } 45 | #' 46 | #' # When redesigning with arguments that are vectors, 47 | #' # use list() in redesign, with each list item 48 | #' # representing a design you wish to create 49 | #' 50 | #' prob_each <- c(.1, .5, .4) 51 | #' 52 | #' population <- declare_model(N = 1000) 53 | #' assignment <- declare_assignment( 54 | #' Z = complete_ra(prob_each = prob_each), 55 | #' legacy = FALSE) 56 | #' 57 | #' design <- population + assignment 58 | #' 59 | #' ## returns two designs 60 | #' 61 | #' designs_vary_prob_each <- redesign( 62 | #' design, 63 | #' prob_each = list(c(.2, .5, .3), c(0, .5, .5))) 64 | #' 65 | #' # To illustrate what does and does not get edited by redesign, 66 | #' # consider the following three designs. In the first two, argument 67 | #' # X is called from the step's environment; in the third it is not. 68 | #' # Using redesign will alter the role of X in the first two designs 69 | #' # but not the third one. 70 | #' 71 | #' X <- 3 72 | #' f <- function(b, X) b*X 73 | #' g <- function(b) b*X 74 | #' 75 | #' design1 <- declare_model(N = 1, A = X) + NULL 76 | #' design2 <- declare_model(N = 1, A = f(2, X)) + NULL 77 | #' design3 <- declare_model(N = 1, A = g(2)) + NULL 78 | #' 79 | #' draw_data(design1) 80 | #' draw_data(design2) 81 | #' draw_data(design3) 82 | #' 83 | #' draw_data(redesign(design1, X=0)) 84 | #' draw_data(redesign(design2, X=0)) 85 | #' draw_data(redesign(design3, X=0)) 86 | #' 87 | #' @export 88 | redesign <- function(design, ..., expand = TRUE) { 89 | check_design_class_single(design) 90 | 91 | f <- function(...) { 92 | clone_design_edit(design, ...) 93 | } 94 | design <- expand_design(f, ..., expand = expand) 95 | structure(design, code = NULL) 96 | } 97 | -------------------------------------------------------------------------------- /R/set_citation.R: -------------------------------------------------------------------------------- 1 | #' Set the citation of a design 2 | #' 3 | #' @param design A design typically created using the + operator 4 | #' @param title The title of the design, as a character string. 5 | #' @param author The author(s) of the design, as a character string. 6 | #' @param year The year of the design, as a character string. 7 | #' @param description A description of the design in words, as a character string. 8 | #' @param citation (optional) The preferred citation for the design, as a character string, in which case title, author, year, and description may be left unspecified. 9 | #' 10 | #' @return a design object with a citation attribute 11 | #' 12 | #' @examples 13 | #' 14 | #' # Setup for example 15 | #' design <- 16 | #' declare_model(data = sleep) + 17 | #' declare_sampling(S = complete_rs(N, n = 10)) 18 | #' 19 | #' # Set citation using set_citation 20 | #' design <- 21 | #' set_citation(design, 22 | #' author = "Lovelace, Ada", 23 | #' title = "Notes", 24 | #' year = 1953, 25 | #' description = 26 | #' "This is a text description of a design") 27 | #' 28 | #' # View citation information using cite_design 29 | #' cite_design(design) 30 | #' 31 | #' @export 32 | set_citation <- 33 | function(design, 34 | title = NULL, 35 | author = NULL, 36 | year = NULL, 37 | description = "Unpublished research design declaration", 38 | citation = NULL) { 39 | check_design_class_single(design) 40 | 41 | if (!is.null(citation)) { 42 | cite <- citation 43 | } else { 44 | cite <- bibentry( 45 | "unpublished", 46 | title = title, 47 | author = author, 48 | note = description, 49 | year = year, 50 | textVersion = citation 51 | ) 52 | } 53 | attr(design, "citation") <- cite 54 | design 55 | } 56 | -------------------------------------------------------------------------------- /R/set_diagnosands.R: -------------------------------------------------------------------------------- 1 | #' Set the diagnosands for a design 2 | #' 3 | #' A researcher often has a set of diagnosands in mind to appropriately assess the quality of a design. \code{set_diagnosands} sets the default diagnosands for a design, so that later readers can assess the design on the same terms as the original author. Readers can also use \code{diagnose_design} to diagnose the design using any other set of diagnosands. 4 | #' 5 | #' @param x A design typically created using the + operator, or a simulations data.frame created by \code{simulate_design}. 6 | #' @param diagnosands A set of diagnosands created by \code{\link{declare_diagnosands}} 7 | #' 8 | #' @return a design object with a diagnosand attribute 9 | #' 10 | #' @examples 11 | #' 12 | #' # Two-arm randomized experiment 13 | #' design <- 14 | #' declare_model( 15 | #' N = 500, 16 | #' gender = rbinom(N, 1, 0.5), 17 | #' X = rep(c(0, 1), each = N / 2), 18 | #' U = rnorm(N, sd = 0.25), 19 | #' potential_outcomes(Y ~ 0.2 * Z + X + U) 20 | #' ) + 21 | #' declare_inquiry(ATE = mean(Y_Z_1 - Y_Z_0)) + 22 | #' declare_sampling(S = complete_rs(N = N, n = 200)) + 23 | #' declare_assignment(Z = complete_ra(N = N, m = 100)) + 24 | #' declare_measurement(Y = reveal_outcomes(Y ~ Z)) + 25 | #' declare_estimator(Y ~ Z, inquiry = "ATE") 26 | #' 27 | #' # You can choose your own diagnosands instead of the defaults: 28 | #' 29 | #' my_diagnosands <- 30 | #' declare_diagnosands(median_bias = median(estimate - estimand)) 31 | #' 32 | #' \dontrun{ 33 | #' ## You can set diagnosands with set_diagnosands 34 | #' design <- set_diagnosands(design, diagnosands = my_diagnosands) 35 | #' diagnosis <- diagnose_design(design) 36 | #' diagnosis 37 | #' 38 | #' ## Using set_diagnosands to diagnose simulated data 39 | #' simulations_df <- simulate_design(design) 40 | #' 41 | #' simulations_df <- set_diagnosands(simulations_df, my_diagnosands) 42 | #' 43 | #' diagnose_design(simulations_df) 44 | #' 45 | #' # If you do not specify diagnosands in diagnose_design, 46 | #' # the function default_diagnosands() is used, 47 | #' # which is reproduced below. 48 | #' 49 | #' alpha <- 0.05 50 | #' 51 | #' default_diagnosands <- 52 | #' declare_diagnosands( 53 | #' mean_estimand = mean(estimand), 54 | #' mean_estimate = mean(estimate), 55 | #' bias = mean(estimate - estimand), 56 | #' sd_estimate = sqrt(pop.var(estimate)), 57 | #' rmse = sqrt(mean((estimate - estimand) ^ 2)), 58 | #' power = mean(p.value <= alpha), 59 | #' coverage = mean(estimand <= conf.high & estimand >= conf.low) 60 | #' ) 61 | #' 62 | #' diagnose_design( 63 | #' simulations_df, 64 | #' diagnosands = default_diagnosands 65 | #' ) 66 | #' 67 | #' # A longer list of potentially useful diagnosands might include: 68 | #' 69 | #' extended_diagnosands <- 70 | #' declare_diagnosands( 71 | #' mean_estimand = mean(estimand), 72 | #' mean_estimate = mean(estimate), 73 | #' bias = mean(estimate - estimand), 74 | #' sd_estimate = sd(estimate), 75 | #' rmse = sqrt(mean((estimate - estimand) ^ 2)), 76 | #' power = mean(p.value <= alpha), 77 | #' coverage = mean(estimand <= conf.high & estimand >= conf.low), 78 | #' mean_se = mean(std.error), 79 | #' type_s_rate = mean((sign(estimate) != sign(estimand))[p.value <= alpha]), 80 | #' exaggeration_ratio = mean((estimate/estimand)[p.value <= alpha]), 81 | #' var_estimate = pop.var(estimate), 82 | #' mean_var_hat = mean(std.error^2), 83 | #' prop_pos_sig = mean(estimate > 0 & p.value <= alpha), 84 | #' mean_ci_length = mean(conf.high - conf.low) 85 | #' ) 86 | #' 87 | #' diagnose_design( 88 | #' simulations_df, 89 | #' diagnosands = extended_diagnosands 90 | #' ) 91 | #' 92 | #' } 93 | #' @export 94 | set_diagnosands <- function(x, diagnosands = default_diagnosands) { 95 | 96 | attr(x, "diagnosands") <- diagnosands 97 | 98 | x 99 | } 100 | -------------------------------------------------------------------------------- /R/tidy_try.R: -------------------------------------------------------------------------------- 1 | #' Tidy Model Results and Filter to Relevant Coefficients 2 | #' 3 | #' Tidy function that returns a tidy data.frame of model results and allows filtering to relevant coefficients. The function will attempt to tidy model objects even when they do not have a tidy method available. For best results, first load the broom package via \code{library(broom)}. 4 | #' 5 | #' @param fit A model fit, as returned by a modeling function like lm, glm, or estimatr::lm_robust. 6 | #' @param term A character vector of the terms that represent quantities of interest, i.e., "Z". If FALSE, return the first non-intercept term; if TRUE return all terms. 7 | #' 8 | #' @return A data.frame with coefficient estimates and associated statistics. 9 | #' 10 | #' @export 11 | #' 12 | #' @examples 13 | #' 14 | #' fit <- lm(mpg ~ hp + disp + cyl, data = mtcars) 15 | #' 16 | #' tidy_try(fit) 17 | #' 18 | tidy_try <- function(fit, term = FALSE) { 19 | 20 | if (hasS3Method("tidy", fit)) { 21 | tidy_df <- tidy(fit, conf.int = TRUE) 22 | } else { 23 | tidy_df <- try(tidy_try_internal(fit, conf.int = TRUE), silent = TRUE) 24 | 25 | if(inherits(tidy_df, "try-error")){ 26 | stop("We were unable to tidy the output of the function provided to 'model'. 27 | It is possible that the broom package has a tidier for that object type. 28 | If not, you can use a custom estimator to 'estimator_function'. 29 | See examples in ?declare_estimator") 30 | } 31 | } 32 | tidy_df 33 | } 34 | 35 | tidy_try_internal <- function(x, conf.int = TRUE) { 36 | # TODO: error checking -- are column names named as we expect 37 | 38 | val <- try({ 39 | summ <- coef(summary(x)) 40 | 41 | if(conf.int == TRUE) { 42 | ci <- suppressMessages(as.data.frame(confint(x))) 43 | tidy_df <- data.frame(term = rownames(summ), summ, ci, stringsAsFactors = FALSE, row.names = NULL) 44 | colnames(tidy_df) <- c("term", "estimate", "std.error", "statistic", "p.value", "conf.low", "conf.high") 45 | } else { 46 | tidy_df <- data.frame(term = rownames(summ), summ, ci, stringsAsFactors = FALSE, row.names = NULL) 47 | colnames(tidy_df) <- c("term", "estimate", "std.error", "statistic", "p.value") 48 | } 49 | 50 | }, silent = TRUE) 51 | 52 | if(inherits(val, "try-error")){ 53 | stop("The default tidy method for the model fit of class ", class(x), " failed. You may try installing and loading the broom package, or you can write your own tidy.", class(x), " method.", call. = FALSE) 54 | } 55 | 56 | tidy_df 57 | } 58 | 59 | #' @importFrom generics tidy 60 | #' @export 61 | generics::tidy 62 | 63 | #' @importFrom utils getS3method 64 | #' @importFrom methods extends 65 | hasS3Method <- function(f, obj) { 66 | o_classes <- if(isS4(obj)) extends(class(obj)) else class(obj) 67 | for(i in o_classes) { 68 | get_function <- try(getS3method(f, i), silent = TRUE) 69 | if(!inherits(get_function, "try-error") && is.function(get_function)) return(TRUE) 70 | } 71 | FALSE 72 | } 73 | -------------------------------------------------------------------------------- /_pkgdown.yml: -------------------------------------------------------------------------------- 1 | url: https://declaredesign.org/r/declaredesign 2 | 3 | home: 4 | title: Declaring and diagnosing research designs 5 | 6 | template: 7 | bootstrap: 5 8 | bslib: 9 | primary: "#0054AD" 10 | border-radius: 0.5rem 11 | btn-border-radius: 0.25rem 12 | 13 | development: 14 | mode: auto 15 | 16 | navbar: 17 | left: 18 | - text: Getting started 19 | href: https://declaredesign.org/getting-started/ 20 | - text: Reference 21 | href: reference/index.html 22 | right: 23 | - text: "Software" 24 | menu: 25 | - text: DeclareDesign 26 | href: https://declaredesign.org/r/declaredesign/ 27 | - text: randomizr 28 | href: https://declaredesign.org/r/randomizr/ 29 | - text: fabricatr 30 | href: https://declaredesign.org/r/fabricatr/ 31 | - text: estimatr 32 | href: https://declaredesign.org/r/estimatr/ 33 | - text: rdss 34 | href: https://declaredesign.org/r/rdss/ 35 | - text: DesignLibrary 36 | href: https://declaredesign.org/r/designlibrary/ 37 | - text: DesignWizard 38 | href: https://eos.wzb.eu/ipi/DDWizard/ 39 | - text: declaredesign.org 40 | href: https://declaredesign.org 41 | 42 | reference: 43 | - title: Declare 44 | description: These functions declare research design steps 45 | contents: 46 | - declare_model 47 | - declare_inquiry 48 | - declare_inquiries 49 | - declare_sampling 50 | - declare_assignment 51 | - declare_measurement 52 | - declare_estimator 53 | - declare_estimators 54 | - declare_test 55 | - declare_step 56 | - set_citation 57 | - label_estimator 58 | - label_test 59 | - tidy_try 60 | - "`+.dd`" 61 | 62 | - title: Post-declaration functions 63 | description: These functions operate on declared designs 64 | contents: 65 | - cite_design 66 | - draw_data 67 | - draw_estimands 68 | - draw_estimates 69 | - run_design 70 | - get_estimates 71 | - print.design 72 | - summary.design 73 | - print_code 74 | 75 | - title: Diagnose 76 | description: These functions assist with research design diagnosis 77 | contents: 78 | - declare_diagnosands 79 | - diagnose_design 80 | - diagnose_designs 81 | - get_diagnosands 82 | - get_simulations 83 | - simulate_design 84 | - simulate_designs 85 | - set_diagnosands 86 | - reshape_diagnosis 87 | - tidy.diagnosis 88 | - pop.var 89 | 90 | - title: Redesign 91 | description: These functions modify declared designs 92 | contents: 93 | - insert_step 94 | - delete_step 95 | - replace_step 96 | - expand_design 97 | - redesign 98 | 99 | - title: Comparison 100 | description: These functions compare declared designs 101 | contents: 102 | - compare_diagnoses 103 | - compare_designs 104 | - compare_design_code 105 | - compare_design_summaries 106 | - compare_design_data 107 | - compare_design_estimates 108 | - compare_design_inquiries 109 | 110 | - title: Package 111 | description: Package description 112 | contents: 113 | - DeclareDesign 114 | -------------------------------------------------------------------------------- /codecov.yml: -------------------------------------------------------------------------------- 1 | comment: false 2 | 3 | coverage: 4 | status: 5 | project: 6 | default: 7 | target: auto 8 | threshold: 1% 9 | informational: true 10 | patch: 11 | default: 12 | target: auto 13 | threshold: 1% 14 | informational: true 15 | -------------------------------------------------------------------------------- /cran-comments.md: -------------------------------------------------------------------------------- 1 | ## Submission 2 | 3 | Small bug fix of parallel processing. 4 | 5 | ## Test environments 6 | * local OS X install (release) 7 | * win-builder (devel, release, oldrel) 8 | 9 | ## R CMD check results 10 | 11 | 0 errors | 0 warnings | 0 notes 12 | 13 | ## Reverse dependencies 14 | 15 | No changes to worse. 16 | 17 | --- 18 | -------------------------------------------------------------------------------- /inst/CITATION: -------------------------------------------------------------------------------- 1 | citHeader("To cite DeclareDesign in publications use:") 2 | 3 | bibentry( 4 | key = "blair_coppock_humphreys_2023", 5 | bibtype = "book", 6 | title = "Research Design in the Social Sciences: Declaration, Diagnosis, and Redesign", 7 | author = c(person("Graeme", "Blair"), 8 | person("Alexander", "Coppock"), 9 | person("Macartan", "Humphreys")), 10 | publisher = "Princeton University Press", 11 | address = "Princeton", 12 | 13 | year = "2023", 14 | url = "https://book.declaredesign.org", 15 | 16 | textVersion = 17 | paste("Graeme Blair, Alexander Coppock, and Macartan Humphreys (2023).", 18 | "Research Design in the Social Sciences: Declaration, Diagnosis, and Redesign.", 19 | "Princeton University Press.", 20 | "URL https://book.declaredesign.org") 21 | ) 22 | 23 | bibentry( 24 | key = "blair_cooper_coppock_humphreys_2019", 25 | bibtype = "article", 26 | title = "Declaring and Diagnosing Research Designs", 27 | author = c(person("Graeme", "Blair"), person("Jasper", "Cooper"), 28 | person("Alexander", "Coppock"), person("Macartan", "Humphreys")), 29 | journal = "American Political Science Review", 30 | volume = "113", 31 | issue = "3", 32 | pages = "838-859", 33 | year = "2019", 34 | url = "https://declaredesign.org/paper.pdf", 35 | 36 | textVersion = 37 | paste("Graeme Blair, Jasper Cooper, Alexander Coppock, and Macartan Humphreys (2019).", 38 | '"Declaring and Diagnosing Research Designs."', 39 | "American Political Science Review 113(3): 838-859.", 40 | "URL https://declaredesign.org/paper.pdf") 41 | ) 42 | 43 | -------------------------------------------------------------------------------- /man/DeclareDesign-deprecated.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/DeclareDesign-deprecated.R, 3 | % R/declare_estimator.R 4 | \name{DeclareDesign-deprecated} 5 | \alias{DeclareDesign-deprecated} 6 | \alias{tidy_estimator} 7 | \alias{model_handler} 8 | \title{Deprecated functions in package \pkg{DeclareDesign}.} 9 | \usage{ 10 | tidy_estimator(estimator_function) 11 | 12 | model_handler(...) 13 | } 14 | \description{ 15 | The functions listed below are deprecated and will be defunct in 16 | the near future. When possible, alternative functions with similar 17 | functionality are also mentioned. Help pages for deprecated functions are 18 | available at \code{help("-deprecated")}. 19 | } 20 | \section{\code{tidy_estimator}}{ 21 | 22 | For \code{tidy_estimator}, use \code{\link{label_estimator}}. 23 | } 24 | 25 | \section{\code{model_handler}}{ 26 | 27 | For \code{model_handler}, use \code{\link{method_handler}}. 28 | } 29 | 30 | \keyword{internal} 31 | -------------------------------------------------------------------------------- /man/DeclareDesign.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/DeclareDesign.R 3 | \docType{package} 4 | \name{DeclareDesign} 5 | \alias{DeclareDesign-package} 6 | \alias{DeclareDesign} 7 | \title{DeclareDesign package} 8 | \description{ 9 | The four main types of functions are to declare a step, to combine steps into designs, 10 | and to manipulate designs and designers (functions that return designs). 11 | } 12 | \section{Design Steps}{ 13 | 14 | \describe{ 15 | \item{\code{\link{declare_model}}}{Model step} 16 | \item{\code{\link{declare_inquiry}}}{Inquiry step} 17 | \item{\code{\link{declare_sampling}}}{Data strategy step (sampling)} 18 | \item{\code{\link{declare_assignment}}}{Data strategy step (assignment)} 19 | \item{\code{\link{declare_measurement}}}{Data strategy step (measurement)} 20 | \item{\code{\link{declare_estimator}}}{Answer strategy step (Estimator)} 21 | \item{\code{\link{declare_test}}}{Answer strategy step (Testing function)} 22 | } 23 | } 24 | 25 | \section{Design Objects}{ 26 | 27 | \describe{ 28 | \item{+}{Add steps to create a design} 29 | \item{\code{\link{redesign}}}{Change design parameters} 30 | \item{\code{\link{draw_data}}}{Draw a simulated dataset} 31 | \item{\code{\link{run_design}}}{Draw one set of inquiry values and estimates} 32 | \item{\code{\link{diagnose_design}}}{Diagnose a design} 33 | \item{\code{\link{cite_design}}}{Cite a design} 34 | } 35 | } 36 | 37 | \section{Design Editing}{ 38 | 39 | \describe{ 40 | \item{\code{\link{modify_design}}}{Add, delete or replace a step} 41 | \item{\code{\link{redesign}}}{Modify local variables within a design (advanced)} 42 | } 43 | } 44 | 45 | \section{Designers}{ 46 | 47 | \describe{ 48 | \item{\code{\link{expand_design}}}{Generate designs from a designer} 49 | \item{designs}{See also the \code{DesignLibrary} package for designers to use} 50 | } 51 | } 52 | 53 | \seealso{ 54 | Useful links: 55 | \itemize{ 56 | \item \url{https://declaredesign.org/r/declaredesign/} 57 | \item \url{https://github.com/DeclareDesign/DeclareDesign} 58 | \item Report bugs at \url{https://github.com/DeclareDesign/DeclareDesign/issues} 59 | } 60 | 61 | } 62 | \author{ 63 | \strong{Maintainer}: Graeme Blair \email{graeme.blair@gmail.com} (\href{https://orcid.org/0000-0001-9164-2102}{ORCID}) 64 | 65 | Authors: 66 | \itemize{ 67 | \item Jasper Cooper \email{jaspercooper@gmail.com} (\href{https://orcid.org/0000-0002-8639-3188}{ORCID}) 68 | \item Alexander Coppock \email{acoppock@gmail.com} (\href{https://orcid.org/0000-0002-5733-2386}{ORCID}) 69 | \item Macartan Humphreys \email{macartan@gmail.com} (\href{https://orcid.org/0000-0001-7029-2326}{ORCID}) 70 | \item Neal Fultz \email{nfultz@gmail.com} 71 | } 72 | 73 | } 74 | -------------------------------------------------------------------------------- /man/cite_design.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/design_helper_functions.R 3 | \name{cite_design} 4 | \alias{cite_design} 5 | \title{Obtain the preferred citation for a design} 6 | \usage{ 7 | cite_design(design, ...) 8 | } 9 | \arguments{ 10 | \item{design}{a design object created using the + operator} 11 | 12 | \item{...}{options for printing the citation if it is a BibTeX entry} 13 | } 14 | \description{ 15 | Obtain the preferred citation for a design 16 | } 17 | -------------------------------------------------------------------------------- /man/compare_diagnoses.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/compare_diagnoses.R 3 | \name{compare_diagnoses} 4 | \alias{compare_diagnoses} 5 | \title{Compare Diagnoses} 6 | \usage{ 7 | compare_diagnoses( 8 | design1, 9 | design2, 10 | sims = 500, 11 | bootstrap_sims = 100, 12 | merge_by_estimator = TRUE, 13 | alpha = 0.05 14 | ) 15 | } 16 | \arguments{ 17 | \item{design1}{A design or a diagnosis.} 18 | 19 | \item{design2}{A design or a diagnosis.} 20 | 21 | \item{sims}{The number of simulations, defaulting to 1000. \code{sims} may also be a vector indicating the number of simulations for each step in a design, as described for \code{\link{simulate_design}}. Used for both designs.} 22 | 23 | \item{bootstrap_sims}{Number of bootstrap replicates for the diagnosands to obtain the standard errors of the diagnosands, defaulting to \code{1000}. Set to \code{FALSE} to turn off bootstrapping. Used for both designs. Must be greater or equal to 100.} 24 | 25 | \item{merge_by_estimator}{A logical. Whether to include \code{estimator} in the set of columns used for merging. Defaults to \code{TRUE}.} 26 | 27 | \item{alpha}{The significance level, 0.05 by default.} 28 | } 29 | \value{ 30 | A list with a \code{data.frame} of compared diagnoses and both diagnoses. 31 | } 32 | \description{ 33 | Diagnose and compare designs. 34 | } 35 | \details{ 36 | The function \code{compare_diagnoses} runs a many-to-many merge matching by \code{inquiry} and \code{term} (if present). If \code{merge_by_estimator} equals \code{TRUE}, \code{estimator} is also included in the merging condition. Any diagnosand that is not included in both designs will be dropped from the merge. 37 | } 38 | \examples{ 39 | design_a <- 40 | declare_model(N = 100, 41 | U = rnorm(N), 42 | Y_Z_0 = U, 43 | Y_Z_1 = U + rnorm(N, mean = 2, sd = 2)) + 44 | declare_inquiry(ATE = mean(Y_Z_1 - Y_Z_0)) + 45 | declare_assignment(Z = complete_ra(N, prob = 0.5)) + 46 | declare_measurement(Y = reveal_outcomes(Y ~ Z)) + 47 | declare_estimator(Y ~ Z, inquiry = "ATE") 48 | 49 | design_b <- replace_step( 50 | design_a, step = "assignment", 51 | declare_assignment(Z = complete_ra(N, prob = 0.3)) ) 52 | 53 | comparison <- compare_diagnoses(design_a, design_b, sims = 40) 54 | 55 | } 56 | -------------------------------------------------------------------------------- /man/compare_functions.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/compare_designs.R 3 | \name{compare_functions} 4 | \alias{compare_functions} 5 | \alias{compare_designs} 6 | \alias{compare_design_code} 7 | \alias{compare_design_summaries} 8 | \alias{compare_design_data} 9 | \alias{compare_design_estimates} 10 | \alias{compare_design_inquiries} 11 | \title{Compare two designs} 12 | \usage{ 13 | compare_designs( 14 | design1, 15 | design2, 16 | format = "ansi8", 17 | pager = "off", 18 | context = -1L, 19 | rmd = FALSE 20 | ) 21 | 22 | compare_design_code( 23 | design1, 24 | design2, 25 | format = "ansi256", 26 | mode = "sidebyside", 27 | pager = "off", 28 | context = -1L, 29 | rmd = FALSE 30 | ) 31 | 32 | compare_design_summaries( 33 | design1, 34 | design2, 35 | format = "ansi256", 36 | mode = "sidebyside", 37 | pager = "off", 38 | context = -1L, 39 | rmd = FALSE 40 | ) 41 | 42 | compare_design_data( 43 | design1, 44 | design2, 45 | format = "ansi256", 46 | mode = "sidebyside", 47 | pager = "off", 48 | context = -1L, 49 | rmd = FALSE 50 | ) 51 | 52 | compare_design_estimates( 53 | design1, 54 | design2, 55 | format = "ansi256", 56 | mode = "auto", 57 | pager = "off", 58 | context = -1L, 59 | rmd = FALSE 60 | ) 61 | 62 | compare_design_inquiries( 63 | design1, 64 | design2, 65 | format = "ansi256", 66 | mode = "sidebyside", 67 | pager = "off", 68 | context = -1L, 69 | rmd = FALSE 70 | ) 71 | } 72 | \arguments{ 73 | \item{design1}{A design object, typically created using the + operator} 74 | 75 | \item{design2}{A design object, typically created using the + operator} 76 | 77 | \item{format}{Format (in console or HTML) options from \code{diffobj::diffChr}} 78 | 79 | \item{pager}{Pager option from \code{diffobj::diffChr}} 80 | 81 | \item{context}{Context option from \code{diffobj::diffChr} which sets the number of lines around differences that are printed. By default, all lines of the two objects are shown. To show only the lines that are different, set \code{context = 0}; to get one line around differences for context, set to 1.} 82 | 83 | \item{rmd}{Set to \code{TRUE} use in Rmarkdown HTML output. NB: will not work with LaTeX, Word, or other .Rmd outputs.} 84 | 85 | \item{mode}{Mode options from \code{diffobj::diffChr}} 86 | } 87 | \description{ 88 | Compare two designs 89 | } 90 | \examples{ 91 | 92 | design1 <- declare_model(N = 100, u = rnorm(N), potential_outcomes(Y ~ Z + u)) + 93 | declare_inquiry(ATE = mean(Y_Z_1 - Y_Z_0)) + 94 | declare_sampling(S = complete_rs(N, n = 75)) + 95 | declare_assignment(Z = complete_ra(N, m = 50)) + 96 | declare_measurement(Y = reveal_outcomes(Y ~ Z)) + 97 | declare_estimator(Y ~ Z, inquiry = "ATE") 98 | 99 | design2 <- declare_model(N = 200, U = rnorm(N), 100 | potential_outcomes(Y ~ 0.5*Z + U)) + 101 | declare_inquiry(ATE = mean(Y_Z_1 - Y_Z_0)) + 102 | declare_sampling(S = complete_rs(N, n = 100)) + 103 | declare_assignment(Z = complete_ra(N, m = 25)) + 104 | declare_measurement(Y = reveal_outcomes(Y ~ Z)) + 105 | declare_estimator(Y ~ Z, .method = lm_robust, inquiry = "ATE") 106 | 107 | compare_designs(design1, design2) 108 | compare_design_code(design1, design2) 109 | compare_design_summaries(design1, design2) 110 | compare_design_data(design1, design2) 111 | compare_design_estimates(design1, design2) 112 | compare_design_inquiries(design1, design2) 113 | 114 | } 115 | -------------------------------------------------------------------------------- /man/declare_assignment.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/declare_assignment.R 3 | \name{declare_assignment} 4 | \alias{declare_assignment} 5 | \alias{assignment_handler} 6 | \title{Declare Data Strategy: Assignment} 7 | \usage{ 8 | declare_assignment(..., handler = assignment_handler, label = NULL) 9 | 10 | assignment_handler(data, ..., legacy = FALSE) 11 | } 12 | \arguments{ 13 | \item{...}{arguments to be captured, and later passed to the handler} 14 | 15 | \item{handler}{a tidy-in, tidy-out function} 16 | 17 | \item{label}{a string describing the step} 18 | 19 | \item{data}{A data.frame.} 20 | 21 | \item{legacy}{Use the legacy randomizr functionality. This will be disabled in future; please use legacy = FALSE.} 22 | } 23 | \value{ 24 | A function that takes a data.frame as an argument and returns a data.frame with assignment columns appended. 25 | } 26 | \description{ 27 | Declare Data Strategy: Assignment 28 | } 29 | \examples{ 30 | # declare_assignment in use 31 | ## Two-arm randomized experiment 32 | design <- 33 | declare_model( 34 | N = 500, 35 | X = rep(c(0, 1), each = N / 2), 36 | U = rnorm(N, sd = 0.25), 37 | potential_outcomes(Y ~ 0.2 * Z + X + U) 38 | ) + 39 | declare_inquiry(ATE = mean(Y_Z_1 - Y_Z_0)) + 40 | declare_sampling(S = complete_rs(N = N, n = 200)) + 41 | declare_assignment(Z = complete_ra(N = N, m = 100)) + 42 | declare_measurement(Y = reveal_outcomes(Y ~ Z)) + 43 | declare_estimator(Y ~ Z, inquiry = "ATE") 44 | 45 | run_design(design) 46 | 47 | # Set up population to assign 48 | model <- declare_model( 49 | villages = add_level( 50 | N = 30, 51 | N_households = sample(c(50:100), N, replace = TRUE) 52 | ), 53 | households = add_level( 54 | N = N_households, 55 | N_members = sample(c(1, 2, 3, 4), N, 56 | prob = c(0.2, 0.3, 0.25, 0.25), replace = TRUE) 57 | ), 58 | individuals = add_level( 59 | N = N_members, 60 | age = sample(18:90, N, replace = TRUE), 61 | gender = rbinom(n = N, size = 1, prob = .5) 62 | ) 63 | ) 64 | 65 | # Assignment procedures 66 | ## Complete random assignment 67 | design <- 68 | model + 69 | declare_assignment(Z = complete_ra(N = N, m = 1000)) 70 | 71 | head(draw_data(design)) 72 | 73 | ## Cluster random assignment 74 | design <- 75 | model + 76 | declare_assignment(Z = cluster_ra(clusters = villages, 77 | n = 15)) 78 | 79 | head(draw_data(design)) 80 | 81 | ## Block and cluster random assignment 82 | design <- 83 | model + 84 | declare_assignment(Z = block_and_cluster_ra( 85 | blocks = villages, 86 | clusters = households, 87 | block_m = rep(20, 30) 88 | )) 89 | 90 | head(draw_data(design)) 91 | 92 | ## Block random assignment 93 | design <- 94 | model + 95 | declare_assignment(Z = block_ra(blocks = gender, m = 100)) 96 | 97 | head(draw_data(design)) 98 | 99 | ## Block random assignment using probabilities 100 | design <- 101 | model + 102 | declare_assignment(Z = block_ra(blocks = gender, 103 | block_prob = c(1 / 3, 2 / 3))) 104 | 105 | head(draw_data(design)) 106 | 107 | ## Factorial assignment 108 | design <- 109 | model + 110 | declare_assignment(Z1 = complete_ra(N = N, m = 100), 111 | Z2 = block_ra(blocks = Z1)) 112 | 113 | head(draw_data(design)) 114 | 115 | ## Assignment using functions outside of randomizr 116 | design <- 117 | model + 118 | declare_assignment(Z = rbinom(n = N, size = 1, prob = 0.35)) 119 | 120 | head(draw_data(design)) 121 | 122 | } 123 | -------------------------------------------------------------------------------- /man/declare_design.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/construct_design.R 3 | \name{declare_design} 4 | \alias{declare_design} 5 | \alias{+.dd} 6 | \title{Declare a design} 7 | \usage{ 8 | \method{+}{dd}(lhs, rhs) 9 | } 10 | \arguments{ 11 | \item{lhs}{A step in a research design, beginning with a function that defines the model. Steps are evaluated sequentially. With the exception of the first step, all steps must be functions that take a \code{data.frame} as an argument and return a \code{data.frame}. Steps are declared using the \code{declare_} functions, i.e., \code{\link{declare_model}}, \code{\link{declare_inquiry}}, \code{\link{declare_sampling}}, \code{\link{declare_assignment}}, \code{\link{declare_measurement}}, \code{\link{declare_estimator}}, and \code{\link{declare_test}}.} 12 | 13 | \item{rhs}{A second step in a research design} 14 | } 15 | \value{ 16 | a design 17 | } 18 | \description{ 19 | Declare a design 20 | } 21 | \examples{ 22 | 23 | design <- 24 | declare_model( 25 | N = 500, 26 | U = rnorm(N), 27 | potential_outcomes(Y ~ Z + U) 28 | ) + 29 | declare_inquiry(ATE = mean(Y_Z_1 - Y_Z_0)) + 30 | declare_sampling(S = complete_rs(N, n = 250)) + 31 | declare_assignment(Z = complete_ra(N, m = 25)) + 32 | declare_measurement(Y = reveal_outcomes(Y ~ Z)) + 33 | declare_estimator(Y ~ Z, inquiry = "ATE") 34 | 35 | dat <- draw_data(design) 36 | head(dat) 37 | 38 | run_design(design) 39 | 40 | # You may wish to have a design with only one step: 41 | 42 | design <- declare_model(N = 500, noise = rnorm(N)) + NULL 43 | 44 | dat <- draw_data(design) 45 | head(dat) 46 | 47 | } 48 | -------------------------------------------------------------------------------- /man/declare_diagnosands.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/declare_diagnosands.R 3 | \name{diagnosand_handler} 4 | \alias{diagnosand_handler} 5 | \alias{declare_diagnosands} 6 | \title{Declare diagnosands} 7 | \usage{ 8 | diagnosand_handler(data, ..., subset = NULL, alpha = 0.05, label) 9 | 10 | declare_diagnosands(..., handler = diagnosand_handler, label = NULL) 11 | } 12 | \arguments{ 13 | \item{data}{A data.frame.} 14 | 15 | \item{...}{A set of new diagnosands.} 16 | 17 | \item{subset}{A subset of the simulations data frame within which to calculate diagnosands e.g. \code{subset = p.value < .05}.} 18 | 19 | \item{alpha}{Alpha significance level. Defaults to \code{.05}.} 20 | 21 | \item{label}{Label for the set of diagnosands.} 22 | 23 | \item{handler}{a tidy-in, tidy-out function} 24 | } 25 | \value{ 26 | a function that returns a data.frame 27 | } 28 | \description{ 29 | Declare diagnosands 30 | } 31 | \details{ 32 | If term is TRUE, the names of ... will be returned in a \code{term} column, and \code{inquiry} 33 | will contain the step label. This can be used as an additional dimension for use in diagnosis. 34 | 35 | Diagnosands summarize the simulations generated by \code{\link{diagnose_design}} or \code{\link{simulate_design}}. Typically, the columns of the resulting simulations data.frame include the following variables: estimate, std.error, p.value, conf.low, conf.high, and inquiry. Many diagnosands will be a function of these variables. 36 | } 37 | \examples{ 38 | 39 | # Two-arm randomized experiment 40 | design <- 41 | declare_model( 42 | N = 500, 43 | gender = rbinom(N, 1, 0.5), 44 | X = rep(c(0, 1), each = N / 2), 45 | U = rnorm(N, sd = 0.25), 46 | potential_outcomes(Y ~ 0.2 * Z + X + U) 47 | ) + 48 | declare_inquiry(ATE = mean(Y_Z_1 - Y_Z_0)) + 49 | declare_sampling(S = complete_rs(N = N, n = 200)) + 50 | declare_assignment(Z = complete_ra(N = N, m = 100)) + 51 | declare_measurement(Y = reveal_outcomes(Y ~ Z)) + 52 | declare_estimator(Y ~ Z, inquiry = "ATE") 53 | 54 | \dontrun{ 55 | # using built-in defaults: 56 | diagnosis <- diagnose_design(design) 57 | diagnosis 58 | 59 | # You can choose your own diagnosands instead of the defaults: 60 | 61 | my_diagnosands <- 62 | declare_diagnosands(median_bias = median(estimate - estimand)) 63 | 64 | ## You can set diagnosands within the diagnose_design function 65 | ## using the 'diagnosands =' argument 66 | diagnosis <- diagnose_design(design, diagnosands = my_diagnosands) 67 | diagnosis 68 | 69 | ## You can also set diagnosands with set_diagnosands 70 | design <- set_diagnosands(design, diagnosands = my_diagnosands) 71 | diagnosis <- diagnose_design(design) 72 | diagnosis 73 | 74 | # If you do not specify diagnosands in diagnose_design, 75 | # the function default_diagnosands() is used, 76 | # which is reproduced below. 77 | 78 | alpha <- 0.05 79 | 80 | default_diagnosands <- 81 | declare_diagnosands( 82 | mean_estimand = mean(estimand), 83 | mean_estimate = mean(estimate), 84 | bias = mean(estimate - estimand), 85 | sd_estimate = sqrt(pop.var(estimate)), 86 | rmse = sqrt(mean((estimate - estimand) ^ 2)), 87 | power = mean(p.value <= alpha), 88 | coverage = mean(estimand <= conf.high & estimand >= conf.low) 89 | ) 90 | 91 | diagnose_design( 92 | design, 93 | diagnosands = default_diagnosands 94 | ) 95 | 96 | # A longer list of potentially useful diagnosands might include: 97 | 98 | extended_diagnosands <- 99 | declare_diagnosands( 100 | mean_estimand = mean(estimand), 101 | mean_estimate = mean(estimate), 102 | bias = mean(estimate - estimand), 103 | sd_estimate = sd(estimate), 104 | rmse = sqrt(mean((estimate - estimand) ^ 2)), 105 | power = mean(p.value <= alpha), 106 | coverage = mean(estimand <= conf.high & estimand >= conf.low), 107 | mean_se = mean(std.error), 108 | type_s_rate = mean((sign(estimate) != sign(estimand))[p.value <= alpha]), 109 | exaggeration_ratio = mean((estimate/estimand)[p.value <= alpha]), 110 | var_estimate = pop.var(estimate), 111 | mean_var_hat = mean(std.error^2), 112 | prop_pos_sig = mean(estimate > 0 & p.value <= alpha), 113 | mean_ci_length = mean(conf.high - conf.low) 114 | ) 115 | 116 | diagnose_design( 117 | design, 118 | diagnosands = extended_diagnosands 119 | ) 120 | } 121 | } 122 | -------------------------------------------------------------------------------- /man/declare_inquiry.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/declare_inquiry.R 3 | \name{declare_inquiry} 4 | \alias{declare_inquiry} 5 | \alias{declare_inquiries} 6 | \alias{declare_estimand} 7 | \alias{declare_estimands} 8 | \alias{inquiry_handler} 9 | \title{Declare inquiry} 10 | \usage{ 11 | declare_inquiry(..., handler = inquiry_handler, label = "inquiry") 12 | 13 | declare_inquiries(..., handler = inquiry_handler, label = "inquiry") 14 | 15 | declare_estimand(...) 16 | 17 | declare_estimands(...) 18 | 19 | inquiry_handler(data, ..., subset = NULL, term = FALSE, label) 20 | } 21 | \arguments{ 22 | \item{...}{arguments to be captured, and later passed to the handler} 23 | 24 | \item{handler}{a tidy-in, tidy-out function} 25 | 26 | \item{label}{a string describing the step} 27 | 28 | \item{data}{a data.frame} 29 | 30 | \item{subset}{a subset expression} 31 | 32 | \item{term}{TRUE/FALSE} 33 | } 34 | \value{ 35 | a function, I(), that accepts a data.frame as an argument and returns a data.frame containing the value of the inquiry, a^m. 36 | } 37 | \description{ 38 | Declares inquiries, or the inferential target of interest. Conceptually very close to "estimand" or "quantity of interest". 39 | } 40 | \details{ 41 | For the default diagnosands, the return value of the handler should have \code{inquiry} and \code{estimand} columns. 42 | 43 | If term is TRUE, the names of ... will be returned in a \code{term} column, 44 | and \code{inquiry} will contain the step label. This can be used as 45 | an additional dimension for use in diagnosis. 46 | } 47 | \examples{ 48 | 49 | 50 | # Set up a design for use in examples: 51 | ## Two-arm randomized experiment 52 | design <- 53 | declare_model( 54 | N = 500, 55 | X = rep(c(0, 1), each = N / 2), 56 | U = rnorm(N, sd = 0.25), 57 | potential_outcomes(Y ~ 0.2 * Z + X + U) 58 | ) + 59 | declare_assignment(Z = complete_ra(N = N, m = 250)) + 60 | declare_measurement(Y = reveal_outcomes(Y ~ Z)) 61 | 62 | head(draw_data(design)) 63 | 64 | # Some common inquiries 65 | design + 66 | declare_inquiry(ATE = mean(Y_Z_1 - Y_Z_0)) 67 | 68 | design + 69 | declare_inquiry(difference_in_var = var(Y_Z_1) - var(Y_Z_0)) 70 | 71 | design + 72 | declare_inquiry(mean_Y = mean(Y)) 73 | 74 | # Inquiries among a subset 75 | design + 76 | declare_inquiry(ATT = mean(Y_Z_1 - Y_Z_0), 77 | subset = (Z == 1)) 78 | 79 | design + 80 | declare_inquiry(CATE = mean(Y_Z_1 - Y_Z_0), 81 | subset = X == 1) 82 | 83 | # equivalently 84 | design + 85 | declare_inquiry(CATE = mean(Y_Z_1[X == 1] - Y_Z_0[X == 1])) 86 | 87 | # Add inquiries to a design along with estimators that 88 | # reference them 89 | diff_in_variances <- 90 | function(data) { 91 | data.frame(estimate = with(data, var(Y[Z == 1]) - var(Y[Z == 0]))) 92 | } 93 | 94 | design_1 <- 95 | design + 96 | declare_inquiry(ATE = mean(Y_Z_1 - Y_Z_0), 97 | difference_in_var = var(Y_Z_1) - var(Y_Z_0)) + 98 | declare_measurement(Y = reveal_outcomes(Y ~ Z)) + 99 | declare_estimator(Y ~ Z, 100 | inquiry = "ATE", 101 | label = "DIM") + 102 | declare_estimator(handler = 103 | label_estimator(diff_in_variances), 104 | inquiry = "difference_in_var", 105 | label = "DIV") 106 | 107 | run_design(design_1) 108 | 109 | # Two inquiries using one estimator 110 | 111 | design_2 <- 112 | design + 113 | declare_inquiry(ATE = mean(Y_Z_1 - Y_Z_0)) + 114 | declare_inquiry(ATT = mean(Y_Z_1 - Y_Z_0), subset = (Z == 1)) + 115 | declare_estimator(Y ~ Z, inquiry = c("ATE", "ATT")) 116 | 117 | run_design(design_2) 118 | 119 | # Two inquiries using different coefficients from one estimator 120 | 121 | design_3 <- 122 | design + 123 | declare_inquiry(intercept = mean(Y_Z_0), 124 | slope = mean(Y_Z_1 - Y_Z_0)) + 125 | declare_estimator( 126 | Y ~ Z, 127 | .method = lm_robust, 128 | term = TRUE, 129 | inquiry = c("intercept", "slope") 130 | ) 131 | 132 | run_design(design_3) 133 | 134 | 135 | # declare_inquiries usage 136 | design_4 <- design + 137 | declare_inquiries( 138 | ATE = mean(Y_Z_1[X == 1] - Y_Z_0[X == 1]), 139 | CATE_X0 = mean(Y_Z_1[X == 0] - Y_Z_0[X == 0]), 140 | CATE_X1 = mean(Y_Z_1[X == 1] - Y_Z_0[X == 1]), 141 | Difference_in_CATEs = CATE_X1 - CATE_X0, 142 | mean_Y = mean(Y)) 143 | 144 | run_design(design_4) 145 | 146 | 147 | } 148 | -------------------------------------------------------------------------------- /man/declare_measurement.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/declare_measurement.R 3 | \name{declare_measurement} 4 | \alias{declare_measurement} 5 | \alias{measurement_handler} 6 | \title{Declare measurement procedure} 7 | \usage{ 8 | declare_measurement(..., handler = measurement_handler, label = NULL) 9 | 10 | measurement_handler(data, ...) 11 | } 12 | \arguments{ 13 | \item{...}{arguments to be captured, and later passed to the handler} 14 | 15 | \item{handler}{a tidy-in, tidy-out function} 16 | 17 | \item{label}{a string describing the step} 18 | 19 | \item{data}{A data.frame.} 20 | } 21 | \value{ 22 | A function that returns a data.frame. 23 | } 24 | \description{ 25 | This function adds measured data columns that can be functions of unmeasured data columns. 26 | } 27 | \details{ 28 | It is also possible to include measured variables in your declare_model call or to add variables using declare_step. However, putting latent variables in declare_model and variables-as-measured in declare_measurement helps communicate which parts of your research design are in M and which parts are in D. 29 | } 30 | \examples{ 31 | 32 | # declare_measurement in use 33 | ## Two-arm randomized experiment 34 | design <- 35 | declare_model( 36 | N = 500, 37 | X = rep(c(0, 1), each = N / 2), 38 | U = rnorm(N, sd = 0.25), 39 | potential_outcomes(Y ~ 0.2 * Z + X + U) 40 | ) + 41 | declare_inquiry(ATE = mean(Y_Z_1 - Y_Z_0)) + 42 | declare_sampling(S = complete_rs(N = N, n = 200)) + 43 | declare_assignment(Z = complete_ra(N = N, m = 100)) + 44 | declare_measurement(Y = reveal_outcomes(Y ~ Z)) + 45 | declare_estimator(Y ~ Z, inquiry = "ATE") 46 | 47 | run_design(design) 48 | 49 | # Reveal potential outcomes according to treatment assignment 50 | design <- 51 | declare_model(N = 100, 52 | potential_outcomes(Y ~ rbinom( 53 | N, size = 1, prob = 0.1 * Z + 0.5 54 | ))) + 55 | declare_assignment(Z = complete_ra(N, m = 50)) + 56 | declare_measurement(Y = reveal_outcomes(Y ~ Z)) 57 | 58 | head(draw_data(design)) 59 | 60 | # Generate observed measurement from a latent value 61 | design <- 62 | declare_model(N = 100, latent = runif(N)) + 63 | declare_measurement(observed = rbinom(N, 1, prob = latent)) 64 | 65 | head(draw_data(design)) 66 | 67 | # Index creation 68 | library(psych) 69 | 70 | design <- 71 | declare_model( 72 | N = 500, 73 | X = rep(c(0, 1), each = N / 2), 74 | Y_1 = 0.2 * X + rnorm(N, sd = 0.25), 75 | Y_2 = 0.3 * X + 0.5 * rnorm(N, sd = 0.50), 76 | Y_3 = 0.1 * X + 0.4 * rnorm(N, sd = 0.75)) + 77 | declare_measurement( 78 | index = fa( 79 | r = cbind(Y_1, Y_2, Y_3), 80 | nfactors = 1, 81 | rotate = "varimax" 82 | )$scores 83 | ) 84 | 85 | draw_data(design) 86 | } 87 | -------------------------------------------------------------------------------- /man/declare_population.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/declare_population.R 3 | \name{declare_population} 4 | \alias{declare_population} 5 | \title{Declare the size and features of the population} 6 | \usage{ 7 | declare_population(..., handler = fabricate, label = NULL) 8 | } 9 | \arguments{ 10 | \item{...}{arguments to be captured, and later passed to the handler} 11 | 12 | \item{handler}{a tidy-in, tidy-out function} 13 | 14 | \item{label}{a string describing the step} 15 | } 16 | \value{ 17 | A potential outcomes declaration, which is a function that returns a data.frame. 18 | } 19 | \description{ 20 | Deprecated. Please use declare_model instead. 21 | } 22 | \keyword{internal} 23 | -------------------------------------------------------------------------------- /man/declare_potential_outcomes.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/declare_potential_outcomes.R 3 | \name{declare_potential_outcomes} 4 | \alias{declare_potential_outcomes} 5 | \alias{potential_outcomes_internal.formula} 6 | \alias{potential_outcomes_internal.NULL} 7 | \title{Declare potential outcomes} 8 | \usage{ 9 | declare_potential_outcomes( 10 | ..., 11 | handler = potential_outcomes_handler, 12 | label = NULL 13 | ) 14 | 15 | potential_outcomes_internal.formula( 16 | formula, 17 | conditions = c(0, 1), 18 | assignment_variables = "Z", 19 | data, 20 | level = NULL, 21 | label = outcome_variable 22 | ) 23 | 24 | potential_outcomes_internal.NULL( 25 | formula = stop("Not provided"), 26 | ..., 27 | data, 28 | level = NULL 29 | ) 30 | } 31 | \arguments{ 32 | \item{...}{arguments to be captured, and later passed to the handler} 33 | 34 | \item{handler}{a tidy-in, tidy-out function} 35 | 36 | \item{label}{a string describing the step} 37 | 38 | \item{formula}{a formula to calculate potential outcomes as functions of assignment variables.} 39 | 40 | \item{conditions}{see \code{\link{expand_conditions}}. Provide values (e.g. \code{conditions = 1:4}) for a single assignment variable. If multiple assignment variables, provide named list (e.g. \code{conditions = list(Z1 = 0:1, Z2 = 0:1)}). Defaults to 0:1 if no conditions provided.} 41 | 42 | \item{assignment_variables}{The name of the assignment variable. Generally not required as names are taken from \code{conditions}.} 43 | 44 | \item{data}{a data.frame} 45 | 46 | \item{level}{a character specifying a level of hierarchy for fabricate to calculate at} 47 | } 48 | \value{ 49 | a function that returns a data.frame 50 | } 51 | \description{ 52 | Deprecated. Please use the potential_outcomes function within a declare_model declaration. 53 | } 54 | \keyword{internal} 55 | -------------------------------------------------------------------------------- /man/declare_reveal.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/declare_reveal.R 3 | \name{declare_reveal} 4 | \alias{declare_reveal} 5 | \alias{declare_reveal_handler} 6 | \title{Declare a reveal outcomes step} 7 | \usage{ 8 | declare_reveal(..., handler = declare_reveal_handler, label = NULL) 9 | 10 | declare_reveal_handler( 11 | data = NULL, 12 | outcome_variables = Y, 13 | assignment_variables = Z, 14 | attrition_variables = NULL, 15 | ... 16 | ) 17 | } 18 | \arguments{ 19 | \item{...}{arguments to be captured, and later passed to the handler} 20 | 21 | \item{handler}{a tidy-in, tidy-out function} 22 | 23 | \item{label}{a string describing the step} 24 | 25 | \item{data}{A data.frame containing columns for assignment and potential outcomes.} 26 | 27 | \item{outcome_variables}{The outcome prefix(es) of the potential outcomes.} 28 | 29 | \item{assignment_variables}{Unquoted name(s) of the assignment variable(s).} 30 | 31 | \item{attrition_variables}{Unquoted name of the attrition variable.} 32 | } 33 | \description{ 34 | Deprecated. Please use the \code{reveal_outcomes} function within a \code{declare_measurement} declaration. 35 | } 36 | \details{ 37 | Potential outcomes declarations indicate what outcomes would obtain for different possible values of assignment variables. 38 | But realized outcomes need to be "revealed." 39 | \code{declare_reveal} generates these realized outcomes using information on 40 | potential outcomes (for instance generated via \code{declare_potential_outcomes}) and the relevant 41 | assignment variables (for example created by \code{declare_assignment}). 42 | Revelation steps are usefully included after declaration of all assignments of conditions required to determine the realized outcome. 43 | If a revelation is not declared, DeclareDesign will try to guess appropriate revelations. Explicit revelation is recommended however. 44 | 45 | \code{declare_reveal} declares how outcomes should be realized. 46 | A "revelation" uses the random assignment to pluck out the correct potential outcomes (Gerber and Green 2012, Chapter 2). 47 | Revelation requires that every named outcome variable is a function of every named assignment variable within a step. Thus if multiple outcome variables depend on different assignment variables, multiple revelations are needed. 48 | } 49 | \examples{ 50 | 51 | design <- 52 | declare_model( 53 | N = 100, 54 | U = rnorm(N), 55 | Y_Z_0 = U, 56 | Y_Z_1 = U + rnorm(N, mean = 2, sd = 2) 57 | ) + 58 | declare_assignment(Z = complete_ra(N, m = 50)) + 59 | declare_measurement(Y = reveal_outcomes(Y ~ Z)) 60 | 61 | head(draw_data(design)) 62 | 63 | # Declaring multiple assignment variables or multiple outcome variables 64 | 65 | design <- 66 | declare_model( 67 | N = 10, 68 | potential_outcomes(Y1 ~ Z), 69 | potential_outcomes(Y2 ~ 1 + 2 * Z), 70 | potential_outcomes(Y3 ~ 1 - X * Z, conditions = list(X = 0:1, Z = 0:1)) 71 | ) + 72 | declare_assignment(Z = complete_ra(N)) + 73 | declare_assignment(X = complete_ra(N)) + 74 | declare_measurement(Y1 = reveal_outcomes(Y1 ~ Z), 75 | Y2 = reveal_outcomes(Y2 ~ Z), 76 | Y3 = reveal_outcomes(Y3 ~ X + Z)) 77 | 78 | head(draw_data(design)) 79 | 80 | design <- 81 | declare_model( 82 | N = 100, 83 | age = sample(18:95, N, replace = TRUE), 84 | potential_outcomes(Y ~ .25 * Z + .01 * age * Z), 85 | potential_outcomes(R ~ rbinom(n = N, size = 1, prob = pnorm(Y_Z_0))) 86 | ) + 87 | declare_assignment(Z = complete_ra(N, m = 25)) 88 | declare_measurement(R = reveal_outcomes(R ~ Z), 89 | Y = reveal_outcomes(Y ~ Z), 90 | Y = ifelse(R == 1, Y, NA)) 91 | 92 | head(draw_data(design)) 93 | } 94 | \keyword{internal} 95 | -------------------------------------------------------------------------------- /man/declare_sampling.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/declare_sampling.R 3 | \name{declare_sampling} 4 | \alias{declare_sampling} 5 | \alias{sampling_handler} 6 | \title{Declare sampling procedure} 7 | \usage{ 8 | declare_sampling(..., handler = sampling_handler, label = NULL) 9 | 10 | sampling_handler(data, ..., legacy = FALSE) 11 | } 12 | \arguments{ 13 | \item{...}{arguments to be captured, and later passed to the handler} 14 | 15 | \item{handler}{a tidy-in, tidy-out function} 16 | 17 | \item{label}{a string describing the step} 18 | 19 | \item{data}{A data.frame.} 20 | 21 | \item{legacy}{Use the legacy randomizr functionality. This will be disabled in future; please use legacy = FALSE.} 22 | } 23 | \value{ 24 | A sampling declaration, which is a function that takes a data.frame as an argument and returns a data.frame subsetted to sampled observations and (optionally) augmented with inclusion probabilities and other quantities. 25 | } 26 | \description{ 27 | Declare sampling procedure 28 | } 29 | \examples{ 30 | 31 | # declare_sampling in use 32 | ## Two-arm randomized experiment 33 | design <- 34 | declare_model( 35 | N = 500, 36 | X = rep(c(0, 1), each = N / 2), 37 | U = rnorm(N, sd = 0.25), 38 | potential_outcomes(Y ~ 0.2 * Z + X + U) 39 | ) + 40 | declare_inquiry(ATE = mean(Y_Z_1 - Y_Z_0)) + 41 | declare_sampling(S = complete_rs(N = N, n = 200)) + 42 | declare_assignment(Z = complete_ra(N = N, m = 100)) + 43 | declare_measurement(Y = reveal_outcomes(Y ~ Z)) + 44 | declare_estimator(Y ~ Z, inquiry = "ATE") 45 | 46 | run_design(design) 47 | 48 | # Set up population to sample from 49 | model <- declare_model( 50 | villages = add_level( 51 | N = 30, 52 | N_households = sample(c(50:100), N, replace = TRUE) 53 | ), 54 | households = add_level( 55 | N = N_households, 56 | N_members = sample(c(1, 2, 3, 4), N, 57 | prob = c(0.2, 0.3, 0.25, 0.25), replace = TRUE) 58 | ), 59 | individuals = add_level( 60 | N = N_members, 61 | age = sample(18:90, N, replace = TRUE), 62 | gender = rbinom(n = N, size = 1, prob = .5) 63 | ) 64 | ) 65 | 66 | # Sampling procedures 67 | ## Complete random sampling 68 | design <- model + 69 | declare_sampling(S = complete_rs(N = N, n = 1000)) 70 | 71 | head(draw_data(design)) 72 | 73 | ## Cluster random sampling 74 | design <- model + 75 | declare_sampling(S = cluster_rs(clusters = villages, 76 | n = 15)) 77 | 78 | head(draw_data(design)) 79 | 80 | ## Strata and cluster random sampling 81 | design <- model + 82 | declare_sampling(S = strata_and_cluster_rs( 83 | strata = villages, 84 | clusters = households, 85 | strata_n = rep(20, 30))) 86 | 87 | head(draw_data(design)) 88 | 89 | ## Stratified random sampling 90 | design <- model + 91 | declare_sampling(S = strata_rs(strata = gender, n = 100)) 92 | 93 | head(draw_data(design)) 94 | 95 | } 96 | -------------------------------------------------------------------------------- /man/declare_step.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/declare_step.R 3 | \name{declare_step} 4 | \alias{declare_step} 5 | \title{Declare a custom step} 6 | \usage{ 7 | declare_step( 8 | ..., 9 | handler = function(data, ...f, ...) ...f(data, ...), 10 | label = NULL 11 | ) 12 | } 13 | \arguments{ 14 | \item{...}{arguments to be captured, and later passed to the handler} 15 | 16 | \item{handler}{a tidy-in, tidy-out function} 17 | 18 | \item{label}{a string describing the step} 19 | } 20 | \value{ 21 | A function that returns a data.frame. 22 | } 23 | \description{ 24 | With declare_step, you can include any function that takes data as one of its arguments and returns data in a design declaration. The first argument is always a "handler", which is the name of the data-in, data-out function. 25 | For handy data manipulations use \code{declare_step(fabricate, ...)}. 26 | } 27 | \examples{ 28 | 29 | population <- declare_model(N = 5, noise = rnorm(N)) 30 | manipulate <- declare_step(fabricate, noise_squared = noise^2, zero = 0) 31 | 32 | design <- population + manipulate 33 | draw_data(design) 34 | 35 | } 36 | -------------------------------------------------------------------------------- /man/declare_test.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/declare_test.R 3 | \name{declare_test} 4 | \alias{declare_test} 5 | \alias{label_test} 6 | \title{Declare test} 7 | \usage{ 8 | declare_test(..., handler = label_test(method_handler), label = "test") 9 | 10 | label_test(fn) 11 | } 12 | \arguments{ 13 | \item{...}{arguments to be captured, and later passed to the handler} 14 | 15 | \item{handler}{a tidy-in, tidy-out function} 16 | 17 | \item{label}{a string describing the step} 18 | 19 | \item{fn}{A function that takes a data.frame as an argument and returns a data.frame with test statistics as columns.} 20 | } 21 | \value{ 22 | A function that accepts a data.frame as an argument and returns a data.frame containing the value of the test statistic and other inferential statistics. 23 | } 24 | \description{ 25 | Declares an test which generates a test statistic and associated inferential statistics. 26 | 27 | Use of \code{declare_test} is identical to use of \code{\link{declare_estimator}}. Use \code{declare_test} for hypothesis testing with no specific inquiry in mind; use \code{declare_estimator} for hypothesis testing when you can link each estimate to an inquiry. For example, \code{declare_test} could be used for a K-S test of distributional equality and \code{declare_estimator} for a difference-in-means estimate of an average treatment effect. 28 | 29 | See \code{\link{declare_estimator}} help for an explanation of how to use \code{method_handler}, which is used identically in both \code{declare_estimator} and \code{declare_test}. The main difference between \code{declare_estimator} and \code{declare_test} is that \code{declare_test} does not link with an explicit inquiry. 30 | } 31 | \details{ 32 | \code{label_test} takes a data-in-data out function to \code{fn}, and returns a data-in-data-out function that first runs the provided test function \code{fn} and then appends a label for the test. 33 | } 34 | \examples{ 35 | 36 | # Balance test F test 37 | 38 | balance_test_design <- 39 | declare_model( 40 | N = 100, 41 | cov1 = rnorm(N), 42 | cov2 = rnorm(N), 43 | cov3 = rnorm(N) 44 | ) + 45 | declare_assignment(Z = complete_ra(N, prob = 0.2)) + 46 | declare_test(Z ~ cov1 + cov2 + cov3, .method = lm_robust, .summary = glance) 47 | 48 | \dontrun{ 49 | diagnosis <- diagnose_design( 50 | design = balance_test_design, 51 | diagnosands = declare_diagnosands( 52 | false_positive_rate = mean(p.value <= 0.05)) 53 | ) 54 | } 55 | 56 | # K-S test of distributional equality 57 | 58 | ks_test <- function(data) { 59 | test <- with(data, ks.test(x = Y[Z == 1], y = Y[Z == 0])) 60 | data.frame(statistic = test$statistic, p.value = test$p.value) 61 | } 62 | 63 | distributional_equality_design <- 64 | declare_model( 65 | N = 100, 66 | Y_Z_1 = rnorm(N), 67 | Y_Z_0 = rnorm(N, sd = 1.5) 68 | ) + 69 | declare_assignment(Z = complete_ra(N, prob = 0.5)) + 70 | declare_measurement(Y = reveal_outcomes(Y ~ Z)) + 71 | declare_test(handler = label_test(ks_test), label = "ks-test") 72 | 73 | \dontrun{ 74 | diagnosis <- diagnose_design( 75 | design = distributional_equality_design, 76 | diagnosands = declare_diagnosands(power = mean(p.value <= 0.05)) 77 | ) 78 | } 79 | 80 | # Thanks to Jake Bowers for this example 81 | 82 | library(coin) 83 | 84 | our_ttest <- function(data) { 85 | res <- coin::oneway_test( 86 | outcome ~ factor(Xclus), 87 | data = data, 88 | distribution = "asymptotic" 89 | ) 90 | data.frame(p.value = pvalue(res)[[1]]) 91 | } 92 | 93 | ttest_design <- 94 | declare_model( 95 | N = 100, 96 | Xclus = rbinom(n = N, size = 1, prob = 0.2), 97 | outcome = 3 + rnorm(N)) + 98 | declare_test(handler = label_test(our_ttest), label = "t-test") 99 | 100 | \dontrun{ 101 | diagnosis <- diagnose_design( 102 | design = ttest_design, 103 | diagnosands = declare_diagnosands( 104 | false_positive_rate = mean(p.value <= 0.05)) 105 | ) 106 | } 107 | 108 | } 109 | \seealso{ 110 | See \code{\link{declare_estimator}} for documentation of the \code{method_handler} function. 111 | } 112 | -------------------------------------------------------------------------------- /man/diagnosis_helpers.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/diagnosis_helper_functions.R 3 | \name{diagnosis_helpers} 4 | \alias{diagnosis_helpers} 5 | \alias{get_diagnosands} 6 | \alias{get_simulations} 7 | \title{Explore your design diagnosis} 8 | \usage{ 9 | get_diagnosands(diagnosis) 10 | 11 | get_simulations(diagnosis) 12 | } 13 | \arguments{ 14 | \item{diagnosis}{A design diagnosis created by \code{\link{diagnose_design}}.} 15 | } 16 | \description{ 17 | Explore your design diagnosis 18 | } 19 | \examples{ 20 | 21 | # Two-arm randomized experiment 22 | design <- 23 | declare_model( 24 | N = 500, 25 | gender = rbinom(N, 1, 0.5), 26 | X = rep(c(0, 1), each = N / 2), 27 | U = rnorm(N, sd = 0.25), 28 | potential_outcomes(Y ~ 0.2 * Z + X + U) 29 | ) + 30 | declare_inquiry(ATE = mean(Y_Z_1 - Y_Z_0)) + 31 | declare_sampling(S = complete_rs(N = N, n = 200)) + 32 | declare_assignment(Z = complete_ra(N = N, m = 100)) + 33 | declare_measurement(Y = reveal_outcomes(Y ~ Z)) + 34 | declare_estimator(Y ~ Z, inquiry = "ATE") 35 | 36 | \dontrun{ 37 | # Diagnose design using default diagnosands 38 | diagnosis <- diagnose_design(design) 39 | diagnosis 40 | 41 | # Use get_diagnosands to explore diagnosands: 42 | get_diagnosands(diagnosis) 43 | 44 | # Use get_simulations to explore simulations 45 | get_simulations(diagnosis) 46 | 47 | # Exploring user-defined diagnosis your own diagnosands 48 | my_diagnosands <- 49 | declare_diagnosands(median_bias = median(estimate - estimand), 50 | absolute_error = mean(abs(estimate - estimand))) 51 | 52 | diagnosis <- diagnose_design(design, diagnosands = my_diagnosands) 53 | diagnosis 54 | 55 | tidy(diagnosis) 56 | 57 | reshape_diagnosis(diagnosis) 58 | 59 | get_diagnosands(diagnosis) 60 | 61 | get_simulations(diagnosis) 62 | 63 | } 64 | 65 | } 66 | -------------------------------------------------------------------------------- /man/draw_functions.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/draw_functions.R 3 | \name{draw_functions} 4 | \alias{draw_functions} 5 | \alias{draw_data} 6 | \alias{draw_estimand} 7 | \alias{draw_estimands} 8 | \alias{draw_estimates} 9 | \title{Draw data, estimates, and inquiries from a design} 10 | \usage{ 11 | draw_data(design, data = NULL, start = 1, end = length(design)) 12 | 13 | draw_estimand(...) 14 | 15 | draw_estimands(...) 16 | 17 | draw_estimates(...) 18 | } 19 | \arguments{ 20 | \item{design}{A design object, typically created using the + operator} 21 | 22 | \item{data}{A data.frame object with sufficient information to get the data, estimates, inquiries, an assignment vector, or a sample.} 23 | 24 | \item{start}{(Defaults to 1) a scalar indicating which step in the design to begin with. By default all data steps are drawn, from step 1 to the last step of the design.} 25 | 26 | \item{end}{(Defaults to \code{length(design)}) a scalar indicating which step in the design to finish drawing data by.} 27 | 28 | \item{...}{A design or set of designs typically created using the + operator} 29 | } 30 | \description{ 31 | Draw data, estimates, and inquiries from a design 32 | } 33 | \examples{ 34 | 35 | # Two-arm randomized experiment 36 | design <- 37 | declare_model( 38 | N = 500, 39 | gender = rbinom(N, 1, 0.5), 40 | X = rep(c(0, 1), each = N / 2), 41 | U = rnorm(N, sd = 0.25), 42 | potential_outcomes(Y ~ 0.2 * Z + X + U) 43 | ) + 44 | declare_inquiry(ATE = mean(Y_Z_1 - Y_Z_0)) + 45 | declare_sampling(S = complete_rs(N = N, n = 200)) + 46 | declare_assignment(Z = complete_ra(N = N, m = 100)) + 47 | declare_measurement(Y = reveal_outcomes(Y ~ Z)) + 48 | declare_estimator(Y ~ Z, inquiry = "ATE") 49 | 50 | # Use draw_data to create a dataset using a design 51 | dat <- draw_data(design) 52 | 53 | # Use end argument to draw data up to a certain design component 54 | dat_no_sampling <- draw_data(design, end = 3) 55 | 56 | # Use draw_estimands to extract value of inquiry 57 | draw_estimands(design) 58 | 59 | # Use draw_estimates to extract value of estimator 60 | draw_estimates(design) 61 | 62 | } 63 | -------------------------------------------------------------------------------- /man/edit.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/modify_edit.R 3 | \name{clone_dot_edit_env} 4 | \alias{clone_dot_edit_env} 5 | \alias{clone_step_edit} 6 | \alias{clone_design_edit} 7 | \title{Override environment via shim} 8 | \usage{ 9 | clone_dot_edit_env(dot, ..., to_replace = list(...)) 10 | 11 | clone_step_edit(step, ..., to_replace = list(...)) 12 | 13 | clone_design_edit(design, ..., to_replace = list(...)) 14 | } 15 | \description{ 16 | Override environment via shim 17 | } 18 | \examples{ 19 | \dontrun{ 20 | here_i_am <- "foo" 21 | dot <- quo(here_i_am) 22 | dot2 <- DeclareDesign:::clone_dot_edit_env(dot, here_i_am = "some_message", xyxyx = "bar") 23 | rlang::eval_tidy(dot) 24 | rlang::eval_tidy(dot2) 25 | } 26 | \dontrun{ 27 | N <- 50 28 | 29 | pop50 <- declare_model(N=N, noise=rnorm(N)) 30 | nrow(pop50()) 31 | 32 | pop100 <- DeclareDesign:::clone_step_edit(pop50, N=100) 33 | nrow(pop100()) 34 | nrow(pop50()) 35 | 36 | } 37 | } 38 | \keyword{internal} 39 | -------------------------------------------------------------------------------- /man/expand_conditions.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/declare_potential_outcomes.R 3 | \name{expand_conditions} 4 | \alias{expand_conditions} 5 | \title{Expand assignment conditions} 6 | \usage{ 7 | expand_conditions( 8 | formula, 9 | conditions = c(0, 1), 10 | assignment_variables = "Z", 11 | data, 12 | level = NULL, 13 | label = NULL 14 | ) 15 | } 16 | \arguments{ 17 | \item{conditions}{the conditions} 18 | 19 | \item{assignment_variables}{the name of assignment variables, if conditions is not already named.} 20 | } 21 | \value{ 22 | a data.frame of potential outcome conditions 23 | } 24 | \description{ 25 | Internal helper to eagerly build assignment conditions for potential outcomes. 26 | } 27 | \details{ 28 | If conditions is a data.frame, it is returned unchanged 29 | 30 | Otherwise, if conditions is a list, it is passed to expand.grid for expansion to a data.frame 31 | 32 | Otherwise, if condition is something else, box it in a list with assignment_variables for names, 33 | and pass that to expand.grid. 34 | } 35 | \keyword{internal} 36 | -------------------------------------------------------------------------------- /man/expand_design.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/expand_design.R 3 | \name{expand_design} 4 | \alias{expand_design} 5 | \title{Declare a design via a designer} 6 | \usage{ 7 | expand_design(designer, ..., expand = TRUE, prefix = "design") 8 | } 9 | \arguments{ 10 | \item{designer}{a function which yields a design} 11 | 12 | \item{...}{Options sent to the designer} 13 | 14 | \item{expand}{boolean - if true, form the crossproduct of the ..., otherwise recycle them} 15 | 16 | \item{prefix}{prefix for the names of the designs, i.e. if you create two designs they would be named prefix_1, prefix_2} 17 | } 18 | \value{ 19 | if set of designs is size one, the design, otherwise a `by`-list of designs. Designs are given a parameters attribute with the values of parameters assigned by expand_design. 20 | } 21 | \description{ 22 | \code{expand_design} easily generates a set of design from a designer function. 23 | } 24 | \examples{ 25 | 26 | \dontrun{ 27 | 28 | # in conjunction with DesignLibrary 29 | 30 | library(DesignLibrary) 31 | 32 | designs <- expand_design(multi_arm_designer, outcome_means = list(c(3,2,4), c(1,4,1))) 33 | 34 | diagnose_design(designs) 35 | 36 | # with a custom designer function 37 | 38 | designer <- function(N) { 39 | design <- 40 | declare_model( 41 | N = N, 42 | U = rnorm(N), 43 | potential_outcomes(Y ~ 0.20 * Z + U) 44 | ) + 45 | declare_inquiry(ATE = mean(Y_Z_1 - Y_Z_0)) + 46 | declare_assignment(Z = complete_ra(N, m = N/2)) + 47 | declare_measurement(Y = reveal_outcomes(Y ~ Z)) + 48 | declare_estimator(Y ~ Z, inquiry = "ATE") 49 | return(design) 50 | } 51 | 52 | # returns list of eight designs 53 | designs <- expand_design(designer, N = seq(30, 100, 10)) 54 | 55 | # diagnose a list of designs created by expand_design or redesign 56 | diagnosis <- diagnose_design(designs, sims = 50) 57 | 58 | # returns a single design 59 | large_design <- expand_design(designer, N = 200) 60 | 61 | diagnose_large_design <- diagnose_design(large_design, sims = 50) 62 | 63 | } 64 | 65 | } 66 | -------------------------------------------------------------------------------- /man/get_functions.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/get_functions.R 3 | \name{get_functions} 4 | \alias{get_functions} 5 | \alias{get_estimates} 6 | \title{Get estimates, inquiries, assignment vectors, or samples from a design given data} 7 | \usage{ 8 | get_estimates(design, data = NULL, start = 1, end = length(design)) 9 | } 10 | \arguments{ 11 | \item{design}{A design object, typically created using the + operator} 12 | 13 | \item{data}{A data.frame object with sufficient information to get the data, estimates, inquiries, an assignment vector, or a sample.} 14 | 15 | \item{start}{(Defaults to 1) a scalar indicating which step in the design to begin with. By default all data steps are drawn, from step 1 to the last step of the design.} 16 | 17 | \item{end}{(Defaults to \code{length(design)}) a scalar indicating which step in the design to finish with.} 18 | } 19 | \description{ 20 | Get estimates, inquiries, assignment vectors, or samples from a design given data 21 | } 22 | \examples{ 23 | 24 | design <- 25 | declare_model( 26 | N = 100, 27 | U = rnorm(N), 28 | potential_outcomes(Y ~ Z + U) 29 | ) + 30 | declare_inquiry(ATE = mean(Y_Z_1 - Y_Z_0)) + 31 | declare_sampling(S = complete_rs(N, n = 75)) + 32 | declare_assignment(Z = complete_ra(N, m = 50)) + 33 | declare_measurement(Y = reveal_outcomes(Y ~ Z)) + 34 | declare_estimator(Y ~ Z, inquiry = "ATE") 35 | 36 | dat <- draw_data(design) 37 | 38 | draw_data(design, data = dat, start = 2) 39 | 40 | get_estimates(design, data = dat) 41 | 42 | } 43 | -------------------------------------------------------------------------------- /man/modify_design.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/modify_design.R 3 | \name{modify_design} 4 | \alias{modify_design} 5 | \alias{insert_step} 6 | \alias{delete_step} 7 | \alias{replace_step} 8 | \title{Modify a design after the fact} 9 | \usage{ 10 | insert_step(design, new_step, before, after) 11 | 12 | delete_step(design, step) 13 | 14 | replace_step(design, step, new_step) 15 | } 16 | \arguments{ 17 | \item{design}{A design object, usually created using the + operator, \code{\link{expand_design}}, or the design library.} 18 | 19 | \item{new_step}{The new step; Either a function or a partial call.} 20 | 21 | \item{before}{The step before which to add steps.} 22 | 23 | \item{after}{The step after which to add steps.} 24 | 25 | \item{step}{The quoted label of the step to be deleted or replaced.} 26 | } 27 | \value{ 28 | A new design object. 29 | } 30 | \description{ 31 | Insert, delete and replace steps in an (already declared) design object. 32 | } 33 | \details{ 34 | See \code{\link{modify_design}} for details. 35 | } 36 | \examples{ 37 | 38 | my_model <- 39 | declare_model( 40 | N = 100, 41 | U = rnorm(N), 42 | Y_Z_0 = U, 43 | Y_Z_1 = U + rnorm(N, mean = 2, sd = 2) 44 | ) 45 | 46 | my_assignment <- declare_assignment(Z = complete_ra(N, m = 50)) 47 | my_assignment_2 <- declare_assignment(Z = complete_ra(N, m = 25)) 48 | 49 | design <- my_model + my_assignment 50 | 51 | draw_data(design) 52 | 53 | design_modified <- replace_step(design, 2, my_assignment_2) 54 | 55 | draw_data(design) 56 | 57 | \dontrun{ 58 | 59 | design <- 60 | declare_model( 61 | N = 100, 62 | U = rnorm(N), 63 | potential_outcomes(Y ~ 0.20 * Z + U) 64 | ) + 65 | declare_inquiry(ATE = mean(Y_Z_1 - Y_Z_0)) + 66 | declare_assignment(Z = complete_ra(N, m = N/2)) + 67 | declare_measurement(Y = reveal_outcomes(Y ~ Z)) + 68 | declare_estimator(Y ~ Z, inquiry = "ATE") 69 | 70 | insert_step(design, declare_sampling(S = complete_rs(N, n = 50)), 71 | after = 1) 72 | 73 | # If you are using a design created by a designer, for example from 74 | # the DesignLibrary package, you will not have access to the step 75 | # objects. Instead, you can always use the label of the step. 76 | 77 | design <- DesignLibrary::two_arm_designer() 78 | 79 | # get the labels for the steps 80 | names(design) 81 | 82 | insert_step(design, 83 | declare_sampling(S = complete_rs(N, n = 50)), 84 | after = "potential_outcomes") 85 | 86 | } 87 | 88 | 89 | design <- 90 | declare_model( 91 | N = 100, 92 | U = rnorm(N), 93 | potential_outcomes(Y ~ 0.20 * Z + U) 94 | ) + 95 | declare_inquiry(ATE = mean(Y_Z_1 - Y_Z_0)) + 96 | declare_assignment(Z = complete_ra(N, m = N/2)) + 97 | declare_measurement(Y = reveal_outcomes(Y ~ Z)) + 98 | declare_estimator(Y ~ Z, inquiry = "ATE") 99 | delete_step(design, step = 5) 100 | 101 | 102 | design <- 103 | declare_model( 104 | N = 100, 105 | U = rnorm(N), 106 | potential_outcomes(Y ~ 0.20 * Z + U) 107 | ) + 108 | declare_inquiry(ATE = mean(Y_Z_1 - Y_Z_0)) + 109 | declare_assignment(Z = complete_ra(N, m = N/2)) + 110 | declare_measurement(Y = reveal_outcomes(Y ~ Z)) + 111 | declare_estimator(Y ~ Z, inquiry = "ATE") 112 | 113 | replace_step( 114 | design, 115 | step = 3, 116 | new_step = declare_assignment(Z = simple_ra(N, prob = 0.5))) 117 | } 118 | -------------------------------------------------------------------------------- /man/pop.var.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/declare_diagnosands.R 3 | \name{pop.var} 4 | \alias{pop.var} 5 | \title{Population variance function} 6 | \usage{ 7 | pop.var(x, na.rm = FALSE) 8 | } 9 | \arguments{ 10 | \item{x}{a numeric vector, matrix or data frame.} 11 | 12 | \item{na.rm}{logical. Should missing values be removed?} 13 | } 14 | \value{ 15 | numeric scalar of the population variance 16 | } 17 | \description{ 18 | Population variance function 19 | } 20 | \examples{ 21 | 22 | x <- 1:4 23 | var(x) # divides by (n-1) 24 | pop.var(x) # divides by n 25 | 26 | 27 | } 28 | -------------------------------------------------------------------------------- /man/post_design.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/design_helper_functions.R, 3 | % R/design_print_summary.R 4 | \name{post_design} 5 | \alias{post_design} 6 | \alias{print_code} 7 | \alias{print.design} 8 | \alias{summary.design} 9 | \title{Explore your design} 10 | \usage{ 11 | print_code(design) 12 | 13 | \method{print}{design}(x, verbose = FALSE, ...) 14 | 15 | \method{summary}{design}(object, verbose = TRUE, ...) 16 | } 17 | \arguments{ 18 | \item{design}{A design object, typically created using the + operator} 19 | 20 | \item{x}{a design object, typically created using the + operator} 21 | 22 | \item{verbose}{an indicator for printing a long summary of the design, defaults to \code{TRUE}} 23 | 24 | \item{...}{optional arguments to be sent to summary function} 25 | 26 | \item{object}{a design object created using the + operator} 27 | } 28 | \description{ 29 | Explore your design 30 | 31 | Print code to recreate a design 32 | } 33 | \examples{ 34 | 35 | # Two-arm randomized experiment 36 | design <- 37 | declare_model( 38 | N = 500, 39 | gender = rbinom(N, 1, 0.5), 40 | X = rep(c(0, 1), each = N / 2), 41 | U = rnorm(N, sd = 0.25), 42 | potential_outcomes(Y ~ 0.2 * Z + X + U) 43 | ) + 44 | declare_inquiry(ATE = mean(Y_Z_1 - Y_Z_0)) + 45 | declare_sampling(S = complete_rs(N = N, n = 200)) + 46 | declare_assignment(Z = complete_ra(N = N, m = 100)) + 47 | declare_measurement(Y = reveal_outcomes(Y ~ Z)) + 48 | declare_estimator(Y ~ Z, inquiry = "ATE") 49 | 50 | # Use draw_data to create a dataset using a design 51 | dat <- draw_data(design) 52 | 53 | draw_data(design, data = dat, start = 2) 54 | 55 | # Apply get_estimates 56 | get_estimates(design, data = dat) 57 | 58 | 59 | # Two-arm randomized experiment 60 | design <- 61 | declare_model( 62 | N = 500, 63 | gender = rbinom(N, 1, 0.5), 64 | X = rep(c(0, 1), each = N / 2), 65 | U = rnorm(N, sd = 0.25), 66 | potential_outcomes(Y ~ 0.2 * Z + X + U) 67 | ) + 68 | declare_inquiry(ATE = mean(Y_Z_1 - Y_Z_0)) + 69 | declare_sampling(S = complete_rs(N = N, n = 200)) + 70 | declare_assignment(Z = complete_ra(N = N, m = 100)) + 71 | declare_measurement(Y = reveal_outcomes(Y ~ Z)) + 72 | declare_estimator(Y ~ Z, inquiry = "ATE") 73 | 74 | print_code(design) 75 | 76 | summary(design) 77 | 78 | 79 | design <- 80 | declare_model( 81 | N = 500, 82 | noise = rnorm(N), 83 | Y_Z_0 = noise, 84 | Y_Z_1 = noise + rnorm(N, mean = 2, sd = 2) 85 | ) + 86 | declare_inquiry(ATE = mean(Y_Z_1 - Y_Z_0)) + 87 | declare_sampling(S = complete_rs(N, n = 250)) + 88 | declare_assignment(Z = complete_ra(N, m = 25)) + 89 | declare_measurement(Y = reveal_outcomes(Y ~ Z)) + 90 | declare_estimator(Y ~ Z, inquiry = "ATE") 91 | 92 | summary(design) 93 | } 94 | -------------------------------------------------------------------------------- /man/redesign.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/redesign.R 3 | \name{redesign} 4 | \alias{redesign} 5 | \title{Redesign} 6 | \usage{ 7 | redesign(design, ..., expand = TRUE) 8 | } 9 | \arguments{ 10 | \item{design}{An object of class design.} 11 | 12 | \item{...}{Arguments to redesign e.g., \code{n = 100.} If redesigning multiple arguments, they must be specified as a named list.} 13 | 14 | \item{expand}{If TRUE, redesign using the crossproduct of \code{...}, otherwise recycle them.} 15 | } 16 | \value{ 17 | A design, or, in the case of multiple values being passed onto \code{...}, a `by`-list of designs. 18 | } 19 | \description{ 20 | \code{redesign} quickly generates a design from an existing one by resetting symbols used in design handler parameters in a step's environment (Advanced). 21 | } 22 | \details{ 23 | Warning: \code{redesign} will edit any symbol in your design, but if the symbol you attempt to change does not exist in a step's environment no changes will be made and no error or warning will be issued. 24 | 25 | Please note that \code{redesign} functionality is experimental and may be changed in future versions. 26 | } 27 | \examples{ 28 | 29 | # Two-arm randomized experiment 30 | n <- 500 31 | 32 | design <- 33 | declare_model( 34 | N = 1000, 35 | gender = rbinom(N, 1, 0.5), 36 | X = rep(c(0, 1), each = N / 2), 37 | U = rnorm(N, sd = 0.25), 38 | potential_outcomes(Y ~ 0.2 * Z + X + U) 39 | ) + 40 | declare_inquiry(ATE = mean(Y_Z_1 - Y_Z_0)) + 41 | declare_sampling(S = complete_rs(N = N, n = n)) + 42 | declare_assignment(Z = complete_ra(N = N, m = n/2)) + 43 | declare_measurement(Y = reveal_outcomes(Y ~ Z)) + 44 | declare_estimator(Y ~ Z, inquiry = "ATE") 45 | 46 | # Use redesign to return a single modified design 47 | modified_design <- redesign(design, n = 200) 48 | 49 | # Use redesign to return a series of modified designs 50 | ## Sample size is varied while the rest of the design remains 51 | ## constant 52 | design_vary_N <- redesign(design, n = c(100, 500, 900)) 53 | 54 | \dontrun{ 55 | # redesign can be used in conjunction with diagnose_designs 56 | # to optimize the design for specific diagnosands 57 | diagnose_designs(design_vary_N) 58 | } 59 | 60 | # When redesigning with arguments that are vectors, 61 | # use list() in redesign, with each list item 62 | # representing a design you wish to create 63 | 64 | prob_each <- c(.1, .5, .4) 65 | 66 | population <- declare_model(N = 1000) 67 | assignment <- declare_assignment( 68 | Z = complete_ra(prob_each = prob_each), 69 | legacy = FALSE) 70 | 71 | design <- population + assignment 72 | 73 | ## returns two designs 74 | 75 | designs_vary_prob_each <- redesign( 76 | design, 77 | prob_each = list(c(.2, .5, .3), c(0, .5, .5))) 78 | 79 | # To illustrate what does and does not get edited by redesign, 80 | # consider the following three designs. In the first two, argument 81 | # X is called from the step's environment; in the third it is not. 82 | # Using redesign will alter the role of X in the first two designs 83 | # but not the third one. 84 | 85 | X <- 3 86 | f <- function(b, X) b*X 87 | g <- function(b) b*X 88 | 89 | design1 <- declare_model(N = 1, A = X) + NULL 90 | design2 <- declare_model(N = 1, A = f(2, X)) + NULL 91 | design3 <- declare_model(N = 1, A = g(2)) + NULL 92 | 93 | draw_data(design1) 94 | draw_data(design2) 95 | draw_data(design3) 96 | 97 | draw_data(redesign(design1, X=0)) 98 | draw_data(redesign(design2, X=0)) 99 | draw_data(redesign(design3, X=0)) 100 | 101 | } 102 | -------------------------------------------------------------------------------- /man/reexports.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/diagnosis_helper_functions.R, R/tidy_try.R 3 | \docType{import} 4 | \name{reexports} 5 | \alias{reexports} 6 | \alias{tidy} 7 | \title{Objects exported from other packages} 8 | \keyword{internal} 9 | \description{ 10 | These objects are imported from other packages. Follow the links 11 | below to see their documentation. 12 | 13 | \describe{ 14 | \item{generics}{\code{\link[generics]{tidy}}, \code{\link[generics]{tidy}}} 15 | }} 16 | 17 | -------------------------------------------------------------------------------- /man/reshape_diagnosis.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/diagnosis_helper_functions.R 3 | \name{reshape_diagnosis} 4 | \alias{reshape_diagnosis} 5 | \title{Clean up a diagnosis object for printing} 6 | \usage{ 7 | reshape_diagnosis(diagnosis, digits = 2, select = NULL, exclude = NULL) 8 | } 9 | \arguments{ 10 | \item{diagnosis}{A diagnosis object generated by \code{diagnose_design}.} 11 | 12 | \item{digits}{Number of digits.} 13 | 14 | \item{select}{List of columns to include in output. Defaults to all.} 15 | 16 | \item{exclude}{Set of columns to exclude from output. Defaults to none.} 17 | } 18 | \value{ 19 | A formatted text table with bootstrapped standard errors in parentheses. 20 | } 21 | \description{ 22 | Take a diagnosis object and returns a pretty output table. If diagnosands are bootstrapped, se's are put in parentheses on a second line and rounded to \code{digits}. 23 | } 24 | \examples{ 25 | 26 | # Two-arm randomized experiment 27 | design <- 28 | declare_model( 29 | N = 500, 30 | gender = rbinom(N, 1, 0.5), 31 | X = rep(c(0, 1), each = N / 2), 32 | U = rnorm(N, sd = 0.25), 33 | potential_outcomes(Y ~ 0.2 * Z + X + U) 34 | ) + 35 | declare_inquiry(ATE = mean(Y_Z_1 - Y_Z_0)) + 36 | declare_sampling(S = complete_rs(N = N, n = 200)) + 37 | declare_assignment(Z = complete_ra(N = N, m = 100)) + 38 | declare_measurement(Y = reveal_outcomes(Y ~ Z)) + 39 | declare_estimator(Y ~ Z, inquiry = "ATE") 40 | 41 | \dontrun{ 42 | # Diagnose design using default diagnosands 43 | diagnosis <- diagnose_design(design) 44 | diagnosis 45 | 46 | # Return diagnosis output table 47 | reshape_diagnosis(diagnosis) 48 | 49 | # Return table with subset of diagnosands 50 | reshape_diagnosis(diagnosis, select = c("Bias", "Power")) 51 | 52 | # With user-defined diagnosands 53 | my_diagnosands <- 54 | declare_diagnosands(median_bias = median(estimate - estimand), 55 | absolute_error = mean(abs(estimate - estimand))) 56 | 57 | diagnosis <- diagnose_design(design, diagnosands = my_diagnosands) 58 | diagnosis 59 | 60 | reshape_diagnosis(diagnosis) 61 | 62 | reshape_diagnosis(diagnosis, select = "Absolute Error") 63 | 64 | # Alternative: Use tidy to produce data.frame with results of 65 | # diagnosis including bootstrapped standard errors and 66 | # confidence intervals for each diagnosand 67 | diagnosis_df <- tidy(diagnosis) 68 | diagnosis_df 69 | 70 | } 71 | } 72 | -------------------------------------------------------------------------------- /man/run_design.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/design_helper_functions.R 3 | \name{run_design} 4 | \alias{run_design} 5 | \title{Run a design one time} 6 | \usage{ 7 | run_design(design) 8 | } 9 | \arguments{ 10 | \item{design}{a DeclareDesign object} 11 | } 12 | \description{ 13 | Run a design one time 14 | } 15 | \examples{ 16 | 17 | # Two-arm randomized experiment 18 | design <- 19 | declare_model( 20 | N = 500, 21 | gender = rbinom(N, 1, 0.5), 22 | X = rep(c(0, 1), each = N / 2), 23 | U = rnorm(N, sd = 0.25), 24 | potential_outcomes(Y ~ 0.2 * Z + X + U) 25 | ) + 26 | declare_inquiry(ATE = mean(Y_Z_1 - Y_Z_0)) + 27 | declare_sampling(S = complete_rs(N = N, n = 200)) + 28 | declare_assignment(Z = complete_ra(N = N, m = 100)) + 29 | declare_measurement(Y = reveal_outcomes(Y ~ Z)) + 30 | declare_estimator(Y ~ Z, inquiry = "ATE") 31 | 32 | # Use run_design to run a design object 33 | run_design(design) 34 | 35 | } 36 | -------------------------------------------------------------------------------- /man/set_citation.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/set_citation.R 3 | \name{set_citation} 4 | \alias{set_citation} 5 | \title{Set the citation of a design} 6 | \usage{ 7 | set_citation( 8 | design, 9 | title = NULL, 10 | author = NULL, 11 | year = NULL, 12 | description = "Unpublished research design declaration", 13 | citation = NULL 14 | ) 15 | } 16 | \arguments{ 17 | \item{design}{A design typically created using the + operator} 18 | 19 | \item{title}{The title of the design, as a character string.} 20 | 21 | \item{author}{The author(s) of the design, as a character string.} 22 | 23 | \item{year}{The year of the design, as a character string.} 24 | 25 | \item{description}{A description of the design in words, as a character string.} 26 | 27 | \item{citation}{(optional) The preferred citation for the design, as a character string, in which case title, author, year, and description may be left unspecified.} 28 | } 29 | \value{ 30 | a design object with a citation attribute 31 | } 32 | \description{ 33 | Set the citation of a design 34 | } 35 | \examples{ 36 | 37 | # Setup for example 38 | design <- 39 | declare_model(data = sleep) + 40 | declare_sampling(S = complete_rs(N, n = 10)) 41 | 42 | # Set citation using set_citation 43 | design <- 44 | set_citation(design, 45 | author = "Lovelace, Ada", 46 | title = "Notes", 47 | year = 1953, 48 | description = 49 | "This is a text description of a design") 50 | 51 | # View citation information using cite_design 52 | cite_design(design) 53 | 54 | } 55 | -------------------------------------------------------------------------------- /man/set_diagnosands.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/set_diagnosands.R 3 | \name{set_diagnosands} 4 | \alias{set_diagnosands} 5 | \title{Set the diagnosands for a design} 6 | \usage{ 7 | set_diagnosands(x, diagnosands = default_diagnosands) 8 | } 9 | \arguments{ 10 | \item{x}{A design typically created using the + operator, or a simulations data.frame created by \code{simulate_design}.} 11 | 12 | \item{diagnosands}{A set of diagnosands created by \code{\link{declare_diagnosands}}} 13 | } 14 | \value{ 15 | a design object with a diagnosand attribute 16 | } 17 | \description{ 18 | A researcher often has a set of diagnosands in mind to appropriately assess the quality of a design. \code{set_diagnosands} sets the default diagnosands for a design, so that later readers can assess the design on the same terms as the original author. Readers can also use \code{diagnose_design} to diagnose the design using any other set of diagnosands. 19 | } 20 | \examples{ 21 | 22 | # Two-arm randomized experiment 23 | design <- 24 | declare_model( 25 | N = 500, 26 | gender = rbinom(N, 1, 0.5), 27 | X = rep(c(0, 1), each = N / 2), 28 | U = rnorm(N, sd = 0.25), 29 | potential_outcomes(Y ~ 0.2 * Z + X + U) 30 | ) + 31 | declare_inquiry(ATE = mean(Y_Z_1 - Y_Z_0)) + 32 | declare_sampling(S = complete_rs(N = N, n = 200)) + 33 | declare_assignment(Z = complete_ra(N = N, m = 100)) + 34 | declare_measurement(Y = reveal_outcomes(Y ~ Z)) + 35 | declare_estimator(Y ~ Z, inquiry = "ATE") 36 | 37 | # You can choose your own diagnosands instead of the defaults: 38 | 39 | my_diagnosands <- 40 | declare_diagnosands(median_bias = median(estimate - estimand)) 41 | 42 | \dontrun{ 43 | ## You can set diagnosands with set_diagnosands 44 | design <- set_diagnosands(design, diagnosands = my_diagnosands) 45 | diagnosis <- diagnose_design(design) 46 | diagnosis 47 | 48 | ## Using set_diagnosands to diagnose simulated data 49 | simulations_df <- simulate_design(design) 50 | 51 | simulations_df <- set_diagnosands(simulations_df, my_diagnosands) 52 | 53 | diagnose_design(simulations_df) 54 | 55 | # If you do not specify diagnosands in diagnose_design, 56 | # the function default_diagnosands() is used, 57 | # which is reproduced below. 58 | 59 | alpha <- 0.05 60 | 61 | default_diagnosands <- 62 | declare_diagnosands( 63 | mean_estimand = mean(estimand), 64 | mean_estimate = mean(estimate), 65 | bias = mean(estimate - estimand), 66 | sd_estimate = sqrt(pop.var(estimate)), 67 | rmse = sqrt(mean((estimate - estimand) ^ 2)), 68 | power = mean(p.value <= alpha), 69 | coverage = mean(estimand <= conf.high & estimand >= conf.low) 70 | ) 71 | 72 | diagnose_design( 73 | simulations_df, 74 | diagnosands = default_diagnosands 75 | ) 76 | 77 | # A longer list of potentially useful diagnosands might include: 78 | 79 | extended_diagnosands <- 80 | declare_diagnosands( 81 | mean_estimand = mean(estimand), 82 | mean_estimate = mean(estimate), 83 | bias = mean(estimate - estimand), 84 | sd_estimate = sd(estimate), 85 | rmse = sqrt(mean((estimate - estimand) ^ 2)), 86 | power = mean(p.value <= alpha), 87 | coverage = mean(estimand <= conf.high & estimand >= conf.low), 88 | mean_se = mean(std.error), 89 | type_s_rate = mean((sign(estimate) != sign(estimand))[p.value <= alpha]), 90 | exaggeration_ratio = mean((estimate/estimand)[p.value <= alpha]), 91 | var_estimate = pop.var(estimate), 92 | mean_var_hat = mean(std.error^2), 93 | prop_pos_sig = mean(estimate > 0 & p.value <= alpha), 94 | mean_ci_length = mean(conf.high - conf.low) 95 | ) 96 | 97 | diagnose_design( 98 | simulations_df, 99 | diagnosands = extended_diagnosands 100 | ) 101 | 102 | } 103 | } 104 | -------------------------------------------------------------------------------- /man/simulate_design.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/simulate_design.R 3 | \name{simulate_design} 4 | \alias{simulate_design} 5 | \alias{simulate_designs} 6 | \title{Simulate a design} 7 | \usage{ 8 | simulate_design(..., sims = 500, future.seed = TRUE) 9 | 10 | simulate_designs(..., sims = 500, future.seed = TRUE) 11 | } 12 | \arguments{ 13 | \item{...}{A design created using the + operator, or a set of designs. You can also provide a single list of designs, for example one created by \code{\link{expand_design}}.} 14 | 15 | \item{sims}{The number of simulations, defaulting to 500. If sims is a vector of the form c(10, 1, 2, 1) then different steps of a design will be simulated different numbers of times.} 16 | 17 | \item{future.seed}{Option for parallel diagnosis via the function future_lapply. A logical or an integer (of length one or seven), or a list of length(X) with pre-generated random seeds. For details, see ?future_lapply.} 18 | } 19 | \description{ 20 | Runs many simulations of a design and returns a simulations data.frame. Speed gains can be achieved by running simulate_design in parallel, see Examples. 21 | } 22 | \details{ 23 | Different steps of a design may each be simulated different a number of times, as specified by sims. In this case simulations are grouped into "fans". The nested 24 | structure of simulations is recorded in the dataset using a set of variables named "step_x_draw." For example if sims = c(2,1,1,3) is passed to simulate_design, then there 25 | will be two distinct draws of step 1, indicated in variable "step_1_draw" (with values 1 and 2) and there will be three draws for step 4 within each of the step 1 draws, recorded in "step_4_draw" (with values 1 to 6). 26 | } 27 | \examples{ 28 | 29 | # Two-arm randomized experiment 30 | design <- 31 | declare_model( 32 | N = 500, 33 | gender = rbinom(N, 1, 0.5), 34 | X = rep(c(0, 1), each = N / 2), 35 | U = rnorm(N, sd = 0.25), 36 | potential_outcomes(Y ~ 0.2 * Z + X + U) 37 | ) + 38 | declare_inquiry(ATE = mean(Y_Z_1 - Y_Z_0)) + 39 | declare_sampling(S = complete_rs(N = N, n = 200)) + 40 | declare_assignment(Z = complete_ra(N = N, m = 100)) + 41 | declare_measurement(Y = reveal_outcomes(Y ~ Z)) + 42 | declare_estimator(Y ~ Z, inquiry = "ATE") 43 | 44 | \dontrun{ 45 | # Simulate design 46 | simulations <- simulate_design(design, sims = 100) 47 | simulations 48 | 49 | # Diagnose design using simulations 50 | diagnosis <- diagnose_design(simulations_df = simulations) 51 | diagnosis 52 | 53 | # Simulate one part of the design for a fixed population 54 | # (The 100 simulates different assignments) 55 | head(simulate_design(design, sims = c(1, 1, 1, 100, 1, 1))) 56 | 57 | # You may also run simulate_design in parallel using 58 | # the future package on a personal computer with multiple 59 | # cores or on high performance computing clusters. 60 | 61 | library(future) 62 | options(parallelly.fork.enable = TRUE) # required for use in RStudio 63 | plan(multicore) # note other plans are possible, see future 64 | 65 | simulate_design(design, sims = 500) 66 | 67 | } 68 | 69 | } 70 | -------------------------------------------------------------------------------- /man/tidy.diagnosis.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/diagnosis_helper_functions.R 3 | \name{tidy.diagnosis} 4 | \alias{tidy.diagnosis} 5 | \title{Tidy diagnosis} 6 | \usage{ 7 | \method{tidy}{diagnosis}(x, conf.int = TRUE, conf.level = 0.95, ...) 8 | } 9 | \arguments{ 10 | \item{x}{A diagnosis object generated by \code{diagnose_design}.} 11 | 12 | \item{conf.int}{Logical indicating whether or not to include a 13 | confidence interval in the tidied output. Defaults to ‘TRUE’.} 14 | 15 | \item{conf.level}{The confidence level to use for the confidence 16 | interval if ‘conf.int = TRUE’. Must be strictly greater than 0 and less 17 | than 1. Defaults to 0.95, which corresponds to a 95 percent confidence 18 | interval.} 19 | 20 | \item{...}{extra arguments (not used)} 21 | } 22 | \value{ 23 | A data.frame with columns for diagnosand names, estimated diagnosand values, 24 | bootstrapped standard errors and confidence intervals 25 | } 26 | \description{ 27 | Tidy diagnosis 28 | } 29 | \examples{ 30 | 31 | effect_size <- 0.1 32 | design <- 33 | declare_model( 34 | N = 100, 35 | U = rnorm(N), 36 | X = rnorm(N), 37 | potential_outcomes(Y ~ effect_size * Z + X + U) 38 | ) + 39 | declare_inquiry(ATE = mean(Y_Z_1 - Y_Z_0)) + 40 | declare_assignment(Z = complete_ra(N)) + 41 | declare_measurement(Y = reveal_outcomes(Y ~ Z)) + 42 | declare_estimator(Y ~ Z, inquiry = "ATE", label = "unadjusted") + 43 | declare_estimator(Y ~ Z + X, inquiry = "ATE", label = "adjusted") 44 | 45 | diagnosis <- diagnose_design(design, sims = 100) 46 | 47 | tidy(diagnosis) 48 | 49 | } 50 | -------------------------------------------------------------------------------- /man/tidy_try.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/tidy_try.R 3 | \name{tidy_try} 4 | \alias{tidy_try} 5 | \title{Tidy Model Results and Filter to Relevant Coefficients} 6 | \usage{ 7 | tidy_try(fit, term = FALSE) 8 | } 9 | \arguments{ 10 | \item{fit}{A model fit, as returned by a modeling function like lm, glm, or estimatr::lm_robust.} 11 | 12 | \item{term}{A character vector of the terms that represent quantities of interest, i.e., "Z". If FALSE, return the first non-intercept term; if TRUE return all terms.} 13 | } 14 | \value{ 15 | A data.frame with coefficient estimates and associated statistics. 16 | } 17 | \description{ 18 | Tidy function that returns a tidy data.frame of model results and allows filtering to relevant coefficients. The function will attempt to tidy model objects even when they do not have a tidy method available. For best results, first load the broom package via \code{library(broom)}. 19 | } 20 | \examples{ 21 | 22 | fit <- lm(mpg ~ hp + disp + cyl, data = mtcars) 23 | 24 | tidy_try(fit) 25 | 26 | } 27 | -------------------------------------------------------------------------------- /tests/testthat.R: -------------------------------------------------------------------------------- 1 | library(testthat) 2 | library(DeclareDesign) 3 | 4 | test_check("DeclareDesign") 5 | -------------------------------------------------------------------------------- /tests/testthat/test-allow-custom-functions.R: -------------------------------------------------------------------------------- 1 | library(dplyr) 2 | 3 | my_pop <- declare_model(N = 100) 4 | 5 | # case 1 6 | 7 | test_that("a bare function can be used in a design", { 8 | my_simple_func <- function(data) { 9 | data$my_var <- 5 10 | data 11 | } 12 | 13 | des <- my_pop + my_simple_func 14 | dat <- draw_data(des) 15 | 16 | expect_equal(names(dat), c("ID", "my_var")) 17 | }) 18 | 19 | 20 | # case 2 21 | 22 | test_that("a dplyr pipeline can be used in a design", { 23 | 24 | # include without parens 25 | des <- my_pop + . %>% mutate(my_var = 5) 26 | dat <- draw_data(des) 27 | 28 | expect_equal(names(dat), c("ID", "my_var")) 29 | 30 | # include with parens 31 | des <- my_pop + (. %>% mutate(my_var = 5)) 32 | dat <- draw_data(des) 33 | 34 | expect_equal(names(dat), c("ID", "my_var")) 35 | }) 36 | 37 | # Use dyplr functions as handlers ? 38 | 39 | test_that("dplyr::mutate can be handlers", { 40 | 41 | design2 <- declare_model(N = 5, X = rnorm(N)) + declare_step(Y = 4, handler = mutate) 42 | 43 | df <- draw_data(design2) 44 | 45 | expect_equal(df$Y, rep(4,5)) 46 | }) 47 | 48 | test_that("dplyr filter can be handlers", { 49 | 50 | design2 <- declare_model(N = 5, X = rnorm(N)) + declare_step(ID > 3, handler = filter) 51 | 52 | df <- draw_data(design2) 53 | 54 | expect_equal(df$ID, as.character(4:5)) 55 | expect_true(DeclareDesign:::is_implicit_data_arg(environment(design2[[2]])$dots)) 56 | }) 57 | 58 | test_that("dplyr filter can be handlers with explicit .data", { 59 | 60 | design2 <- declare_model(N = 5, X = rnorm(N)) + declare_step(.data=data, ID > 3, handler = filter) 61 | 62 | df <- draw_data(design2) 63 | 64 | expect_equal(df$ID, as.character(4:5)) 65 | expect_false(DeclareDesign:::is_implicit_data_arg(environment(design2[[2]])$dots)) 66 | }) 67 | 68 | -------------------------------------------------------------------------------- /tests/testthat/test-alternative-df-compatibility.R: -------------------------------------------------------------------------------- 1 | context("tibble, sf compatibility") 2 | 3 | test_that("data.frame", { 4 | dat <- data.frame(y = rnorm(5), x = rnorm(5)) 5 | 6 | pos <- declare_potential_outcomes(Y_Z_0 = y * 5, Y_Z_1 = y * 5 + 3) 7 | 8 | design <- declare_model(dat) + pos 9 | 10 | df <- draw_data(design) 11 | 12 | expect_identical(colnames(df), c("y", "x", "Y_Z_0", "Y_Z_1")) 13 | 14 | expect_identical(dim(df), 5:4) 15 | }) 16 | 17 | test_that("tibble", { 18 | skip_if_not_installed("dplyr") 19 | 20 | dat <- dplyr::tibble(y = rnorm(5), x = rnorm(5)) 21 | 22 | pos <- declare_potential_outcomes(Y_Z_0 = y * 5, Y_Z_1 = y * 5 + 3) 23 | 24 | design <- declare_model(dat) + pos 25 | 26 | df <- draw_data(design) 27 | 28 | expect_identical(colnames(df), c("y", "x", "Y_Z_0", "Y_Z_1")) 29 | 30 | expect_identical(dim(df), 5:4) 31 | }) 32 | 33 | test_that("tibble more", { 34 | 35 | population <- declare_model(N = 100, u = rnorm(N)) 36 | potential_outcomes <- declare_potential_outcomes(Y ~ Z) 37 | assignment <- declare_assignment(Z = complete_ra(N, m = 50)) 38 | reveal_Y <- declare_reveal(Y,Z) 39 | 40 | my_func <- function(data){ 41 | data %>% (tibble::as_tibble) 42 | } 43 | 44 | design <- population + potential_outcomes + assignment + declare_step(handler = my_func) 45 | 46 | expect_s3_class(draw_data(design), "tbl_df") 47 | 48 | }) 49 | 50 | 51 | test_that("data.table", { 52 | skip_if_not_installed("data.table") 53 | 54 | dat <- data.table::data.table(y = rnorm(5), x = rnorm(5)) 55 | 56 | pos <- declare_potential_outcomes(Y_Z_0 = y * 5, Y_Z_1 = y * 5 + 3) 57 | 58 | design <- declare_model(dat) + pos 59 | 60 | df <- draw_data(design) 61 | 62 | expect_identical(colnames(df), c("y", "x", "Y_Z_0", "Y_Z_1")) 63 | 64 | expect_identical(dim(df), 5:4) 65 | }) 66 | 67 | test_that("sf", { 68 | skip_if_not_installed("sf") 69 | 70 | dat <- sf::st_as_sf(data.frame(id = 1:5, y = rnorm(5), x = rnorm(5)), coords = c("x", "y"), remove = FALSE) 71 | 72 | pos <- declare_potential_outcomes(Y_Z_0 = y * 5, Y_Z_1 = y * 5 + 3) 73 | 74 | design <- declare_model(dat) + pos 75 | 76 | df <- draw_data(design) 77 | 78 | expect_identical(colnames(df), c("id", "y", "x", "geometry", "Y_Z_0", "Y_Z_1")) 79 | 80 | expect_identical(dim(df), 5:6) 81 | }) 82 | 83 | -------------------------------------------------------------------------------- /tests/testthat/test-attrition.R: -------------------------------------------------------------------------------- 1 | context("Attrition") 2 | 3 | ## would be nice to do with fixed POs 4 | 5 | my_population <- declare_model( 6 | N = 100, income = rnorm(N), age = sample(18:95, N, replace = TRUE) 7 | ) 8 | 9 | my_potential_outcomes_Y <- declare_potential_outcomes( 10 | formula = Y ~ .25 * Z + .01 * age * Z 11 | ) 12 | 13 | my_assignment <- declare_assignment(Z = complete_ra(N, m = 25)) 14 | 15 | test_that("attrition / formula PO", { 16 | my_potential_outcomes_attrition <- declare_potential_outcomes( 17 | formula = R ~ rbinom(n = N, size = 1, prob = pnorm(Y_Z_0)) 18 | ) 19 | 20 | 21 | my_reveal_attrition <- declare_reveal(outcome_variables = "R") 22 | my_reveal_outcomes <- declare_reveal(outcome_variables = "Y", attrition_variables = "R") 23 | 24 | my_design <- 25 | my_population + 26 | my_potential_outcomes_Y + 27 | my_potential_outcomes_attrition + 28 | my_assignment + 29 | my_reveal_attrition + 30 | my_reveal_outcomes 31 | 32 | 33 | out <- head(draw_data(my_design)) 34 | 35 | expect_identical(is.na(out$Y), out$R == 0) 36 | }) 37 | 38 | test_that("attrition / legacy PO", { 39 | my_potential_outcomes_attrition <- declare_potential_outcomes( 40 | R_Z_0 = rbinom(n = N, size = 1, prob = pnorm(income)), 41 | R_Z_1 = rbinom(n = N, size = 1, prob = pnorm(income + .2)) 42 | ) 43 | 44 | my_design <- 45 | my_population + 46 | my_potential_outcomes_Y + 47 | my_potential_outcomes_attrition + 48 | my_assignment + 49 | declare_reveal(outcome_variables = "R") + 50 | declare_reveal(attrition_variables = "R") 51 | 52 | out <- head(draw_data(my_design)) 53 | 54 | expect_identical(is.na(out$Y), out$R == 0) 55 | }) 56 | -------------------------------------------------------------------------------- /tests/testthat/test-bootstrap-diagnosands.R: -------------------------------------------------------------------------------- 1 | context("Bootstrap Diagnosands") 2 | test_that("test diagnosands", { 3 | my_population <- declare_model(N = 50, noise = rnorm(N)) 4 | 5 | my_potential_outcomes <- 6 | declare_potential_outcomes( 7 | Y_Z_0 = noise, 8 | Y_Z_1 = noise + rnorm(N, mean = 2, sd = 2) 9 | ) 10 | 11 | my_assignment <- declare_assignment(Z = complete_ra(N, m = 25)) 12 | 13 | pate <- declare_inquiry(mean(Y_Z_1 - Y_Z_0), label = "pate") 14 | 15 | pate_estimator1 <- declare_estimator(Y ~ Z, inquiry = pate, label = "test1") 16 | pate_estimator2 <- declare_estimator(Y ~ Z - 1, inquiry = pate, label = "test2") 17 | 18 | measurement <- declare_measurement(Y = reveal_outcomes(Y ~ Z)) 19 | 20 | fixed_data <- my_population() 21 | 22 | my_design <- declare_model(data = fixed_data) + 23 | my_potential_outcomes + 24 | pate + 25 | my_assignment + 26 | measurement + 27 | pate_estimator1 + 28 | pate_estimator2 29 | 30 | run_design(my_design) 31 | 32 | # default set 33 | 34 | diagnosis <- diagnose_design(my_design, sims = 2, bootstrap_sims = 2) 35 | expect_equal(dim(diagnosis$diagnosands_df), c(2, 20)) 36 | 37 | expect_equal(dim(diagnosis$simulations_df), c(4, 14)) 38 | }) 39 | 40 | 41 | 42 | test_that("Bootstrap ses close", { 43 | skip("Skipped bootstrap SE test for speed") 44 | 45 | pop <- declare_model(N = 100, S100 = rnorm(N, sd = 100), S10000 = rnorm(N, sd = 10000)) 46 | inquiry <- declare_inquiry(S100 = mean(S100), S10000 = mean(S10000)) 47 | estimate <- declare_estimator(S100 ~ S10000, .method = lm, inquiry = list("S100", "S10000")) 48 | design <- pop + inquiry + estimate 49 | d <- diagnose_design(design, sims = 10000) 50 | expect_true(d$diagnosands_df$`se(mean_estimand)`[1] > .06) 51 | expect_true(d$diagnosands_df$`se(mean_estimand)`[1] < .14) 52 | expect_true(d$diagnosands_df$`se(mean_estimand)`[2] > 6) 53 | expect_true(d$diagnosands_df$`se(mean_estimand)`[2] < 14) 54 | }) 55 | 56 | -------------------------------------------------------------------------------- /tests/testthat/test-citation.R: -------------------------------------------------------------------------------- 1 | context("add design citation") 2 | 3 | test_that("test with generated citation", { 4 | 5 | design <- declare_model(data = sleep) + declare_sampling(S = complete_rs(N, n = 10)) 6 | design 7 | 8 | design <- set_citation(design, 9 | author = "Lovelace, Ada", 10 | title = "Notes", 11 | year = 1953, 12 | description = "This is a text description of a design" 13 | ) 14 | 15 | expect_output(print(design), "Lovelace") 16 | 17 | expect_output(cite <- cite_design(design), "Ada") 18 | 19 | expect_equal( 20 | cite, 21 | structure(list(structure(list( 22 | title = "Notes", 23 | author = structure(list( 24 | list( 25 | given = NULL, family = "Lovelace", 26 | role = NULL, email = NULL, comment = NULL 27 | ), 28 | list( 29 | given = NULL, family = "Ada", 30 | role = NULL, email = NULL, comment = NULL 31 | ) 32 | ), 33 | class = "person" 34 | ), 35 | note = "This is a text description of a design", 36 | year = "1953" 37 | ), bibtype = "Unpublished")), class = "bibentry") 38 | ) 39 | }) 40 | 41 | test_that("test with user-specified text citation", { 42 | text <- "Set of authors (2017). My custom design." 43 | 44 | design <- declare_model(data = sleep) + NULL 45 | 46 | design <- set_citation(design, citation = text) 47 | 48 | expect_output(cite <- cite_design(design), paste0('[1] "', text, '"'), fixed = TRUE) 49 | expect_equal(cite, text) 50 | 51 | expect_output(print(design), "Citation:") 52 | }) 53 | 54 | -------------------------------------------------------------------------------- /tests/testthat/test-compare-designs.R: -------------------------------------------------------------------------------- 1 | context("Compare Designs") 2 | 3 | my_population <- declare_model(N = 50, noise = rnorm(N)) 4 | 5 | my_potential_outcomes <- 6 | declare_potential_outcomes(Y_Z_0 = noise, Y_Z_1 = noise + rnorm(N, mean = 2, sd = 2)) 7 | 8 | my_assignment <- declare_assignment(Z = complete_ra(N, m = 25)) 9 | 10 | pate <- declare_inquiry(pate = mean(Y_Z_1 - Y_Z_0)) 11 | sate <- declare_inquiry(sate = mean(Y_Z_1 - Y_Z_0)) 12 | 13 | pate_estimator <- declare_estimator(Y ~ Z, inquiry = pate) 14 | sate_estimator <- declare_estimator(Y ~ Z, inquiry = sate) 15 | 16 | measurement <- declare_measurement(Y = reveal_outcomes(Y ~ Z)) 17 | 18 | my_design_1 <- my_population + 19 | my_potential_outcomes + 20 | pate + 21 | my_assignment + 22 | measurement + 23 | pate_estimator 24 | 25 | my_design_2 <- my_population + 26 | my_potential_outcomes + 27 | sate + 28 | my_assignment + 29 | measurement + 30 | sate_estimator 31 | 32 | test_that("compare_designs works", { 33 | 34 | 35 | diagnosis_1 <- diagnose_design(my_design_1, sims = 2, bootstrap_sims = FALSE) 36 | diagnosis_2 <- diagnose_design(my_design_2, sims = 2, bootstrap_sims = FALSE) 37 | 38 | # designs not in list, no names, names are imputed 39 | comparison <- diagnose_design(my_design_1, my_design_2, sims = 2, bootstrap_sims = FALSE) 40 | expect_equal(as.character(comparison$diagnosands$design), c("my_design_1", "my_design_2")) 41 | 42 | # designs in list, no names, names are imputed 43 | comparison <- diagnose_design(list(my_design_1, my_design_2), sims = 2, bootstrap_sims = FALSE) 44 | expect_equal(as.character(comparison$diagnosands$design), c("design_1", "design_2")) 45 | 46 | # designs not in list, all names, names used 47 | comparison <- diagnose_design(d1 = my_design_1, d2 = my_design_2, sims = 2, bootstrap_sims = FALSE) 48 | expect_equal(as.character(comparison$diagnosands$design), c("d1", "d2")) 49 | 50 | # designs in list, all names, names used 51 | comparison <- diagnose_design(list(d1 = my_design_1, d2 = my_design_2), sims = 2, bootstrap_sims = FALSE) 52 | expect_equal(as.character(comparison$diagnosands$design), c("d1", "d2")) 53 | 54 | # designs not in list, some names, available names used 55 | comparison <- diagnose_design(my_design_1, a_design_2 = my_design_2, sims = 2, bootstrap_sims = FALSE) 56 | expect_true(all(as.character(comparison$diagnosands$design) %in% c("my_design_1", "a_design_2"))) 57 | 58 | # designs not in list, duplicated names used, error 59 | expect_error(comparison <- diagnose_design(d1 = my_design_1, d1 = my_design_2, sims = 2, bootstrap_sims = FALSE)) 60 | 61 | # designs in list, duplicated names used, error 62 | expect_error(comparison <- diagnose_design(list(d1 = my_design_1, d1 = my_design_2), sims = 2, bootstrap_sims = FALSE)) 63 | }) 64 | 65 | 66 | my_population <- declare_model(N = 50, noise = rnorm(N)) 67 | 68 | my_potential_outcomes <- 69 | declare_potential_outcomes(Y_Z_0 = noise, Y_Z_1 = noise + rnorm(N, mean = 2, sd = 2)) 70 | 71 | my_assignment <- declare_assignment(Z = complete_ra(N, m = 25)) 72 | 73 | pate <- declare_inquiry(pate = mean(Y_Z_1 - Y_Z_0)) 74 | sate <- declare_inquiry(sate = mean(Y_Z_1 - Y_Z_0)) 75 | 76 | pate_estimator <- declare_estimator(Y ~ Z, inquiry = pate) 77 | sate_estimator <- declare_estimator(Y ~ Z, inquiry = sate) 78 | 79 | measurement <- declare_measurement(Y = reveal_outcomes(Y ~ Z)) 80 | 81 | my_special_step <- declare_inquiry(ATE = 5) 82 | 83 | my_design_3 <- my_population + 84 | my_potential_outcomes + 85 | pate + 86 | my_special_step + 87 | my_assignment + 88 | measurement + 89 | pate_estimator 90 | 91 | my_design_4 <- my_population + 92 | my_potential_outcomes + 93 | sate + 94 | my_assignment + 95 | measurement + 96 | sate_estimator 97 | 98 | test_that("compare works", { 99 | expect_no_error(compare_design_code(my_design_3, my_design_4)) 100 | expect_no_error(compare_design_summaries(my_design_3, my_design_4)) 101 | expect_no_error(compare_design_data(my_design_3, my_design_4)) 102 | expect_no_error(compare_design_inquiries(my_design_3, my_design_4)) 103 | expect_no_error(compare_design_estimates(my_design_3, my_design_4)) 104 | expect_no_error(compare_designs(my_design_3, my_design_4)) 105 | }) 106 | 107 | 108 | -------------------------------------------------------------------------------- /tests/testthat/test-compare-diagnoses.R: -------------------------------------------------------------------------------- 1 | context("Compare Diagnoses") 2 | 3 | prob_assgn <- 0.5 4 | design_a <- 5 | declare_model(N = 100, u = rnorm(N), X = runif(N, 0, 2)) + 6 | declare_potential_outcomes(Y_Z_0 = u, Y_Z_1 = u + rnorm(N, .5)) + 7 | declare_assignment(Z = complete_ra(N, prob = prob_assgn)) + 8 | declare_inquiry(ATE = mean(Y_Z_1 - Y_Z_0), label = "ATE") + 9 | declare_measurement(Y = reveal_outcomes(Y ~ Z)) + 10 | declare_estimator(Y ~ Z, inquiry = "ATE", label = "est1") 11 | design_b <- redesign(design_a, prob_assgn = 0.1) 12 | set.seed(2000) 13 | 14 | comparison <- compare_diagnoses(design_a, design_b, sims = 3) 15 | 16 | test_that("compare_diagnoses works", { 17 | set.seed(2000) 18 | expect_is(compare_diagnoses(design_a, design_b, sims = 3), "compared_diagnoses") 19 | }) 20 | 21 | 22 | 23 | test_that("merge_by_estimator working in compare_diagnoses", { 24 | 25 | # 1:1 comparison 26 | diagnosis_a <- diagnose_design(design_a, sims = 3, bootstrap_sims = 0) 27 | design_c <- 28 | insert_step( 29 | design_a, 30 | declare_estimator( 31 | Y ~ Z + X, 32 | inquiry = "ATE", 33 | term = "Z", 34 | .method = lm_robust, 35 | label = "est2" 36 | ), 37 | after = "est1" 38 | ) 39 | comparison <- 40 | compare_diagnoses(design_a, 41 | design_c, 42 | sims = 3, 43 | merge_by_estimator = TRUE) 44 | 45 | n1 <- length(diagnosis_a$diagnosand_names) 46 | n2 <- nrow(comparison$compared_diagnoses_df) 47 | expect_equal(n1, n2) 48 | 49 | comparison <- 50 | compare_diagnoses(design_a, 51 | design_c, 52 | sims = 3, 53 | merge_by_estimator = FALSE) 54 | n2 <- nrow(comparison$compared_diagnoses_df) 55 | expect_equal(n1*2, n2) 56 | 57 | # 2:2 58 | comparison <- compare_diagnoses(design_c, design_c, sims = 3, merge_by_estimator = FALSE) 59 | n2 <- nrow(comparison$compared_diagnoses_df) 60 | expect_equal(n1*4, n2) 61 | }) 62 | 63 | 64 | test_that("compare_diagnoses errors when it should", { 65 | # bootstrap errors 66 | expect_error(compare_diagnoses(design_a, design_b, sims = 3, bootstrap_sims = 0)) 67 | 68 | 69 | 70 | # diagnosis_df must contain only one unique design 71 | designer <- function(N) { 72 | declare_model(N = N, noise = rnorm(N)) + 73 | declare_potential_outcomes(Y ~ 0.20 * Z + noise) + 74 | declare_assignment(Z = complete_ra(N, prob = 0.5)) + 75 | declare_inquiry(ate = mean(Y_Z_1 - Y_Z_0)) + 76 | declare_measurement(Y = reveal_outcomes(Y ~ Z)) + 77 | declare_estimator(Y ~ Z) 78 | } 79 | 80 | designs <- expand_design(designer , N = c(20, 30)) 81 | expect_error(compare_diagnoses(designs, design_a, sims = 3)) 82 | design_c <- designer(N = 30) 83 | expect_error(compare_diagnoses(design_a, design_c, sims = 3)) 84 | design_d <- delete_step(design_c, "estimator") 85 | expect_warning(compare_diagnoses(design_c, design_d, sims = 3)) 86 | }) 87 | 88 | 89 | test_that("compare_diagnoses prints", { 90 | expect_output(DeclareDesign:::print.compared_diagnoses(comparison)) 91 | }) 92 | -------------------------------------------------------------------------------- /tests/testthat/test-conduct-custom.R: -------------------------------------------------------------------------------- 1 | context("declare design") 2 | 3 | test_that("test the custom execution strategy", { 4 | 5 | # closes ticket #62 6 | 7 | design <- declare_model(sleep) + declare_estimator(extra ~ group) 8 | 9 | my_sleep <- sleep 10 | my_sleep$extra <- my_sleep$extra + 1 * (my_sleep$group == 1) 11 | 12 | exst <- 13 | execution_st(design, 14 | current_df = my_sleep, 15 | results = list(estimator = vector(mode = "list", length = 2)), 16 | 2, 2 17 | ) 18 | 19 | 20 | regular <- run_design(design) 21 | output <- run_design(exst) 22 | 23 | expect_equal( 24 | regular$estimate, 25 | output$estimate + 1 26 | ) 27 | expect_true(!"estimand" %in% names(output)) # no inquiries 28 | }) 29 | 30 | 31 | test_that("test error messages in run_design", { 32 | 33 | # closes ticket #12 34 | design <- declare_model(sleep) + declare_model(foo = bar) 35 | 36 | expect_error(run_design(design), "Error in step 2") 37 | }) 38 | 39 | test_that("draw_data does not run inquiry/estimator", { 40 | 41 | # closes ticket #12 42 | design <- declare_model(sleep) + 43 | declare_inquiry( 44 | "Should not be run", 45 | handler = function(data, msg) 46 | stop(x) 47 | ) 48 | 49 | expect_identical(draw_data(design), sleep) 50 | }) 51 | -------------------------------------------------------------------------------- /tests/testthat/test-continuous-pos.R: -------------------------------------------------------------------------------- 1 | context("Continuous POs") 2 | test_that("you can do continuous POs", { 3 | my_population <- declare_model( 4 | N = 100, income = rnorm(N), age = sample(18:95, N, replace = T) 5 | ) 6 | 7 | conditions <- seq(0, 1, by = .1) 8 | 9 | my_potential_outcomes <- declare_potential_outcomes( 10 | formula = Y ~ .25 * Z + .01 * age * Z, conditions = conditions 11 | ) 12 | 13 | my_assignment <- declare_assignment(Z = complete_ra(N = N, conditions = conditions)) 14 | 15 | my_measurement <- declare_measurement(Y = reveal_outcomes(Y ~ Z)) 16 | 17 | my_design <- my_population + 18 | my_potential_outcomes + 19 | my_assignment + 20 | my_measurement 21 | 22 | df <- head(draw_data(my_design)) 23 | 24 | expect_length(colnames(df) %i% paste("Y", "Z", conditions, sep = "_"), 11) 25 | }) 26 | 27 | test_that("Hooke's law", { 28 | 29 | # Length of spring = resting length + stiffness * Force 30 | 31 | # Length is cm 32 | # Force is g 33 | # stiffness is cm/g 34 | 35 | # Variablity in manufacturing 36 | pop <- 37 | declare_model(springs = add_level( 38 | N = 100, 39 | resting = rnorm(N, 10, .1), 40 | stiffness = rnorm(N, 1, .05) 41 | )) 42 | 43 | 44 | potential_outcome_f <- 45 | function(resting, stiffness, force) { 46 | resting + stiffness * force 47 | } 48 | 49 | inquiry <- declare_inquiry( 50 | `(Intercept)` = mean(potential_outcome_f(resting, stiffness, 0)), 51 | stiffness = mean(potential_outcome_f(resting, stiffness, 1) - potential_outcome_f(resting, stiffness, 0)), 52 | term = TRUE 53 | ) 54 | 55 | # 30 is magic 56 | sampling <- declare_sampling(S = complete_rs(N, n = 30)) 57 | 58 | # We don't have a 1g weight, only 5, 10, 25, 50, 100 59 | # randomly put a combo of those on the spring 60 | w <- c(0, 5, 10, 25, 50, 100) 61 | 62 | assignment <- declare_assignment( 63 | handler = fabricate, 64 | force = replicate(N, sum(sample( 65 | w, sample(length(w), 1) 66 | ))) 67 | ) 68 | 69 | # 1mm of measurment error 70 | reveal <- declare_reveal( 71 | handler = fabricate, 72 | length = potential_outcome_f(resting, stiffness, force) + 73 | rnorm(N, sd = .1) 74 | ) 75 | 76 | estimator <- declare_estimator(length ~ force, .method = lm, term = TRUE) 77 | 78 | design <- pop + inquiry + sampling + assignment + reveal + estimator 79 | 80 | df <- draw_data(design) 81 | 82 | # Not all forces are realized 83 | expect_lt(length(unique(df$force)), sum(choose(length(w), seq_along(w)))) 84 | 85 | # No PO columns created in df 86 | expect_false(any(grep("length_force_", names(df)))) 87 | }) 88 | -------------------------------------------------------------------------------- /tests/testthat/test-custom-functions.R: -------------------------------------------------------------------------------- 1 | context("Custom Functions") 2 | 3 | test_that("custom population", { 4 | ## population 5 | my_population_function <- function(N) { 6 | data.frame(u = rnorm(N)) 7 | } 8 | 9 | my_population_custom <- declare_model( 10 | handler = my_population_function, N = 100 11 | ) 12 | 13 | rm(my_population_function) 14 | pop_custom <- my_population_custom() 15 | 16 | expect_equal(dim(pop_custom), c(100, 1)) 17 | }) 18 | 19 | test_that("custom PO", { 20 | ## potential outcomes 21 | my_potential_outcomes_function <- 22 | function(data) { 23 | data$Y_Z_0 <- with(data, extra) 24 | data$Y_Z_1 <- with(data, 0.25 + extra) 25 | data 26 | } 27 | 28 | my_potential_outcomes_custom <- declare_potential_outcomes( 29 | handler = my_potential_outcomes_function 30 | ) 31 | 32 | rm(my_potential_outcomes_function) 33 | pop_custom <- my_potential_outcomes_custom(data = sleep) 34 | 35 | expect_equal(dim(pop_custom), c(20, 5)) 36 | }) 37 | 38 | 39 | test_that("custom sampling", { 40 | ## sampling 41 | my_sampling_function <- function(data) { 42 | data$S <- rbinom( 43 | n = nrow(data), 44 | size = 1, 45 | prob = 0.1 46 | ) 47 | data[data$S == 1, ] 48 | } 49 | 50 | my_sampling_custom <- declare_sampling( 51 | handler = my_sampling_function 52 | ) 53 | 54 | smp_custom <- my_sampling_custom(sleep) 55 | expect_true("S" %in% names(smp_custom)) 56 | }) 57 | -------------------------------------------------------------------------------- /tests/testthat/test-declare-design.R: -------------------------------------------------------------------------------- 1 | context("declare design") 2 | 3 | test_that( 4 | "test the full declare design setup", { 5 | N <- 500 6 | 7 | my_population <- declare_model(N = N, noise = rnorm(N)) 8 | 9 | my_potential_outcomes <- 10 | declare_potential_outcomes(Y_Z_0 = noise, Y_Z_1 = noise + rnorm(N, mean = 2, sd = 2)) 11 | 12 | my_sampling <- declare_sampling(S = complete_rs(N, n = 250)) 13 | 14 | my_assignment <- declare_assignment(Z = complete_ra(N, m = 25)) 15 | 16 | my_inquiry <- declare_inquiry(ATE = mean(Y_Z_1 - Y_Z_0)) 17 | 18 | my_estimator <- declare_estimator(Y ~ Z, inquiry = my_inquiry) 19 | 20 | my_mutate <- declare_step(dplyr::mutate, noise_sq = noise^2) 21 | 22 | my_measurement <- declare_measurement(Y = reveal_outcomes(Y ~ Z)) 23 | 24 | design <- my_population + 25 | my_potential_outcomes + 26 | my_sampling + 27 | my_inquiry + 28 | my_mutate + 29 | my_assignment + 30 | my_measurement + 31 | my_estimator 32 | 33 | df <- (draw_data(design)) 34 | expect_equal(dim(df), c(250, 8)) 35 | 36 | output <- run_design(design) 37 | expect_equal(dim(output), c(1, 12)) 38 | } 39 | ) 40 | 41 | 42 | test_that("No estimators / inquiries", { 43 | design <- 44 | declare_model(N = 500, noise = 1:N, Y_Z_0 = noise, Y_Z_1 = noise + 1) + 45 | declare_sampling(S = complete_rs(N, n = 250)) + 46 | declare_assignment(Z = complete_ra(N, m = 25)) + 47 | declare_measurement(Y = reveal_outcomes(Y ~ Z)) 48 | 49 | head(draw_data(design)) 50 | expect_error(run_design(design), "No estimates or inquiries were declared") 51 | }) 52 | 53 | test_that("single-step designs work", { 54 | pop <- declare_model(N = 100) 55 | 56 | des_1 <- +pop 57 | des_2 <- pop + NULL 58 | 59 | expect_equal(des_1, des_2) 60 | }) 61 | 62 | test_that("sending bad objects to design yields error", { 63 | pop <- declare_model(N = 100) 64 | 65 | my_func <- function(x) { 66 | return(x) 67 | } 68 | 69 | # can't send a function call 70 | expect_error(pop + my_func(5), "The right hand side") 71 | }) 72 | 73 | test_that("test send design as RHS", { 74 | my_rhs <- declare_sampling(S = complete_rs(N, n = 50)) + declare_assignment(Z = complete_ra(N, m = 5)) 75 | 76 | expect_length(declare_model(N = 100) + my_rhs, 3) 77 | }) 78 | 79 | 80 | test_that("send function that doesn't have data as first arg sends warning", { 81 | my_func <- function(my_arg) return(my_arg) 82 | 83 | expect_warning(declare_model(N = 100) + my_func, "Undeclared Step 2 function arguments are not exactly 'data'") 84 | }) 85 | 86 | -------------------------------------------------------------------------------- /tests/testthat/test-declare-step.R: -------------------------------------------------------------------------------- 1 | context("declare step") 2 | 3 | test_that("test declare step ", { 4 | my_population <- declare_model(N = 50, noise = rnorm(N)) 5 | my_assignment <- declare_assignment(Z = complete_ra(N, m = 25)) 6 | my_step <- declare_step(fabricate, Z2 = Z, q = 5) 7 | 8 | design <- my_population + my_assignment + my_step 9 | df <- draw_data(design) 10 | expect_equal(df$Z2, df$Z) 11 | }) 12 | -------------------------------------------------------------------------------- /tests/testthat/test-deprecated.R: -------------------------------------------------------------------------------- 1 | 2 | context("deprecated") 3 | 4 | test_that("get_estimates is changed to draw_estimates", { 5 | my_design <- declare_model(N = 100) + NULL 6 | expect_error(get_estimates(my_design), "Please provide a data frame to the data argument. If you would like to get estimates from simulated data, use draw_estimates to draw data and get estimates in one step.") 7 | }) 8 | 9 | 10 | test_that("estimand = is deprecated", { 11 | 12 | des <- 13 | declare_model(N = 5, Y = rnorm(N)) + 14 | declare_inquiry(ybar = mean(Y)) + 15 | declare_estimator(Y ~ 1, .method = lm_robust, estimand = "ybar") 16 | 17 | expect_warning(draw_estimates(des), "The argument 'estimand = ' is deprecated. Please use 'inquiry = ' instead.") 18 | 19 | }) 20 | 21 | test_that("declare_estimand is deprecated", { 22 | 23 | expect_warning(declare_estimand(ATE = mean(Y_Z_1 - Y_Z_0), label = "The SATE"), "Use 'declare_inquiry' instead.") 24 | 25 | expect_warning(( 26 | declare_model( 27 | N = 10, 28 | Y_Z_0 = 1:10, 29 | Y_Z_1 = 3:12 30 | ) + 31 | declare_estimand(PATE = mean(Y_Z_1 - Y_Z_0)) 32 | ), 33 | "Use 'declare_inquiry' instead.") 34 | 35 | }) 36 | 37 | test_that("model = is deprecated", { 38 | 39 | des <- 40 | declare_model(N = 5, Y = rnorm(N)) + 41 | declare_inquiry(ybar = mean(Y)) + 42 | declare_estimator(Y ~ 1, model = lm_robust, inquiry = "ybar") 43 | 44 | expect_warning(draw_estimates(des), "The argument 'model = ' is deprecated. Please use '.method = ' instead.") 45 | 46 | expect_warning(expect_equal(colnames(draw_estimates(des)), c("estimator", "term", "estimate", "std.error", "statistic", 47 | "p.value", "conf.low", "conf.high", "df", "outcome", "inquiry" 48 | ))) 49 | 50 | }) 51 | 52 | test_that("model_summary = is deprecated", { 53 | 54 | des <- 55 | declare_model(N = 5, Y = rnorm(N)) + 56 | declare_inquiry(ybar = mean(Y)) + 57 | declare_estimator(Y ~ 1, model = lm_robust, model_summary = tidy, inquiry = "ybar") 58 | 59 | expect_warning(draw_estimates(des), "The argument 'model_summary = ' is deprecated. Please use '.summary = ' instead.") 60 | 61 | expect_warning(expect_equal(colnames(draw_estimates(des)), c("estimator", "term", "estimate", "std.error", "statistic", 62 | "p.value", "conf.low", "conf.high", "df", "outcome", "inquiry" 63 | ))) 64 | 65 | }) 66 | -------------------------------------------------------------------------------- /tests/testthat/test-describe_variable.R: -------------------------------------------------------------------------------- 1 | context("Describe Variable") 2 | 3 | test_that("Describle Variable", { 4 | data_littleint <- c(rep(1, 10), rep(2, 10), rep(3, 10)) 5 | data_littlechar <- c(rep("test", 10), rep("that", 10)) 6 | data_littlefactor <- as.factor(data_littlechar) 7 | data_littlemissing <- c(rep(1, 10), rep(NA, 3)) 8 | 9 | data_bigint <- 1:20 10 | data_bigchar <- c("a", "b", "c", "d", "e", "f", "g") 11 | data_bigfactor <- as.factor(data_bigchar) 12 | data_bigmissing <- c(1:10, rep(NA, 3)) 13 | 14 | data_logical <- c(rep(TRUE, 11), rep(FALSE, 9)) 15 | data_true_mixed <- c(TRUE, 5, NA, "test") # Should induce coercion to character 16 | data_mixed_numeric <- c(TRUE, FALSE, TRUE, 5, 7, 8, 9) # Should induce coercion to 1/0 17 | 18 | describe_variable(data_littleint) 19 | describe_variable(data_littlechar) 20 | describe_variable(data_littlefactor) 21 | describe_variable(data_littlemissing) 22 | 23 | describe_variable(data_bigint) 24 | describe_variable(data_bigchar) 25 | describe_variable(data_bigfactor) 26 | describe_variable(data_bigmissing) 27 | 28 | describe_variable(data_logical) 29 | 30 | expect_equal( 31 | sort(colnames(describe_variable(data_true_mixed))), 32 | sort(c("5", "test", "TRUE", "NA")) 33 | ) 34 | 35 | expect_equal( 36 | describe_variable(data_mixed_numeric), 37 | structure(list( 38 | min = 0, median = 5, mean = 4.43, max = 9, sd = 3.74, 39 | N_missing = 0L, N_unique = 6L 40 | ), 41 | .Names = c( 42 | "min", "median", 43 | "mean", "max", "sd", "N_missing", "N_unique" 44 | ), 45 | row.names = c(NA, -1L), class = "data.frame" 46 | ) 47 | ) 48 | }) 49 | 50 | 51 | test_that("Describe Variable", { 52 | test <- data.frame( 53 | d = seq(from = as.POSIXct("2018-01-01"), 54 | to = as.POSIXct("2018-05-01"), 55 | by = "days")) 56 | # Different ways of bringing data into DD 57 | pop1 <- declare_model(data = test) 58 | dsgn <- pop1 + NULL 59 | expect_output(print(dsgn, verbose = TRUE), "2018-01-01") 60 | }) 61 | -------------------------------------------------------------------------------- /tests/testthat/test-design-library.R: -------------------------------------------------------------------------------- 1 | context("design library") 2 | 3 | 4 | test_that("design library dependency works",{ 5 | skip_if_not_installed("DesignLibrary") 6 | skip_on_cran() 7 | design_1 <- DesignLibrary::two_by_two_designer(N = 500, outcome_means = c(0,0,1,2), weight_A = 0, weight_B = 0) 8 | design_2 <- DesignLibrary::multi_arm_designer(N = 500, m_arms = 3, outcome_means = c(0, 0, 1)) 9 | dx <- diagnose_design(design_1, design_2, sims = 3, bootstrap_sims = FALSE) 10 | 11 | expect_true(all(c("design_1", "design_2") %in% dx$diagnosands_df$design)) 12 | 13 | }) 14 | 15 | 16 | 17 | # fan out 18 | 19 | test_that("MH sim ids", { 20 | skip_if_not_installed("DesignLibrary") 21 | skip_on_cran() 22 | design <- DesignLibrary::two_arm_designer() 23 | 24 | Sys.setenv(TESTTHAT='m') 25 | sx <- expect_warning(simulate_design(design, sims = c(2, 1, 1, 1, 1, 2))) 26 | Sys.setenv(TESTTHAT='true') 27 | 28 | expect_equal(sx$step_1_draw, c(1L, 1L, 2L, 2L)) 29 | expect_equal(sx$step_6_draw, c(1L, 2L, 3L, 4L)) 30 | expect_equal(sx$estimate[1], sx$estimate[2]) 31 | expect_equal(sx$estimate[3], sx$estimate[4]) 32 | }) 33 | 34 | 35 | test_that("fan out IDs are correct", { 36 | 37 | skip_if_not_installed("DesignLibrary") 38 | skip_on_cran() 39 | 40 | sims <- c(30, 1, 2, 1, 1, 2) 41 | design <- DesignLibrary::two_arm_designer(rho = 0) 42 | 43 | sx <- simulate_design(design, sims = sims) 44 | 45 | expect_equivalent(vapply(sx[c("step_1_draw", "step_3_draw", "step_6_draw")], max, 0), c(30, 60, 120)) 46 | }) -------------------------------------------------------------------------------- /tests/testthat/test-design-summary.R: -------------------------------------------------------------------------------- 1 | context("Design summary") 2 | 3 | test_that("Basic design summary", { 4 | my_population <- declare_model(N = 500, noise = rnorm(N)) 5 | 6 | my_potential_outcomes <- declare_potential_outcomes(Y_Z_0 = noise, Y_Z_1 = noise + rnorm(N, mean = 2, sd = 2)) 7 | 8 | my_sampling <- declare_sampling(S = complete_rs(N, n = 250)) 9 | 10 | my_assignment <- declare_assignment(Z = complete_ra(N, m = 25)) 11 | 12 | my_inquiry <- declare_inquiry(ATE = mean(Y_Z_1 - Y_Z_0)) 13 | 14 | my_estimator <- declare_estimator(Y ~ Z, inquiry = my_inquiry) 15 | 16 | my_measurement <- declare_measurement(Y = reveal_outcomes(Y ~ Z)) 17 | 18 | design <- my_population + 19 | my_potential_outcomes + 20 | my_sampling + 21 | my_inquiry + 22 | declare_step(dplyr::mutate, q = 5) + 23 | my_assignment + 24 | my_measurement + 25 | my_estimator 26 | 27 | s <- summary(design) 28 | 29 | # First step 30 | expect_equal(s$N[[1]], "N = 500") 31 | expect_equal(s$call[[1]], attr(my_population, "call")) 32 | 33 | # Last step 34 | expect_equal(s$formulae[[8]], Y ~ Z) 35 | 36 | s_short <- summary(design, verbose = FALSE) 37 | 38 | expect_failure(expect_output(print(summary(design, verbose = FALSE)), "Formula")) 39 | }) 40 | 41 | 42 | test_that("Add Quantitites and Alter Variables", { 43 | my_population <- declare_model(N = 500, noise = rnorm(N)) 44 | my_inquiry <- declare_inquiry(foo = mean(noise)) 45 | my_transform <- declare_model(noise = noise / 2) 46 | my_inquiry2 <- declare_inquiry(foo2 = mean(noise)) 47 | 48 | 49 | design <- my_population + 50 | my_inquiry + 51 | my_transform + 52 | my_inquiry2 53 | 54 | # Adding Quantitites 55 | expect_output( 56 | print(design, verbose = TRUE), "A single draw of the" 57 | ) 58 | 59 | # Altering variables 60 | expect_output( 61 | print(design, verbose = TRUE), "Altered variable: noise " 62 | ) 63 | }) 64 | 65 | test_that("str() works", { 66 | expect_output(str(declare_model(N = 50)), "design_step:\\t declare_model[(]N = 50[)] ") 67 | }) 68 | 69 | test_that("summary, custom estimator handler, numeric value", { 70 | extra <- declare_estimator( 71 | handler = function(data) 72 | mean(data$extra) 73 | ) 74 | d <- declare_model(sleep) + extra 75 | 76 | expect_output(print(d, verbose = TRUE), "1.54") 77 | }) 78 | 79 | test_that("summary, estimator formula print formula", { 80 | extra <- declare_estimator(extra ~ group) 81 | d <- declare_model(sleep) + extra 82 | expect_output(print(d), "extra ~ group") 83 | }) 84 | 85 | test_that("summary, estimator print model", { 86 | d <- declare_model(sleep) + declare_estimator(extra ~ group, .method = lm) 87 | expect_output(print(d, verbose = TRUE), "Method:\\s*lm") 88 | }) 89 | -------------------------------------------------------------------------------- /tests/testthat/test-environment-issues.R: -------------------------------------------------------------------------------- 1 | context("environment problems") 2 | 3 | test_that("send inquiry to estimator works", { 4 | my_population <- declare_model(N = 50, noise = rnorm(N)) 5 | 6 | my_potential_outcomes <- 7 | declare_potential_outcomes( 8 | Y_Z_0 = noise, 9 | Y_Z_1 = noise + rnorm(N, mean = 2, sd = 2) 10 | ) 11 | 12 | my_assignment <- declare_assignment(Z = complete_ra(N, m = 25)) 13 | 14 | pate <- declare_inquiry(mean(Y_Z_1 - Y_Z_0), label = "pate") 15 | 16 | pate_estimator <- declare_estimator(Y ~ Z, inquiry = pate, label = "test") 17 | 18 | my_measurement <- declare_measurement(Y = reveal_outcomes(Y ~ Z)) 19 | 20 | my_design <- my_population + 21 | my_potential_outcomes + 22 | pate + 23 | my_assignment + 24 | my_measurement + 25 | pate_estimator 26 | 27 | rm(list = ls()[-which(ls() %in% "my_design")]) 28 | diag <- diagnose_design(my_design, sims = 2, bootstrap_sims = 3) 29 | 30 | expect_equal(names(diag), c("simulations_df", "diagnosands_df", "diagnosand_names", "group_by_set", "parameters_df", "bootstrap_replicates", "bootstrap_sims", "duration")) 31 | expect_equal(nrow(diag$simulations_df), 2) 32 | expect_equal(nrow(diag$diagnosands_df), 1) 33 | expect_equal(nrow(diag$bootstrap_replicates), 3) 34 | }) 35 | -------------------------------------------------------------------------------- /tests/testthat/test-estimands.R: -------------------------------------------------------------------------------- 1 | context("Inquiries") 2 | 3 | df <- data.frame(Y_Z_0 = 1:10, Y_Z_1 = 3:12) 4 | 5 | test_that("splat labels", { 6 | ## default labeling 7 | my_inquiry <- declare_inquiry(ATE = mean(Y_Z_1 - Y_Z_0)) 8 | expect_identical( 9 | my_inquiry(df), 10 | structure(list(inquiry = "ATE", estimand = 2), .Names = c( 11 | "inquiry", 12 | "estimand" 13 | ), row.names = c(NA, -1L), class = "data.frame") 14 | ) 15 | expect_equal(attr(my_inquiry, "label"), "ATE") 16 | }) 17 | 18 | test_that("default label", { 19 | ## no label 20 | my_inquiry <- declare_inquiry(mean(Y_Z_1 - Y_Z_0)) 21 | expect_identical( 22 | my_inquiry(df), 23 | structure(list(inquiry = "inquiry", estimand = 2), .Names = c( 24 | "inquiry", 25 | "estimand" 26 | ), row.names = c(NA, -1L), class = "data.frame") 27 | ) 28 | expect_equal(attr(my_inquiry, "label"), "inquiry") 29 | }) 30 | 31 | test_that("manual label", { 32 | 33 | ## manual label 34 | my_inquiry <- declare_inquiry(mean(Y_Z_1 - Y_Z_0), label = "ATE2") 35 | 36 | expect_identical( 37 | my_inquiry(df), 38 | structure(list(inquiry = "ATE2", estimand = 2), .Names = c( 39 | "inquiry", 40 | "estimand" 41 | ), row.names = c(NA, -1L), class = "data.frame") 42 | ) 43 | expect_equal(attr(my_inquiry, "label"), "ATE2") 44 | }) 45 | 46 | test_that("custom inquiry has label", { 47 | ## custom inquiry function 48 | my_inquiry_function <- function(data, label) { 49 | with(data, data.frame(inquiry = label, estimand = median(Y_Z_1 - Y_Z_0), stringsAsFactors = TRUE)) 50 | } 51 | my_inquiry_custom <- declare_inquiry( 52 | handler = my_inquiry_function, label = "medianTE" 53 | ) 54 | 55 | expect_identical( 56 | my_inquiry_custom(df), 57 | structure(list( 58 | inquiry = structure(1L, .Label = "medianTE", class = "factor"), 59 | estimand = 2 60 | ), .Names = c("inquiry", "estimand"), row.names = c( 61 | NA, 62 | -1L 63 | ), class = "data.frame") 64 | ) 65 | expect_equal(attr(my_inquiry_custom, "label"), "medianTE") 66 | }) 67 | 68 | test_that("splat label overrides label", { 69 | my_inquiry <- declare_inquiry(SATT = mean(Y_Z_1 - Y_Z_0), label = "ATE") 70 | expect_equal( 71 | attributes(my_inquiry)$label, 72 | "SATT" 73 | ) 74 | }) 75 | 76 | 77 | test_that("multiple inquiry declarations work", { 78 | # splat label, should inherit 79 | sate <- declare_inquiry(SATE = mean(Y_Z_1 - Y_Z_0)) 80 | pate <- declare_inquiry(PATE = mean(Y_Z_1 - Y_Z_0)) 81 | 82 | design_1 <- declare_model(df) + pate + sate 83 | expect_identical( 84 | draw_estimands(design_1), 85 | structure(list(inquiry = c("PATE", "SATE"), estimand = c( 86 | 2, 87 | 2 88 | )), .Names = c("inquiry", "estimand"), row.names = c( 89 | NA, 90 | -2L 91 | ), class = "data.frame") 92 | ) 93 | }) 94 | 95 | test_that("multiple inquiry declarations work", { 96 | 97 | # Explicit label, should not inherit 98 | sate_label <- declare_inquiry(mean(Y_Z_1 - Y_Z_0), label = "The SATE") 99 | pate_label <- declare_inquiry(mean(Y_Z_1 - Y_Z_0), label = "The PATE") 100 | 101 | design_2 <- declare_model(df) + pate_label + sate_label 102 | 103 | expect_identical( 104 | draw_estimands(design_2), 105 | structure(list(inquiry = c("The PATE", "The SATE"), estimand = c( 106 | 2, 107 | 2 108 | )), .Names = c("inquiry", "estimand"), row.names = c( 109 | NA, 110 | -2L 111 | ), class = "data.frame") 112 | ) 113 | }) 114 | 115 | test_that("duplicated labels fail", { 116 | # This could eventually be fixed so that the inquiry object names are inherited 117 | # default labeling whatsoever 118 | sate_nolabel <- declare_inquiry(mean(Y_Z_1 - Y_Z_0)) 119 | pate_nolabel <- declare_inquiry(mean(Y_Z_1 - Y_Z_0)) 120 | 121 | expect_error({ 122 | design_3 <- declare_model(df) + pate_nolabel + sate_nolabel 123 | }) 124 | }) 125 | 126 | 127 | test_that("inquiries can use other inquiries in calculations", { 128 | prop_inquiry <- declare_inquiry(yz1.mu = mean(Y_Z_1), yz0.mu = mean(Y_Z_0), percent.diff = abs(yz1.mu - yz0.mu) / yz0.mu) 129 | 130 | expect_equal( 131 | prop_inquiry(df), 132 | structure(list(inquiry = c("yz1.mu", "yz0.mu", "percent.diff"), 133 | estimand = c(7.5, 5.5, 0.363636363636364)), 134 | class = "data.frame", row.names = c(NA, -3L)) 135 | ) 136 | }) 137 | -------------------------------------------------------------------------------- /tests/testthat/test-factorial.R: -------------------------------------------------------------------------------- 1 | context("Factorial Design") 2 | 3 | test_that("Factorial", { 4 | my_population <- declare_model(N = 2000, noise = rnorm(N)) 5 | 6 | my_potential_outcomes <- declare_potential_outcomes( 7 | Y_Z_T1 = noise, 8 | Y_Z_T2 = noise + 0.2, 9 | Y_Z_T3 = noise + 0.2, 10 | Y_Z_T4 = noise + 0.6 11 | ) 12 | 13 | my_assignment <- declare_assignment(Z = complete_ra(N, num_arms = 4)) 14 | 15 | my_inquiry <- declare_inquiry(interaction = mean(Y_Z_T4 - Y_Z_T3) - mean(Y_Z_T2 - Y_Z_T1)) 16 | 17 | my_estimator <- declare_estimator(Y ~ Z1 + Z2 + Z1 * Z2, 18 | .method = lm_robust, 19 | term = "Z1:Z2" 20 | ) 21 | 22 | my_measurement <- declare_measurement(Y = reveal_outcomes(Y ~ Z)) 23 | 24 | my_design <- 25 | my_population + 26 | my_potential_outcomes + 27 | my_inquiry + 28 | my_assignment + 29 | declare_step(dplyr::mutate, 30 | Z1 = as.numeric(Z %in% c("T2", "T4")), 31 | Z2 = as.numeric(Z %in% c("T3", "T4")) 32 | ) + 33 | my_measurement + 34 | my_estimator 35 | 36 | expect_equal(my_design %>% draw_data() %>% nrow(), 2000) 37 | expect_equal(my_design %>% run_design() %>% names(), c("inquiry", "estimand", "estimator", "term", "estimate", 38 | "std.error", "statistic", "p.value", "conf.low", "conf.high", 39 | "df", "outcome")) 40 | 41 | diagnosis <- diagnose_design(my_design, sims = 2, bootstrap_sims = FALSE) 42 | 43 | expect_equal(diagnosis %>% get_simulations %>% dim, c(2, 14)) 44 | 45 | expect_equal(diagnosis %>% get_diagnosands %>% dim, c(1, 13)) 46 | 47 | }) 48 | -------------------------------------------------------------------------------- /tests/testthat/test-get-star.R: -------------------------------------------------------------------------------- 1 | 2 | 3 | context("get_ functions") 4 | 5 | population <- declare_model(N = 100, u = rnorm(N)) 6 | potential_outcomes <- declare_model(Y_Z_0 = 0, 7 | Y_Z_1 = 1 + u) 8 | inquiry <- declare_inquiry(ATE = mean(Y_Z_1 - Y_Z_0)) 9 | sampling <- declare_sampling(S = complete_rs(N, n = 75)) 10 | assignment <- declare_assignment(Z = complete_ra(N, m = 50)) 11 | measurement <- declare_measurement(Y = reveal_outcomes(Y ~ Z)) 12 | estimator <- declare_estimator(Y ~ Z, inquiry = inquiry) 13 | design <- 14 | population + potential_outcomes + inquiry + sampling + assignment + measurement + estimator 15 | 16 | dat <- draw_data(design) 17 | dat$Z <- NULL 18 | 19 | test_that("error when send list of designs to draw_data", { 20 | 21 | expect_error(draw_data(list(design, design)), "Please send a single design object to the design argument, typically created using the \\+ operator.") 22 | 23 | }) 24 | -------------------------------------------------------------------------------- /tests/testthat/test-labels.R: -------------------------------------------------------------------------------- 1 | context("general label issues") 2 | 3 | test_that("error if more than one label is sent to any step", { 4 | 5 | expect_error(declare_model( 6 | N = 5, 7 | label = c("lbl1", "lbl2")), "Please provide only one label.") 8 | 9 | expect_error(declare_potential_outcomes( 10 | Y ~ Z, 11 | label = c("lbl1", "lbl2")), "Please provide only one label.") 12 | 13 | expect_error(declare_sampling( 14 | n = 10, 15 | label = c("lbl1", "lbl2")), "Please provide only one label.") 16 | 17 | expect_error(declare_assignment( 18 | Z = complete_ra(N, m = 10), 19 | label = c("lbl1", "lbl2")), "Please provide only one label.") 20 | 21 | expect_error(declare_reveal( 22 | label = c("lbl1", "lbl2")), "Please provide only one label.") 23 | 24 | expect_error(declare_estimator( 25 | Y ~ A + B, 26 | .method = lm_robust, 27 | label = c("lbl1", "lbl2")), "Please provide only one label.") 28 | 29 | expect_error(declare_inquiry( 30 | mean(Y), 31 | label = c("lbl1", "lbl2")), "Please provide only one label.") 32 | 33 | expect_error(declare_diagnosands( 34 | mean(Y), 35 | label = c("lbl1", "lbl2")), "Please provide only one label.") 36 | 37 | }) 38 | -------------------------------------------------------------------------------- /tests/testthat/test-measurement.R: -------------------------------------------------------------------------------- 1 | context("Measurement") 2 | 3 | # This test is lightweight because it's just fabricate 4 | 5 | test_that("declare_measurement works", { 6 | design <- 7 | declare_model(N = 10, latent = seq(0, 1, length.out = N)) + 8 | declare_measurement(observed = as.numeric(cut(latent, breaks = seq(0, 1, length.out = 6), include.lowest = TRUE))) 9 | 10 | 11 | 12 | 13 | A <- 14 | structure( 15 | list( 16 | ID = c("01", "02", "03", "04", "05", "06", "07", 17 | "08", "09", "10"), 18 | latent = c( 19 | 0, 20 | 0.111111111111111, 21 | 0.222222222222222, 22 | 0.333333333333333, 23 | 0.444444444444444, 24 | 0.555555555555556, 25 | 0.666666666666667, 26 | 0.777777777777778, 27 | 0.888888888888889, 28 | 1 29 | ), 30 | observed = c(1, 1, 31 | 2, 2, 3, 3, 4, 4, 5, 5) 32 | ), 33 | class = "data.frame", 34 | row.names = c(NA, 35 | 10L) 36 | ) 37 | 38 | 39 | expect_equal(A, draw_data(design)) 40 | 41 | 42 | }) 43 | 44 | 45 | 46 | -------------------------------------------------------------------------------- /tests/testthat/test-modify-design.R: -------------------------------------------------------------------------------- 1 | context("modify design") 2 | 3 | test_that("test modify declare design ", { 4 | library(dplyr) 5 | N <- 500 6 | 7 | my_population <- declare_model(N = N, noise = rnorm(N)) 8 | 9 | my_potential_outcomes <- declare_potential_outcomes(Y_Z_0 = noise, Y_Z_1 = noise + rnorm(N, mean = 2, sd = 2)) 10 | 11 | my_assignment <- declare_assignment(Z = complete_ra(N, m = 25), label = "a_label") 12 | 13 | design <- my_population + 14 | my_potential_outcomes + 15 | declare_step(dplyr::mutate, q = 5) + 16 | my_assignment 17 | 18 | my_assignment_2 <- declare_assignment(Z2 = complete_ra(N, m = 25)) 19 | 20 | expect_length(replace_step(design, new_step = my_assignment_2, step = my_assignment), 4) 21 | expect_length(replace_step(design, new_step = my_assignment_2, step = 4), 4) 22 | expect_length(replace_step(design, new_step = my_assignment_2, step = "a_label"), 4) 23 | 24 | redesigned <- replace_step(design, new_step = my_assignment_2, step = my_assignment) 25 | 26 | expect_equal(names(redesigned), c("my_population", "my_potential_outcomes", "custom", "my_assignment_2")) 27 | 28 | expect_length(insert_step(design, declare_step(mutate, blah = 6), before = my_potential_outcomes), 5) 29 | 30 | expect_length(insert_step(design, declare_step(mutate, blah = 6), after = my_potential_outcomes), 5) 31 | 32 | expect_length(replace_step(design, declare_step(mutate, blah = 10), step = my_population), 4) 33 | 34 | expect_length(delete_step(design, 3), 3) 35 | }) 36 | 37 | 38 | 39 | test_that("placement doesn't matter", { 40 | my_population <- 41 | declare_model( 42 | N = 100, 43 | noise = rnorm(N), 44 | label = "mypop" 45 | ) 46 | 47 | my_potential_outcomes <- 48 | declare_model( 49 | Y_Z_0 = noise, 50 | Y_Z_1 = noise + rnorm(N, mean = 2, sd = 2) 51 | ) 52 | 53 | my_assignment <- declare_assignment(Z = complete_ra(N, m = 50)) 54 | my_assignment_2 <- declare_assignment(Z = complete_ra(N, m = 25)) 55 | 56 | design <- my_population + my_potential_outcomes + my_assignment 57 | 58 | expect_length(insert_step(design, declare_step(mutate, income = noise^2), after = my_assignment), 4) 59 | expect_length(insert_step(design, declare_step(mutate, income = noise^2), before = my_assignment), 4) 60 | 61 | expect_length(insert_step(design, declare_step(mutate, income = noise^2), before = "mypop"), 4) 62 | 63 | expect_error(insert_step(design, declare_step(mutate, income = noise^2), before = "notfound")) 64 | expect_error(insert_step(design, declare_step(mutate, income = noise^2))) 65 | }) 66 | 67 | 68 | test_that("names are correct", { 69 | my_population <- declare_model(N = 100, noise = rnorm(N)) 70 | 71 | my_potential_outcomes <- declare_model(Y_Z_0 = noise, Y_Z_1 = noise + rnorm(N, mean = 2, sd = 2)) 72 | 73 | my_assignment <- declare_assignment(Z = complete_ra(N, m = 25), label = "a_label") 74 | 75 | design <- my_population + 76 | my_potential_outcomes + 77 | my_assignment + 78 | declare_measurement(Y = reveal_outcomes(Y ~ Z)) 79 | 80 | 81 | processing <- declare_step(handler = fabricate, q = 5) 82 | 83 | linear <- declare_estimator(Y ~ Z, 84 | .method = lm_robust, 85 | label = "linear" 86 | ) 87 | 88 | saturated <- declare_estimator(Y ~ Z, label = "saturated", .method = lm_robust) 89 | 90 | neighbors_design <- insert_step(design, after = 3, processing) 91 | 92 | expect_equal( 93 | names(neighbors_design), 94 | c("my_population", "my_potential_outcomes", "a_label", "processing", "measurement") 95 | ) 96 | 97 | check0 <- neighbors_design + linear 98 | check1 <- neighbors_design + saturated 99 | check2 <- neighbors_design + linear + saturated 100 | 101 | expect_equal( 102 | names(check0), 103 | c( 104 | "my_population", "my_potential_outcomes", "a_label", "processing", 105 | "measurement", "linear" 106 | ) 107 | ) 108 | 109 | expect_equal( 110 | names(check1), 111 | c( 112 | "my_population", "my_potential_outcomes", "a_label", "processing", 113 | "measurement", "saturated" 114 | ) 115 | ) 116 | expect_equal( 117 | names(check2), 118 | c( 119 | "my_population", "my_potential_outcomes", "a_label", "processing", 120 | "measurement", "linear", "saturated" 121 | ) 122 | ) 123 | }) 124 | -------------------------------------------------------------------------------- /tests/testthat/test-multiple-coefficients.R: -------------------------------------------------------------------------------- 1 | context("Multiple Coefficients") 2 | 3 | 4 | test_that("Multiple Coefficients", { 5 | alpha <- 1 6 | beta <- 3 7 | 8 | my_pop <- declare_model( 9 | N = 30, 10 | noise = rnorm(N, mean = 0, sd = 1), 11 | X = 1:N, 12 | Y = alpha + beta * X + noise 13 | ) 14 | 15 | theta <- declare_inquiry( 16 | `(Intercept)` = alpha, 17 | X = beta, 18 | term = TRUE 19 | ) 20 | 21 | OLS <- declare_estimator(Y ~ X, 22 | .method = lm, 23 | inquiry = theta, 24 | term = TRUE 25 | ) 26 | 27 | my_design <- my_pop + theta + OLS 28 | diagnosis <- diagnose_design(my_design, sims = 2, bootstrap_sims = FALSE) 29 | 30 | expect_equal(diagnosis %>% get_simulations %>% dim, c(4, 12)) 31 | 32 | expect_equal(diagnosis %>% get_diagnosands %>% dim, c(2, 12)) 33 | }) 34 | -------------------------------------------------------------------------------- /tests/testthat/test-multiple-estimands-one-estimator.R: -------------------------------------------------------------------------------- 1 | context("Multiple inquiries can be mapped to one estimator") 2 | 3 | 4 | test_that("Multiple inquiries can be mapped to one estimator", { 5 | pop_var <- function(x) { 6 | mean((x - mean(x))^2) 7 | } 8 | 9 | x <- rnorm(100) 10 | dat <- data.frame(X = x) 11 | sx <- sum((dat$X - mean(dat$X))^2) 12 | 13 | 14 | 15 | simp_pop <- declare_model( 16 | epsilon = rnorm(N, sd = 2), 17 | Y = X + epsilon 18 | ) 19 | 20 | dgp_se <- declare_inquiry(dgp_se = 2 / sqrt(sx)) 21 | obs_se <- declare_inquiry(obs_se = sqrt(pop_var(epsilon) / sqrt(sx))) 22 | 23 | lmc <- declare_estimator( 24 | Y ~ X, 25 | .method = estimatr::lm_robust, 26 | se_type = "classical", 27 | inquiry = c(dgp_se, obs_se), 28 | term = "X" 29 | ) 30 | 31 | des <- 32 | declare_model(dat) + 33 | simp_pop + 34 | dgp_se + 35 | obs_se + 36 | lmc 37 | 38 | my_dig <- declare_diagnosands( 39 | bias_se = mean(std.error - estimand), 40 | bias_est = mean(std.error - sd(estimand)), 41 | mean_se = mean(std.error), 42 | sd_se = sd(std.error), 43 | mean_estimand = mean(estimand), 44 | sd_inquiry = sd(estimand) 45 | ) 46 | 47 | diag <- diagnose_design(des, sims = 2, diagnosands = my_dig, bootstrap_sims = FALSE) 48 | 49 | expect_equal(nrow(get_diagnosands(diag)), 2) 50 | expect_true(!any(is.na(get_diagnosands(diag)$bias_se))) 51 | }) 52 | 53 | 54 | test_that("More multiple inquiries", { 55 | my_smp_fun <- function(data) { 56 | S <- rbinom(n = nrow(data), size = 1, prob = pnorm(data$noise)) 57 | return(data[S == 1, , drop = FALSE]) 58 | } 59 | 60 | 61 | pop <- declare_model(N = 100, noise = rnorm(N)) 62 | pos <- declare_potential_outcomes(Y ~ Z * noise) 63 | pate <- declare_inquiry(pate = mean(Y_Z_1 - Y_Z_0)) 64 | smp <- declare_sampling(handler = my_smp_fun) 65 | sate <- declare_inquiry(sate = mean(Y_Z_1 - Y_Z_0)) 66 | assgn <- declare_assignment(Z = complete_ra(N, m = 10)) 67 | my_measurement <- declare_measurement(Y = reveal_outcomes(Y ~ Z)) 68 | mator_both <- declare_estimator(Y ~ Z, inquiry = c(pate, sate)) 69 | 70 | 71 | 72 | des <- pop + pos + pate + smp + sate + assgn + my_measurement + mator_both 73 | expect_equal(draw_estimates(des)$inquiry, c("pate", "sate")) 74 | }) 75 | 76 | -------------------------------------------------------------------------------- /tests/testthat/test-multiple-estimators.R: -------------------------------------------------------------------------------- 1 | context("Multiple estimators") 2 | 3 | test_that("Two estimators, Two inquiries (matched)", { 4 | des <- 5 | declare_model(sleep) + 6 | declare_inquiry( 7 | CATE_1_5 = mean(extra[group == 2]) - mean(extra[group == 1]), 8 | subset = ID %in% 1:5 9 | ) + 10 | declare_inquiry( 11 | CATE_6_10 = mean(extra[group == 2]) - mean(extra[group == 1]), 12 | subset = ID %in% 6:10 13 | ) + 14 | declare_step(fabricate, extra = extra + rnorm(N)) + 15 | declare_estimator( 16 | extra ~ group, 17 | subset = ID %in% 1:5, 18 | .method = difference_in_means, 19 | inquiry = "CATE_1_5", 20 | label = "DIM_1_5", 21 | term = "group2" 22 | ) + 23 | declare_estimator( 24 | extra ~ group, 25 | subset = ID %in% 6:10, 26 | .method = difference_in_means, 27 | inquiry = "CATE_6_10", 28 | label = "DIM_6_10", 29 | term = "group2" 30 | ) 31 | 32 | diag <- diagnose_design(des, sims = 5, bootstrap_sims = FALSE) 33 | expect_equal(nrow(diag$diagnosands), 2) 34 | }) 35 | 36 | 37 | test_that("Two estimators, Two inquiries (crossed)", { 38 | des <- 39 | declare_model(sleep) + 40 | # Make a noisier outcome 41 | declare_potential_outcomes(extra1 ~ extra + 2 * (Z == 1) + rnorm(length(extra))) + 42 | 43 | declare_inquiry(ATE = mean(extra1_Z_1) - mean(extra1_Z_0)) + 44 | declare_inquiry(ATT = mean(extra1_Z_1) - mean(extra1_Z_0), subset = group == 2) + 45 | 46 | declare_assignment(Z = complete_ra(N, prob = 0.5)) + 47 | declare_measurement(extra1 = reveal_outcomes(extra1 ~ Z)) + 48 | 49 | declare_estimator(extra1 ~ Z, .method = difference_in_means, inquiry = c("ATE", "ATT"), label = "DIM") + 50 | declare_estimator(extra1 ~ Z + group, .method = lm_robust, clusters = ID, inquiry = c("ATE", "ATT"), label = "OLS + control") 51 | 52 | diag <- diagnose_design(des, sims = 5, bootstrap_sims = FALSE) 53 | expect_equal(nrow(diag$diagnosands), 4) 54 | }) 55 | 56 | -------------------------------------------------------------------------------- /tests/testthat/test-multiple-pos.R: -------------------------------------------------------------------------------- 1 | context("Multiple POs") 2 | 3 | test_that("multiple potential outcomes", { 4 | my_population <- declare_model( 5 | N = 100, income = rnorm(N), age = sample(18:95, N, replace = T) 6 | ) 7 | 8 | my_potential_outcomes_Y <- declare_potential_outcomes( 9 | formula = Y ~ .25 * Z + .01 * age * Z 10 | ) 11 | 12 | my_potential_outcomes_attrition <- declare_potential_outcomes( 13 | formula = R ~ rbinom(n = N, size = 1, prob = pnorm(Y_Z_0)) 14 | ) 15 | 16 | my_assignment <- declare_assignment(Z = complete_ra(N, m = 25)) 17 | 18 | my_design <- my_population + 19 | my_potential_outcomes_Y + 20 | my_potential_outcomes_attrition + 21 | my_assignment + 22 | declare_reveal(outcome_variable = "R", assignment_variable = "Z") + 23 | declare_reveal(outcome_variable = "Y", assignment_variable = "Z") 24 | 25 | expect_true(all( 26 | c("R", "Y") %in% colnames(draw_data(my_design)) 27 | )) 28 | }) 29 | -------------------------------------------------------------------------------- /tests/testthat/test-name-steps.R: -------------------------------------------------------------------------------- 1 | 2 | 3 | context("naming steps") 4 | 5 | test_that("design steps are named appropriately when blank", { 6 | pop <- declare_model(N = 25) 7 | des <- pop + declare_model(N = 50) 8 | expect_equal(names(des), c("pop", "model")) 9 | 10 | smp <- declare_sampling(S = complete_rs(N, n = 25)) 11 | des <- declare_model(N = 50) + smp 12 | expect_equal(names(des), c("model", "smp")) 13 | 14 | des <- 15 | declare_model(N = 50) + 16 | declare_model(Y_Z_0 = rnorm(N), Y_Z_1 = Y_Z_0 + 1) + 17 | declare_inquiry(mean(Y_Z_1 - Y_Z_0)) + 18 | declare_sampling(S = complete_rs(N, n = 25)) + 19 | declare_assignment(Z = complete_ra(N, m = 10)) + 20 | declare_measurement(Y = reveal_outcomes(Y ~ Z)) + 21 | declare_estimator(Y ~ Z) 22 | expect_equal( 23 | names(des), 24 | c( 25 | "model", 26 | "model_1", 27 | "inquiry", 28 | "sampling", 29 | "assignment", 30 | "measurement", 31 | "estimator" 32 | ) 33 | ) 34 | }) 35 | -------------------------------------------------------------------------------- /tests/testthat/test-names-and-labels.R: -------------------------------------------------------------------------------- 1 | context("Names and Labels") 2 | 3 | 4 | test_that("inquiry labels work", { 5 | my_private_estimator <- function(data) { 6 | data.frame(estimate = median(data$Y)^2) 7 | } 8 | pop <- declare_model(N = 6, Y = rnorm(N)) 9 | 10 | # Unmarked case 11 | inquiry <- declare_inquiry(mean(Y)) 12 | estimator <- declare_estimator(inquiry = inquiry, handler = label_estimator(my_private_estimator)) 13 | design <- pop + inquiry + estimator 14 | names(design) 15 | diagnosis <- diagnose_design(design, sims = 10, bootstrap_sims = FALSE) 16 | 17 | expect_true(all(diagnosis$simulations_df$inquiry == "inquiry")) 18 | 19 | # declare_inquiry(b = 2) --> Label is b 20 | inquiry_2 <- declare_inquiry(some_stat = mean(Y)) 21 | mator_2 <- declare_estimator(inquiry = inquiry_2, handler = label_estimator(my_private_estimator)) 22 | design <- pop + inquiry_2 + mator_2 23 | names(design) 24 | diagnosis <- diagnose_design(design, sims = 10, bootstrap_sims = FALSE) 25 | diagnosis$simulations_df 26 | expect_true(all(diagnosis$simulations_df$inquiry == "some_stat")) 27 | 28 | # declare_inquiry(2, label = "b") --> Label is b 29 | inquiry_3 <- declare_inquiry(mean(Y), label = "a_label") 30 | mator_3 <- declare_estimator(inquiry = inquiry_3, handler = label_estimator(my_private_estimator)) 31 | design <- pop + inquiry_3 + mator_3 32 | names(design) 33 | diagnosis <- diagnose_design(design, sims = 10, bootstrap_sims = FALSE) 34 | diagnosis$simulations_df 35 | expect_true(all(diagnosis$simulations_df$inquiry == "a_label")) 36 | 37 | # declare_inquiry(a = 2, label = "b") --> Label is b 38 | inquiry_4 <- declare_inquiry(some_stat = mean(Y), label = "a_label") 39 | mator_4 <- declare_estimator(inquiry = inquiry_4, handler = label_estimator(my_private_estimator)) 40 | design <- pop + inquiry_4 + mator_4 41 | names(design) 42 | diagnosis <- diagnose_design(design, sims = 10, bootstrap_sims = FALSE) 43 | diagnosis$simulations_df 44 | expect_true(all(diagnosis$simulations_df$inquiry == "some_stat")) 45 | }) 46 | 47 | test_that("multiple inquiries", { 48 | pop <- declare_model(N = 6, Y = rnorm(N)) 49 | inquiry <- declare_inquiry(a1 = 1, a2 = 2, a3 = 3, label = "b") 50 | design <- pop + inquiry 51 | 52 | diagnosis <- diagnose_design(design, sims = 5, bootstrap_sims = FALSE) 53 | expect_true(all(diagnosis$diagnosands_df$inquiry %in% c("a1", "a2", "a3"))) 54 | }) 55 | 56 | 57 | test_that("label conflicts", { 58 | pop <- declare_model(N = 6, Y = rnorm(N)) 59 | inquiry_1 <- declare_inquiry(some_stat = mean(Y)) 60 | inquiry_2 <- declare_inquiry(some_stat = median(Y)) 61 | expect_error(design <- pop + inquiry_1 + inquiry_2) 62 | 63 | expect_error(inquiry_1 <- declare_inquiry(some_stat = mean(Y), some_stat = median(Y))) 64 | }) 65 | 66 | 67 | 68 | test_that("step name conflicts in design", { 69 | pop <- declare_model(N = 6, Y = rnorm(N)) 70 | assign_1 <- declare_assignment(Z = complete_ra(N, m = 2)) 71 | inquiry_1 <- declare_inquiry(some_stat = mean(Y)) 72 | expect_error(design <- pop + inquiry_1 + inquiry_1, "You have inquiries with identical labels: some_stat\nPlease provide inquiries with unique labels") 73 | expect_equal(names(pop + assign_1 + assign_1), c("pop", "assign_1", "assign_1_1")) 74 | }) 75 | -------------------------------------------------------------------------------- /tests/testthat/test-noncompliance.R: -------------------------------------------------------------------------------- 1 | context("Noncompliance") 2 | 3 | test_that("Noncompliance", { 4 | skip_if_not_installed("AER") 5 | 6 | my_population <- declare_model(N = 100, noise = rnorm(N)) 7 | 8 | POS_Y <- declare_model(Y_D_0 = noise, Y_D_1 = Y_D_0 + 2) 9 | POS_Z <- declare_model( 10 | D_Z_0 = rbinom(n = N, size = 1, prob = pnorm(noise - 1)), 11 | D_Z_1 = rbinom(n = N, size = 1, prob = pnorm(noise + 1)) 12 | ) 13 | 14 | my_assignment <- declare_assignment(Z = complete_ra(N, m = 50)) 15 | 16 | CACE <- declare_inquiry(CACE = mean(Y_D_1[complier == 1] - Y_D_0[complier == 1])) 17 | ITT_d <- declare_inquiry(ITT_d = mean(complier)) 18 | 19 | cace_estimator <- function(data, alpha = 0.05) { 20 | fit <- AER::ivreg(Y ~ D | Z, data = data) 21 | N <- nrow(data) 22 | k <- 2 23 | df <- N - k 24 | 25 | coef <- coef(fit) 26 | std.error <- sqrt(diag(vcov(fit))) 27 | 28 | p.value <- 2 * pt(abs(coef), df = df, lower.tail = FALSE) 29 | conf.low <- coef - qt(1 - alpha / 2, df = df) * std.error 30 | conf.high <- coef + qt(1 - alpha / 2, df = df) * std.error 31 | 32 | return_frame <- 33 | data.frame( 34 | variable_names = names(coef), 35 | estimate = coef, 36 | std.error = std.error, 37 | p.value = p.value, 38 | conf.low = conf.low, 39 | conf.high = conf.high 40 | ) 41 | return_frame[return_frame$variable_names == "D", ] 42 | } 43 | 44 | cace_hat <- declare_estimator(handler = label_estimator(cace_estimator), inquiry = CACE, label = "CACE_hat") 45 | 46 | design <- my_population + 47 | POS_Y + 48 | POS_Z + 49 | declare_step(fabricate, complier = as.numeric(D_Z_0 == 0 & D_Z_1 == 1)) + 50 | ITT_d + 51 | CACE + 52 | my_assignment + 53 | declare_measurement(D = reveal_outcomes(D ~ Z)) + 54 | declare_measurement(Y = reveal_outcomes(Y ~ D)) + 55 | cace_hat 56 | 57 | df <- draw_data(design) 58 | expect_true("complier" %in% colnames(df)) 59 | 60 | diag <- diagnose_design(design, sims = 2, bootstrap_sims = FALSE) 61 | 62 | expect_equal(diag$diagnosands$mean_estimand[1], 2) 63 | expect_equal(diag$diagnosands$estimator[1], "CACE_hat") 64 | # ITT_d is not in output - not estimated: AC: NOW IT IS! 65 | }) 66 | 67 | test_that("POs correctly assembled for noncompliance case", { 68 | pop <- declare_model( 69 | N = 10000, 70 | type = sample( 71 | c("Complier", "Never-taker", "Always-taker"), 72 | size = N, 73 | prob = c(0.5, 0.2, 0.3), 74 | replace = TRUE 75 | ), 76 | noise = rnorm(N) 77 | ) 78 | 79 | df <- pop() 80 | 81 | pos_D <- declare_potential_outcomes(D ~ as.numeric(type == "Always-taker" | type == "Complier" & Z == 1)) 82 | 83 | 84 | expect_equal(colnames(pos_D(df)), c("ID", "type", "noise", "D_Z_0", "D_Z_1")) 85 | 86 | pos_Y <- declare_potential_outcomes( 87 | Y ~ 0.4 * D * (type == "Complier") - 0.2 * (type == "Never-taker") + 88 | 0.5 * (type == "Always-taker") + 89 | noise, 90 | assignment_variables = "D" 91 | ) 92 | 93 | assignment <- declare_assignment(Z = complete_ra(N, prob = 0.5)) 94 | 95 | noncompliance <- 96 | pop + 97 | pos_D + 98 | assignment + 99 | declare_measurement(D = reveal_outcomes(D ~ Z)) + 100 | pos_Y + 101 | declare_measurement(Y = reveal_outcomes(Y ~ D)) 102 | 103 | e <- (noncompliance[[4]]) 104 | 105 | expect_true(inherits(e, "design_step")) 106 | expect_equal(attr(e, "step_type"), "measurement") 107 | }) 108 | 109 | 110 | test_that("POS don't erase Z", { 111 | pop <- declare_model(N = 10, Z = rbinom(N, size = 1, prob = .5)) 112 | po <- declare_potential_outcomes(Y ~ Z) 113 | df <- pop() 114 | expect_equal(df$Z, po(df)$Z) 115 | }) 116 | -------------------------------------------------------------------------------- /tests/testthat/test-paper.R: -------------------------------------------------------------------------------- 1 | context("Checking Code in Paper Works") 2 | 3 | # “Characterizing Research Designs in Code" ------------------------------- 4 | 5 | test_that("section on 'Characterizing Research Designs in Code' works", { 6 | my_population <- function(N) { 7 | data.frame(u = rnorm(N)) 8 | } 9 | 10 | population <- 11 | declare_model(handler = my_population, N = 500) 12 | 13 | my_sampling <- function(data) { 14 | data$S <- rbinom( 15 | n = nrow(data), 16 | size = 1, 17 | prob = 0.1 18 | ) 19 | data <- data[data$S == 1, ] 20 | data$S <- NULL 21 | data 22 | } 23 | 24 | sampling <- declare_sampling(handler = my_sampling) 25 | 26 | my_assignment <- function(data) { 27 | data$Z <- rbinom( 28 | n = nrow(data), 29 | size = 1, 30 | prob = 0.5 31 | ) 32 | data 33 | } 34 | 35 | assignment <- 36 | declare_assignment(handler = my_assignment) 37 | 38 | my_potential_outcomes <- 39 | function(data) { 40 | data$Y_Z_0 <- with(data, u) 41 | data$Y_Z_1 <- with(data, 0.25 + u) 42 | data 43 | } 44 | 45 | potential_outcomes <- declare_potential_outcomes( 46 | handler = my_potential_outcomes 47 | ) 48 | 49 | my_inquiry <- function(data) { 50 | with( 51 | data, 52 | data.frame(inquiry = "inquiry", estimand = mean(Y_Z_1 - Y_Z_0), stringsAsFactors = FALSE) 53 | ) 54 | } 55 | 56 | inquiry <- declare_inquiry(handler = my_inquiry) 57 | 58 | my_estimator <- function(data) { 59 | reg <- lm(Y ~ Z, data = data) 60 | phi <- t(data.frame(summary(reg)$coefficients["Z", ])) 61 | colnames(phi) <- c("estimate", "std.error", "t", "p.value") 62 | phi 63 | } 64 | 65 | estimator <- declare_estimator(handler = label_estimator(my_estimator), inquiry = inquiry) 66 | 67 | diagnosand <- declare_diagnosands(bias = mean(estimate - estimand), keep_defaults = FALSE) 68 | 69 | measurement <- declare_measurement(Y = reveal_outcomes(Y ~ Z)) 70 | 71 | design <- 72 | population + 73 | sampling + 74 | assignment + 75 | potential_outcomes + 76 | inquiry + 77 | measurement + 78 | estimator 79 | 80 | df <- draw_data(design) 81 | 82 | expect_equal(colnames(df), c("u", "Z", "Y_Z_0", "Y_Z_1", "Y")) 83 | 84 | run_design(design) 85 | 86 | diagnose_design( 87 | design = design, 88 | diagnosands = diagnosand, 89 | sims = 2, bootstrap_sims = FALSE 90 | ) 91 | }) 92 | -------------------------------------------------------------------------------- /tests/testthat/test-plus.R: -------------------------------------------------------------------------------- 1 | context("plus operator") 2 | 3 | test_that("plus works", { 4 | my_population <- declare_model(N = 500, noise = rnorm(N)) 5 | my_potential_outcomes <- declare_potential_outcomes(Y_Z_0 = noise, Y_Z_1 = noise + rnorm(N, mean = 2, sd = 2)) 6 | my_sampling <- declare_sampling(S = complete_rs(N, n = 250)) 7 | my_assignment <- declare_assignment(Z = complete_ra(N, m = 25)) 8 | my_inquiry <- declare_inquiry(ATE = mean(Y_Z_1 - Y_Z_0)) 9 | my_estimator <- declare_estimator(Y ~ Z, inquiry = my_inquiry) 10 | my_measurement <- declare_measurement(Y = reveal_outcomes(Y ~ Z)) 11 | 12 | design <- my_population + my_potential_outcomes + my_sampling + my_inquiry + my_assignment + my_measurement + my_estimator 13 | expect_length(design, 7) 14 | }) 15 | 16 | 17 | 18 | 19 | test_that("more plus", { 20 | U <- declare_model(N = 10, noise = rnorm(N)) 21 | Y <- declare_potential_outcomes(Y ~ Z + noise) 22 | Z <- declare_assignment(Z = complete_ra(N, prob = 0.5)) 23 | R <- declare_measurement(Y = reveal_outcomes(Y ~ Z)) 24 | 25 | # doesn't 26 | # expect_warning(des <- U + Y + Z + R) 27 | 28 | des <- U + Y + Z + R 29 | expect_null(attr(des[[4]], "label")) 30 | }) 31 | -------------------------------------------------------------------------------- /tests/testthat/test-print-code.R: -------------------------------------------------------------------------------- 1 | context("print") 2 | 3 | N <- 500 4 | 5 | my_population <- declare_model(N = N, noise = rnorm(N)) 6 | 7 | my_potential_outcomes <- declare_potential_outcomes(Y_Z_0 = noise, Y_Z_1 = noise + rnorm(N, mean = 2, sd = 2)) 8 | 9 | my_sampling <- declare_sampling(S = complete_rs(N, n = 250)) 10 | 11 | my_assignment <- declare_assignment(Z = complete_ra(N, m = 25)) 12 | 13 | my_inquiry <- declare_inquiry(ATE = mean(Y_Z_1 - Y_Z_0)) 14 | 15 | my_estimator <- declare_estimator(Y ~ Z, inquiry = my_inquiry) 16 | 17 | my_measurement <- declare_measurement(Y = reveal_outcomes(Y ~ Z)) 18 | 19 | design <- my_population + 20 | my_potential_outcomes + 21 | my_sampling + 22 | my_inquiry + 23 | declare_step(dplyr::mutate, q = 5) + 24 | declare_step(dplyr::mutate, q = 6) + 25 | my_assignment + 26 | my_measurement + 27 | my_estimator 28 | 29 | test_that("print code works", { 30 | expect_output(print_code(design), "my_population <- declare") 31 | 32 | attr(design, "code") <- "code" 33 | 34 | expect_output(print_code(design), "code") 35 | }) 36 | 37 | 38 | # test_that("print full design", { 39 | # 40 | # expect_equal(capture.output(print_code(design)), 41 | # c("my_population <- declare_model(N = N, noise = rnorm(N)) ", 42 | # "", "my_potential_outcomes <- declare_potential_outcomes(Y_Z_0 = noise, Y_Z_1 = noise + rnorm(N, mean = 2, sd = 2)) ", 43 | # "", "my_sampling <- declare_sampling(S = complete_rs(N, n = 250)) ", "", "my_inquiry <- declare_inquiry(ATE = mean(Y_Z_1 - Y_Z_0)) ", 44 | # "", "my_assignment <- declare_assignment(Z = complete_ra(N, m = 25)) ", "", "my_measurement <- declare_measurement(Y = reveal_outcomes(Y ~ Z)", 45 | # "", "my_estimator <- declare_estimator(Y ~ Z, inquiry = my_inquiry) ", 46 | # "", "my_design <- my_population + my_potential_outcomes + my_sampling + my_inquiry + dplyr::mutate(q = 5) + dplyr::mutate(q = 6) + my_assignment + my_reveal + my_estimator) ", 47 | # "")) 48 | # 49 | # }) 50 | 51 | test_that("print a step", { 52 | expect_equal(capture.output(print(my_measurement)), "declare_measurement(Y = reveal_outcomes(Y ~ Z))") 53 | }) 54 | -------------------------------------------------------------------------------- /tests/testthat/test-redesign.R: -------------------------------------------------------------------------------- 1 | context("redesign") 2 | 3 | test_that("N not changed", { 4 | N <- 100 5 | d <- declare_model(N = N) + NULL 6 | expect_equal(N, 100) 7 | 8 | expect_length(draw_data(d)$ID, 100) 9 | 10 | others <- c(50, 100, 200, 100) 11 | d_alt <- redesign(d, N = others) 12 | 13 | for (i in seq_along(others)) { 14 | expect_length(draw_data(d_alt[[i]])$ID, others[i]) 15 | } 16 | 17 | # N itself should not be changed 18 | expect_equal(N, 100) 19 | }) 20 | -------------------------------------------------------------------------------- /tests/testthat/test-run-design.R: -------------------------------------------------------------------------------- 1 | 2 | 3 | test_that("run design errors if you don't send a design object", { 4 | 5 | expect_error(run_design(6)) 6 | 7 | }) 8 | -------------------------------------------------------------------------------- /tests/testthat/test-save-reload-redesign.R: -------------------------------------------------------------------------------- 1 | context("Save-Reload-Redesign") 2 | 3 | test_that("Save Reload Redesign works", { 4 | N <- 100 5 | d <- declare_model(N = N, foo = rnorm(N)) + declare_inquiry(d = mean(foo)) 6 | f <- tempfile() 7 | 8 | suppressWarnings( 9 | saveRDS(d, f) 10 | ) 11 | 12 | rm(d, N) 13 | 14 | suppressWarnings( 15 | d <- readRDS(f) 16 | ) 17 | 18 | expect_true(is.data.frame(draw_data(d))) 19 | 20 | d2 <- redesign(d, N = 20) 21 | 22 | expect_true(is.data.frame(draw_data(d2))) 23 | }) 24 | -------------------------------------------------------------------------------- /tests/testthat/test-scaffolding.R: -------------------------------------------------------------------------------- 1 | context("Internal declaration scaffolding") 2 | 3 | test_that("make declarations correctly", { 4 | noop_handler <- function(data) data 5 | i <<- 0 6 | validation_fn(noop_handler) <- function(ret, dots, label) { 7 | i <<- label 8 | ret 9 | } 10 | 11 | declare_noop <- make_declarations(noop_handler, "test", causal_type = "dgp", "noop", strictDataParam = TRUE) 12 | 13 | expect_equal(formals(declare_noop)$handler, quote(noop_handler)) 14 | 15 | 16 | expect_equal(class(declare_noop), c("declaration", "function")) 17 | 18 | expect_equal(names(attributes(declare_noop)), c("class", "step_type", "causal_type", "strictDataParam")) 19 | 20 | expect_equal(i, 0) # i is unchanged so far 21 | my_noop <- declare_noop(handler = noop_handler, label = "my_label") # setting handler here? scoping issue from setting default handler due to package protection 22 | expect_equal(i, "my_label") # i is set via the validation callback 23 | 24 | expect_identical(sleep, my_noop(sleep)) 25 | }) 26 | 27 | test_that("internal testing function was built correctly", { 28 | 29 | # declare_internal_inherit_params - step template 30 | expect_true(inherits(declare_internal_inherit_params, "declaration")) 31 | expect_true(is.function(declare_internal_inherit_params)) 32 | expect_equal(attr(declare_internal_inherit_params, "step_type"), "BLNKMSG") 33 | expect_equal(attr(declare_internal_inherit_params, "causal_type"), "dgp") 34 | expect_true(attr(declare_internal_inherit_params, "strictDataParam")) 35 | 36 | w <- declare_internal_inherit_params(foo) 37 | expect_true(inherits(w, "design_step")) 38 | expect_true(is.function(w)) 39 | expect_equal(attr(w, "step_type"), "BLNKMSG") 40 | expect_equal(attr(w, "causal_type"), "dgp") 41 | expect_identical(as.character(attr(w, "call")), as.character(quote(declare_internal_inherit_params(foo)))) 42 | 43 | expect_identical(w(NULL), structure(list(HIA = structure(1L, .Label = "MSG", class = "factor")), 44 | .Names = "BLNK", row.names = c(NA, -1L), class = "data.frame" 45 | )) 46 | }) 47 | -------------------------------------------------------------------------------- /tests/testthat/test-sims-independent.R: -------------------------------------------------------------------------------- 1 | context("Test whether separate simulations are independent") 2 | 3 | design <- declare_model(N = 100, U = rnorm(N)) + declare_inquiry(Q = mean(U)) 4 | 5 | test_that("diagnose_design when setting seed they are identical, when not setting seed they are independent", { 6 | 7 | sims_a <- design |> diagnose_design(sims = 10, future.seed = 5) |> get_simulations() 8 | sims_b <- design |> diagnose_design(sims = 10, future.seed = 5) |> get_simulations() 9 | 10 | expect_equal(sims_a$estimand, sims_b$estimand) # exactly 1 11 | 12 | set.seed(5) 13 | 14 | sims_a <- design |> diagnose_design(sims = 10) |> get_simulations() 15 | sims_b <- design |> diagnose_design(sims = 10) |> get_simulations() 16 | 17 | expect_lt(abs(cor(sims_a$estimand, sims_b$estimand)), 0.4) # ~0 (should be, because didn't set seed in between) 18 | 19 | set.seed(5) 20 | sims_a <- design |> diagnose_design(sims = 10) |> get_simulations() 21 | set.seed(5) 22 | sims_b <- design |> diagnose_design(sims = 10) |> get_simulations() 23 | 24 | expect_equal(sims_a$estimand, sims_b$estimand) # exactly 1 25 | 26 | }) 27 | 28 | test_that("diagnose_design focused on bootstrapping - when setting seed they are identical, when not setting seed they are independent", { 29 | 30 | sims_a <- design |> diagnose_design(sims = 10, bootstrap_sims = 5, future.seed = 5) 31 | sims_b <- design |> diagnose_design(sims = 10, bootstrap_sims = 5, future.seed = 5) 32 | 33 | expect_equal(sims_a$bootstrap_replicates$mean_estimand, sims_b$bootstrap_replicates$mean_estimand) # exactly 1 34 | 35 | set.seed(5) 36 | 37 | sims_a <- design |> diagnose_design(sims = 10, bootstrap_sims = 5) 38 | sims_b <- design |> diagnose_design(sims = 10, bootstrap_sims = 5) 39 | 40 | expect_lt(abs(cor(sims_a$bootstrap_replicates$mean_estimand, sims_b$bootstrap_replicates$mean_estimand)), 0.4) # ~0 (should be, because didn't set seed in between) 41 | 42 | set.seed(5) 43 | sims_a <- design |> diagnose_design(sims = 10) 44 | set.seed(5) 45 | sims_b <- design |> diagnose_design(sims = 10) 46 | 47 | expect_equal(sims_a$bootstrap_replicates$mean_estimand, sims_b$bootstrap_replicates$mean_estimand) # exactly 1 48 | 49 | }) 50 | 51 | test_that("simulate_design when setting seed they are identical, when not setting seed they are independent", { 52 | 53 | sims_a <- design |> simulate_design(sims = 10, future.seed = 5) 54 | sims_b <- design |> simulate_design(sims = 10, future.seed = 5) 55 | 56 | expect_equal(sims_a$estimand, sims_b$estimand) # exactly 1 57 | 58 | set.seed(5) 59 | 60 | sims_a <- design |> simulate_design(sims = 10) 61 | sims_b <- design |> simulate_design(sims = 10) 62 | 63 | expect_lt(abs(cor(sims_a$estimand, sims_b$estimand)), 0.4) # ~0 (should be, because didn't set seed in between) 64 | 65 | set.seed(5) 66 | sims_a <- design |> simulate_design(sims = 10) 67 | set.seed(5) 68 | sims_b <- design |> simulate_design(sims = 10) 69 | 70 | expect_equal(sims_a$estimand, sims_b$estimand) # exactly 1 71 | 72 | }) 73 | 74 | -------------------------------------------------------------------------------- /tests/testthat/test-subset.R: -------------------------------------------------------------------------------- 1 | context("Subsetting") 2 | 3 | test_that("Test Subsetting on default inquiry handler", { 4 | my_population <- declare_model(N = 50, noise = rnorm(N)) 5 | 6 | my_potential_outcomes <- declare_model(Y_Z_0 = noise, Y_Z_1 = noise + rnorm(N, mean = 2, sd = 2)) 7 | 8 | my_sampling <- declare_sampling(S = complete_rs(N, n = 25)) 9 | 10 | my_inquiry <- declare_inquiry( 11 | ATE_pos = mean(Y_Z_1 - Y_Z_0), 12 | subset = Y_Z_1 > 0 13 | ) 14 | 15 | my_inquiry2 <- declare_inquiry( 16 | ATE_neg = mean(Y_Z_1 - Y_Z_0), 17 | subset = Y_Z_1 < 0 18 | ) 19 | 20 | 21 | 22 | design <- my_population + my_potential_outcomes + my_sampling + my_inquiry + my_inquiry2 23 | 24 | expect_true(design %>% draw_estimands() %>% with(estimand[1] > 2 && estimand[2] < 0)) 25 | # > z <- replicate(10000, design %>% draw_estimands() %>% with(inquiry[[1]] > 2 && inquiry[2] < 0)) %>% table 26 | # > z 27 | # . 28 | # FALSE TRUE 29 | # 8 9992 30 | }) 31 | -------------------------------------------------------------------------------- /tests/testthat/test-sugar.R: -------------------------------------------------------------------------------- 1 | context("testing rlang NSE syntax sugar") 2 | 3 | 4 | test_that("multiple PO / reveal", { 5 | my_population <- declare_model(N = 100, noise = rnorm(N)) 6 | 7 | multi_po <- rlang:::quos() 8 | multi_po[paste0("Y", 1:3, "_Z_0")] <- list(rlang::quo(noise)) 9 | multi_po[paste0("Y", 1:3, "_Z_1")] <- list(rlang::quo(noise + rnorm(N, mean = 2, sd = 2))) 10 | 11 | my_potential_outcomes3 <- declare_potential_outcomes(!!!multi_po) 12 | 13 | my_assignment <- declare_assignment(Z = complete_ra(N, m = 50)) 14 | 15 | my_outcomes <- paste0("Y", 1:3) 16 | 17 | reveal_multiple <- declare_reveal(outcome_variables = !!my_outcomes) 18 | 19 | design <- my_population + my_potential_outcomes3 + my_assignment + reveal_multiple 20 | 21 | expect_equal(grep("^Y\\d$", colnames(draw_data(design)), value = TRUE), my_outcomes) 22 | }) 23 | 24 | 25 | test_that("+ constructors", { 26 | d <- declare_model(sleep) + declare_sampling(S = complete_rs(N)) + declare_assignment(Z = complete_ra(N, prob = 0.5)) 27 | expect_equal(dim(draw_data(d)), c(10, 5)) 28 | }) 29 | 30 | 31 | 32 | test_that("Lots of levels", { 33 | outcomes <- lapply(LETTERS, function(l) quo(preference == !!l)) 34 | names(outcomes) <- paste0("Y_Z_", LETTERS) 35 | 36 | 37 | design <- declare_model(N = 26000, preference = sample(LETTERS, N, replace = TRUE)) + 38 | declare_potential_outcomes(!!!outcomes) + 39 | declare_assignment(Z = complete_ra(N, conditions = !!LETTERS)) + 40 | declare_measurement(Y = reveal_outcomes(Y ~ Z)) 41 | 42 | expect_equal(colnames(draw_data(design)), c( 43 | "ID", "preference", "Y_Z_A", "Y_Z_B", "Y_Z_C", "Y_Z_D", "Y_Z_E", 44 | "Y_Z_F", "Y_Z_G", "Y_Z_H", "Y_Z_I", "Y_Z_J", "Y_Z_K", "Y_Z_L", 45 | "Y_Z_M", "Y_Z_N", "Y_Z_O", "Y_Z_P", "Y_Z_Q", "Y_Z_R", "Y_Z_S", 46 | "Y_Z_T", "Y_Z_U", "Y_Z_V", "Y_Z_W", "Y_Z_X", "Y_Z_Y", "Y_Z_Z", 47 | "Z", "Y" 48 | )) 49 | }) 50 | -------------------------------------------------------------------------------- /tests/testthat/test-test.R: -------------------------------------------------------------------------------- 1 | 2 | context("declare_test") 3 | 4 | test_that("declare_test works", { 5 | skip_if_not_installed("coin") 6 | 7 | # thanks to Jake Bowers for this test 8 | # https://gist.github.com/jwbowers/2d91fd40faa13520b29ebaa187c58e17 9 | 10 | our_ttest <- function(data) { 11 | require(coin) 12 | res <- coin::oneway_test( 13 | disp ~ factor(vs), 14 | data = data, 15 | distribution = "asymptotic" 16 | ) 17 | data.frame(p.value = pvalue(res)[[1]]) 18 | } 19 | 20 | des <- 21 | # declare_model(N = 100, Xclus = rbinom(n = N, size = 1, prob = 0.2), outcome = 0.2 * Xclus + 3 + rnorm(N)) + 22 | declare_model(data = mtcars) + 23 | declare_test(handler = our_ttest, label = "bare") + 24 | declare_test(handler = label_test(our_ttest), label = "tidied") 25 | 26 | est <- draw_estimates(des) 27 | 28 | expect_equal(est, structure(list(p.value = c(7.6397665500938e-05, 7.6397665500938e-05 29 | ), estimator = c(NA, "tidied")), row.names = c(NA, -2L), class = "data.frame")) 30 | 31 | }) -------------------------------------------------------------------------------- /tests/testthat/test-utilities.R: -------------------------------------------------------------------------------- 1 | context("Utilities") 2 | 3 | 4 | 5 | test_that("pretty printers", { 6 | expect_output(print(declare_model(sleep)), 7 | "declare_model\\(sleep\\)") 8 | }) 9 | 10 | test_that("error if data is in there.", { 11 | expect_error(declare_potential_outcomes(data = "foo"), 12 | "should not be a declared argument.") 13 | }) 14 | 15 | test_that("fallback to lapply", { 16 | future_lapply <- future_lapply 17 | environment(future_lapply) <- 18 | new.env(parent = environment(future_lapply)) 19 | environment(future_lapply)$requireNamespace <- function(...) 20 | FALSE 21 | 22 | expect_identical(future_lapply(LETTERS, identity), as.list(LETTERS)) 23 | }) 24 | 25 | 26 | test_that("names from quos", { 27 | blank_fun <- function(select) { 28 | reveal_nse_helper(enquo(select)) 29 | } 30 | 31 | expect_equal("bias", blank_fun(select = bias)) 32 | expect_equal(c("bias", "mean"), blank_fun(select = c(bias, mean))) 33 | }) 34 | 35 | 36 | test_that("clone_dot_edit_env", { 37 | dot <- quo(test_obj) 38 | environment(dot) <- NULL 39 | expect_s3_class(clone_dot_edit_env(dot, 40 | here_i_am = "some_message", 41 | xyxyx = "bar"), 42 | "quosure") 43 | }) 44 | -------------------------------------------------------------------------------- /vignettes/custom_functions.Rmd: -------------------------------------------------------------------------------- 1 | --- 2 | title: "Custom functions and DeclareDesign" 3 | output: rmarkdown::html_vignette 4 | vignette: > 5 | %\VignetteIndexEntry{Custom functions and DeclareDesign} 6 | %\VignetteEngine{knitr::rmarkdown} 7 | %\VignetteEncoding{UTF-8} 8 | --- 9 | 10 | ```{r echo=FALSE, warning=FALSE, message=FALSE} 11 | set.seed(42) 12 | library(DeclareDesign) 13 | options(digits=2) 14 | ``` 15 | 16 | The `declare_*` functions in **DeclareDesign** use functions in the **fabricatr**, **randomizr**, and **estimatr** packages as defaults, which work great for most designs. Sometimes, however, you might want to write your own function. This advanced vignette declares a design using only custom functions. 17 | 18 | First, we'll write custom functions for each of the steps in the design. All functions must take a data.frame and return a data.frame, with the exception of a population step, whose inputs can be anything but whose output must be a data.frame. 19 | 20 | ```{r} 21 | # M: Model 22 | custom_population <- function(N) { 23 | data.frame(u = rnorm(N)) 24 | } 25 | custom_potential_outcomes <- 26 | function(data) { 27 | within(data,{ 28 | Y_Z_0 <- u 29 | Y_Z_1 <- 0.25 + u 30 | }) 31 | } 32 | 33 | # I: Inquiry 34 | custom_inquiry <- function(data, label) { 35 | data.frame(inquiry = label, 36 | inquiry = with(data, median(Y_Z_1 - Y_Z_0))) 37 | } 38 | 39 | # D: Data Strategy 40 | custom_sampling <- function(data) { 41 | data$S <- rbinom(n = nrow(data), 42 | size = 1, 43 | prob = 0.1) 44 | data[data$S == 1, ] 45 | } 46 | 47 | custom_assignment <- function(data) { 48 | data$Z <- rbinom(n = nrow(data), 49 | size = 1, 50 | prob = 0.5) 51 | data 52 | } 53 | 54 | custom_reveal <- function(data){ 55 | within(data, Y <- Y_Z_1 * Z + Y_Z_0 * (1 - Z)) 56 | } 57 | 58 | # A: Answer strategy 59 | custom_estimator <- function(data){ 60 | data.frame(estimate = with(data, mean(Y))) 61 | } 62 | ``` 63 | 64 | In order to declare the design, we pass each of the custom functions to the `handler` argument of each declaration step: 65 | 66 | ```{r} 67 | design <- 68 | declare_model(handler = custom_population, N = 100) + 69 | declare_potential_outcomes(handler = custom_potential_outcomes) + 70 | declare_inquiry(handler = custom_inquiry, label = "medianTE") + 71 | declare_sampling(handler = custom_sampling) + 72 | declare_assignment(handler = custom_assignment) + 73 | declare_reveal(handler = custom_reveal) + 74 | declare_estimator(handler = tidy_estimator(custom_estimator), 75 | inquiry = "medianTE") 76 | head(draw_data(design)) 77 | run_design(design) 78 | ``` 79 | 80 | This example used very simple custom functions, but this framework is flexible enough to accommodate any design step that can be expressed as a function of data that returns data. 81 | -------------------------------------------------------------------------------- /vignettes/design_declaration_in_other_languages.Rmd: -------------------------------------------------------------------------------- 1 | --- 2 | title: "Design Diagnosis in other languages" 3 | output: rmarkdown::html_vignette 4 | vignette: > 5 | %\VignetteIndexEntry{Design Diagnosis in other languages} 6 | %\VignetteEngine{knitr::rmarkdown} 7 | %\VignetteEncoding{UTF-8} 8 | --- 9 | 10 | | Language | Declaration in code | Figure based on mock data | Diagnosis | 11 | | -------- | ------------------- | ------------------------------------------------------------ | --------- | 12 | | R | | | | 13 | | Stata | | | | 14 | | Python | | | | 15 | | Excel | | | | 16 | Table: Design declaration in four languages 17 | 18 | Click on the declarations to download the code files; the figures to download the code that generated them; and the diagnosis to download a reproducible document that includes the diagnosis. You can also download the code for the reproducible documents for [R](https://declaredesign.org/other_languages/figures/two_arm_design_r.rmd), [Stata](https://declaredesign.org/other_languages/figures/two_arm_design_stata.txt), and [Python](https://declaredesign.org/other_languages/figures/two_arm_design_python.md). 19 | 20 | # How to compile the reproducible documents 21 | 22 | R: the .rmd is knit in Rstudio 23 | 24 | Python: compiled through pandoc using the following command: 25 | 26 | `stitch two_arm_design_python.md -o two_arm_design_python.html` 27 | 28 | Stata: compiled from within Stata via the command: 29 | 30 | `dyndoc two_arm_design_stata.txt, replace` 31 | 32 | --------------------------------------------------------------------------------