├── data └── simulated_data.RData ├── man ├── figures │ └── README-boxplot-1.png ├── nameMu.Rd ├── nameContrast.Rd ├── print.multiMatch.Rd ├── summary.multiMatch.Rd ├── simulated_data.Rd ├── multilevelMatching.Rd ├── calcKMVarFactor.Rd ├── multilevelMatchX.Rd ├── prepareData.Rd ├── estimateTrtModel.Rd ├── multilevelGPSStratification.Rd ├── multilevelGPSMatch.Rd └── multiMatch.Rd ├── .travis.yml ├── CRAN-RELEASE ├── docs ├── reference │ ├── figures │ │ └── README-boxplot-1.png │ ├── nameCols.html │ ├── nameMu.html │ ├── getIDs.html │ ├── overlap.html │ ├── nameContrast.html │ ├── argChecks.html │ ├── setIDs.html │ ├── simulated_data.html │ ├── averageMultipleMatches.html │ ├── determineIDs.html │ ├── reorderByTreatment.html │ ├── calcSigSqAI2006.html │ └── index.html ├── articles │ ├── multilevelMatching-v1.0.0_files │ │ └── figure-html │ │ │ └── boxplot-1.png │ └── index.html ├── pkgdown.yml ├── link.svg ├── sitemap.xml ├── docsearch.js ├── pkgdown.js ├── pkgdown.css └── authors.html ├── .gitignore ├── tests ├── testthat │ ├── testing_datafiles │ │ ├── test_M_match.Rdata │ │ ├── test_M_match_args.Rds │ │ ├── test_toy_output.Rdata │ │ ├── J_var_matches_1_match.Rds │ │ ├── J_var_matches_2_match.Rds │ │ ├── existingGPS_t4mm_orig.Rds │ │ └── test_stratification_data.Rdata │ ├── helper.R │ ├── test_calcKMFactor.R │ ├── test_utilities.R │ ├── test_GPS_Stratification.R │ ├── test_2_impute_mat.R │ ├── test_existing_GPS_matching.R │ ├── test_multiMatch.R │ └── test_1_toy_output.R └── testthat.R ├── codecov.yml ├── .Rbuildignore ├── NAMESPACE ├── _pkgdown.yml ├── multilevelMatching.Rproj ├── cran-comments.md ├── R ├── overlap.r ├── simulated_data.R ├── multilevelMatching.R ├── estforboot.r ├── s3methods.R ├── estimateTrtModel.R ├── utilities.R ├── multilevelGPSStratification.r ├── estimateTau.R ├── estSigSq.R └── multilevelMatchX.r ├── appveyor.yml ├── DESCRIPTION ├── NEWS.md ├── data_raw └── simulate_data.R └── README.Rmd /data/simulated_data.RData: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/shuyang-stat/multilevelMatching/HEAD/data/simulated_data.RData -------------------------------------------------------------------------------- /man/figures/README-boxplot-1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/shuyang-stat/multilevelMatching/HEAD/man/figures/README-boxplot-1.png -------------------------------------------------------------------------------- /.travis.yml: -------------------------------------------------------------------------------- 1 | # R for travis: see documentation at https://docs.travis-ci.com/user/languages/r 2 | 3 | language: R 4 | sudo: false 5 | cache: packages 6 | -------------------------------------------------------------------------------- /CRAN-RELEASE: -------------------------------------------------------------------------------- 1 | This package was submitted to CRAN on 2019-02-17. 2 | Once it is accepted, delete this file and tag the release (commit 0ba97fd56c). 3 | -------------------------------------------------------------------------------- /docs/reference/figures/README-boxplot-1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/shuyang-stat/multilevelMatching/HEAD/docs/reference/figures/README-boxplot-1.png -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | Meta 2 | doc 3 | .Rproj.user 4 | .Rhistory 5 | vignettes/*.R 6 | vignettes/*.html 7 | scratch/ 8 | *.DS_Store 9 | README.html 10 | inst/doc 11 | -------------------------------------------------------------------------------- /tests/testthat/testing_datafiles/test_M_match.Rdata: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/shuyang-stat/multilevelMatching/HEAD/tests/testthat/testing_datafiles/test_M_match.Rdata -------------------------------------------------------------------------------- /tests/testthat/testing_datafiles/test_M_match_args.Rds: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/shuyang-stat/multilevelMatching/HEAD/tests/testthat/testing_datafiles/test_M_match_args.Rds -------------------------------------------------------------------------------- /tests/testthat/testing_datafiles/test_toy_output.Rdata: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/shuyang-stat/multilevelMatching/HEAD/tests/testthat/testing_datafiles/test_toy_output.Rdata -------------------------------------------------------------------------------- /tests/testthat/testing_datafiles/J_var_matches_1_match.Rds: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/shuyang-stat/multilevelMatching/HEAD/tests/testthat/testing_datafiles/J_var_matches_1_match.Rds -------------------------------------------------------------------------------- /tests/testthat/testing_datafiles/J_var_matches_2_match.Rds: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/shuyang-stat/multilevelMatching/HEAD/tests/testthat/testing_datafiles/J_var_matches_2_match.Rds -------------------------------------------------------------------------------- /tests/testthat/testing_datafiles/existingGPS_t4mm_orig.Rds: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/shuyang-stat/multilevelMatching/HEAD/tests/testthat/testing_datafiles/existingGPS_t4mm_orig.Rds -------------------------------------------------------------------------------- /tests/testthat.R: -------------------------------------------------------------------------------- 1 | library(testthat) 2 | library(multilevelMatching) 3 | 4 | suppressWarnings(RNGversion("3.5.0")) ## For backwards compatibility 5 | test_check("multilevelMatching") 6 | -------------------------------------------------------------------------------- /tests/testthat/testing_datafiles/test_stratification_data.Rdata: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/shuyang-stat/multilevelMatching/HEAD/tests/testthat/testing_datafiles/test_stratification_data.Rdata -------------------------------------------------------------------------------- /docs/articles/multilevelMatching-v1.0.0_files/figure-html/boxplot-1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/shuyang-stat/multilevelMatching/HEAD/docs/articles/multilevelMatching-v1.0.0_files/figure-html/boxplot-1.png -------------------------------------------------------------------------------- /codecov.yml: -------------------------------------------------------------------------------- 1 | comment: false 2 | 3 | coverage: 4 | status: 5 | project: 6 | default: 7 | target: auto 8 | threshold: 1% 9 | patch: 10 | default: 11 | target: auto 12 | threshold: 1% 13 | -------------------------------------------------------------------------------- /tests/testthat/helper.R: -------------------------------------------------------------------------------- 1 | 2 | 3 | quickLookup <- function(name) { 4 | # rprojroot::find_package_root_file( 5 | # "tests", "testthat", 6 | rprojroot::find_testthat_root_file( 7 | "testing_datafiles", name) 8 | } 9 | 10 | my_tolerance <- 1e-7 11 | -------------------------------------------------------------------------------- /.Rbuildignore: -------------------------------------------------------------------------------- 1 | ^Meta$ 2 | ^doc$ 3 | ^CRAN-RELEASE$ 4 | ^.*\.Rproj$ 5 | ^\.Rproj\.user$ 6 | ^scratch$ 7 | ^\.travis\.yml$ 8 | ^appveyor\.yml$ 9 | ^codecov\.yml$ 10 | ^_pkgdown\.yml$ 11 | ^README\.Rmd$ 12 | ^README\.html$ 13 | ^docs$ 14 | ^data_raw$ 15 | ^cran-comments\.md$ 16 | -------------------------------------------------------------------------------- /docs/pkgdown.yml: -------------------------------------------------------------------------------- 1 | pandoc: 1.19.2.1 2 | pkgdown: 1.3.0 3 | pkgdown_sha: ~ 4 | articles: 5 | multilevelMatching-v1.0.0: multilevelMatching-v1.0.0.html 6 | urls: 7 | reference: https://shuyang1987.github.io/multilevelMatching//reference 8 | article: https://shuyang1987.github.io/multilevelMatching//articles 9 | 10 | -------------------------------------------------------------------------------- /NAMESPACE: -------------------------------------------------------------------------------- 1 | # Generated by roxygen2: do not edit by hand 2 | 3 | S3method(print,multiMatch) 4 | S3method(summary,multiMatch) 5 | export(calcKMVarFactor) 6 | export(estimateTrtModel) 7 | export(multiMatch) 8 | export(multilevelGPSMatch) 9 | export(multilevelGPSStratification) 10 | export(multilevelMatchX) 11 | export(nameContrast) 12 | export(nameMu) 13 | export(prepareData) 14 | -------------------------------------------------------------------------------- /man/nameMu.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/utilities.R 3 | \name{nameMu} 4 | \alias{nameMu} 5 | \title{Naming the matching population mean mu's} 6 | \usage{ 7 | nameMu(trt) 8 | } 9 | \arguments{ 10 | \item{trt}{Treatment level} 11 | } 12 | \description{ 13 | Naming the matching population mean mu's 14 | } 15 | \examples{ 16 | nameMu(1) 17 | 18 | } 19 | -------------------------------------------------------------------------------- /_pkgdown.yml: -------------------------------------------------------------------------------- 1 | development: 2 | mode: unreleased 3 | 4 | url: https://shuyang1987.github.io/multilevelMatching/ 5 | 6 | reference: 7 | - title: Matching on raw covariates 8 | contents: 9 | - multiMatch 10 | - multilevelMatchX 11 | 12 | - title: Matching on generalized propensity scores 13 | contents: 14 | - multiMatch 15 | - multilevelGPSMatch 16 | 17 | - title: Stratification on generalized propensity scores 18 | contents: 19 | - multilevelGPSStratification 20 | -------------------------------------------------------------------------------- /man/nameContrast.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/utilities.R 3 | \name{nameContrast} 4 | \alias{nameContrast} 5 | \title{Naming the matching contrasts} 6 | \usage{ 7 | nameContrast(trt1, trt2) 8 | } 9 | \arguments{ 10 | \item{trt1}{Former treatment level} 11 | 12 | \item{trt2}{Latter treatment level} 13 | } 14 | \description{ 15 | Naming the matching contrasts 16 | } 17 | \examples{ 18 | nameContrast(trt1=1, trt2=0) 19 | 20 | } 21 | -------------------------------------------------------------------------------- /multilevelMatching.Rproj: -------------------------------------------------------------------------------- 1 | Version: 1.0 2 | 3 | RestoreWorkspace: Default 4 | SaveWorkspace: Default 5 | AlwaysSaveHistory: Default 6 | 7 | EnableCodeIndexing: Yes 8 | UseSpacesForTab: Yes 9 | NumSpacesForTab: 2 10 | Encoding: UTF-8 11 | 12 | RnwWeave: knitr 13 | LaTeX: XeLaTeX 14 | 15 | AutoAppendNewline: Yes 16 | StripTrailingWhitespace: Yes 17 | 18 | BuildType: Package 19 | PackageUseDevtools: Yes 20 | PackageInstallArgs: --no-multiarch --with-keep.source 21 | PackageRoxygenize: rd,collate,namespace,vignette 22 | -------------------------------------------------------------------------------- /tests/testthat/test_calcKMFactor.R: -------------------------------------------------------------------------------- 1 | 2 | context("calcKMVarFactor") 3 | 4 | test_that( 5 | "calcKMVarFactor returns the correct values of K_M_var_factor from Kiw",{ 6 | 7 | ## Expected vectors were calculated by hand from the components presented in 8 | ## Theorem 7 in Abadie and Imbens 2006 Econometrica paper 9 | 10 | expect_equal( 11 | calcKMVarFactor(Kiw = c(1,5,10,23), M_matches = 1), 12 | c(2, 30, 110, 552) 13 | ) 14 | expect_equal( 15 | calcKMVarFactor(Kiw = c(1,5,10,23), M_matches = 2), 16 | c(1, 10, 32.5, 149.5) 17 | ) 18 | } 19 | ) 20 | -------------------------------------------------------------------------------- /cran-comments.md: -------------------------------------------------------------------------------- 1 | ## Resubmission 2 | This is a resubmission. In this version I have: 3 | 4 | * edited the roxygen2 documentation with correct LaTeX variable definition 5 | * added DOI information to the reference in the Description. 6 | * reinstalled Tex to see if examples are included in submission build 7 | * added more examples to exported functions 8 | * fixed broken examples 9 | * Ensured every documented function has an example 10 | 11 | 12 | ## Test environments 13 | * local OS X install, R 3.5.1 14 | * ubuntu 12.04 (on travis-ci), R 3.4.3 15 | * win-builder (devel and release) 16 | 17 | ## R CMD check results 18 | 19 | 0 errors | 0 warnings | 1 note 20 | 21 | * This is a new release. 22 | 23 | ## Reverse dependencies 24 | 25 | This is a new release, so there are no reverse dependencies. 26 | -------------------------------------------------------------------------------- /R/overlap.r: -------------------------------------------------------------------------------- 1 | 2 | # #' Function to determine overlap from Crump et al. (2009)'s method. 3 | # #' 4 | # #' @param PF.fit fitted propensity model 5 | # #' 6 | # #' @references Crump, R. K., Hotz, V. J., Imbens, G. W., & Mitnik, O. A. (2009). 7 | # #' Dealing with limited overlap in estimation of average treatment effects. 8 | # #' Biometrika, 96(1), 187-199. \url{https://doi.org/10.1093/biomet/asn055} 9 | # #' 10 | overlap <- function(PF.fit){ 11 | 12 | obj <- function(alpha){ 13 | gx <- apply(1/PF.fit,1,sum) 14 | id <- (gx 2 | 3 | 5 | 8 | 12 | 13 | -------------------------------------------------------------------------------- /man/print.multiMatch.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/s3methods.R 3 | \name{print.multiMatch} 4 | \alias{print.multiMatch} 5 | \title{Prints a summary of the estimates from a multiMatch object} 6 | \usage{ 7 | \method{print}{multiMatch}(x, ...) 8 | } 9 | \arguments{ 10 | \item{x}{object of class "multiMatch"} 11 | 12 | \item{...}{dots} 13 | } 14 | \description{ 15 | Prints a summary of the estimates from a multiMatch object 16 | } 17 | \examples{ 18 | 19 | sim_data <- multilevelMatching::simulated_data 20 | Y <- sim_data$outcome 21 | W <- sim_data$treatment 22 | X <- as.matrix(sim_data[ ,-(1:2)]) 23 | names(Y) <- paste0("ID", 1:length(Y)) 24 | 25 | trimming <- FALSE 26 | method <- c("covariates", "polr", "multinom")[2] 27 | 28 | fit <- multiMatch(Y,W,X,trimming=trimming,match_on=method) 29 | print(fit) 30 | 31 | } 32 | -------------------------------------------------------------------------------- /man/summary.multiMatch.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/s3methods.R 3 | \name{summary.multiMatch} 4 | \alias{summary.multiMatch} 5 | \title{Prints a summary of a multiMatch object} 6 | \usage{ 7 | \method{summary}{multiMatch}(object, ...) 8 | } 9 | \arguments{ 10 | \item{object}{object of class "multiMatch"} 11 | 12 | \item{...}{dots} 13 | } 14 | \description{ 15 | Prints a summary of a multiMatch object 16 | } 17 | \examples{ 18 | 19 | sim_data <- multilevelMatching::simulated_data 20 | Y <- sim_data$outcome 21 | W <- sim_data$treatment 22 | X <- as.matrix(sim_data[ ,-(1:2)]) 23 | names(Y) <- paste0("ID", 1:length(Y)) 24 | 25 | trimming <- FALSE 26 | method <- c("covariates", "polr", "multinom")[2] 27 | 28 | fit <- multiMatch(Y,W,X,trimming=trimming,match_on=method) 29 | summary(fit) 30 | 31 | } 32 | \author{ 33 | Brian G. Barkley 34 | } 35 | -------------------------------------------------------------------------------- /R/simulated_data.R: -------------------------------------------------------------------------------- 1 | #' Simulated dataset for multilevelMatching package 2 | #' 3 | #' This is a dataset with six baseline covariates, one column indicating 4 | #' treatment level, and one column indicating post-treatment outcome. This 5 | #' simulated data is purely for illustration, and any combination of the 6 | #' covariates can be assumed to sufficient to meet conditional exchangeability. 7 | #' 8 | #' @format A data frame with 300 rows and 8 variables: 9 | #' \describe{ 10 | #' \item{outcome}{Outcome of interest} 11 | #' \item{treatment}{Treatment level of the unit} 12 | #' \item{covar1}{Baseline covariate 1} 13 | #' \item{covar2}{Baseline covariate 2} 14 | #' \item{covar3}{Baseline covariate 3} 15 | #' \item{covar4}{Baseline covariate 4} 16 | #' \item{covar5}{Baseline covariate 5} 17 | #' \item{covar6}{Baseline covariate 6} 18 | #' } 19 | #' @source \url{http://www.diamondse.info/} 20 | "simulated_data" 21 | -------------------------------------------------------------------------------- /appveyor.yml: -------------------------------------------------------------------------------- 1 | # DO NOT CHANGE the "init" and "install" sections below 2 | 3 | # Download script file from GitHub 4 | init: 5 | ps: | 6 | $ErrorActionPreference = "Stop" 7 | Invoke-WebRequest http://raw.github.com/krlmlr/r-appveyor/master/scripts/appveyor-tool.ps1 -OutFile "..\appveyor-tool.ps1" 8 | Import-Module '..\appveyor-tool.ps1' 9 | 10 | install: 11 | ps: Bootstrap 12 | 13 | cache: 14 | - C:\RLibrary 15 | 16 | # Adapt as necessary starting from here 17 | 18 | build_script: 19 | - travis-tool.sh install_deps 20 | 21 | test_script: 22 | - travis-tool.sh run_tests 23 | 24 | on_failure: 25 | - 7z a failure.zip *.Rcheck\* 26 | - appveyor PushArtifact failure.zip 27 | 28 | artifacts: 29 | - path: '*.Rcheck\**\*.log' 30 | name: Logs 31 | 32 | - path: '*.Rcheck\**\*.out' 33 | name: Logs 34 | 35 | - path: '*.Rcheck\**\*.fail' 36 | name: Logs 37 | 38 | - path: '*.Rcheck\**\*.Rout' 39 | name: Logs 40 | 41 | - path: '\*_*.tar.gz' 42 | name: Bits 43 | 44 | - path: '\*_*.zip' 45 | name: Bits 46 | -------------------------------------------------------------------------------- /man/simulated_data.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/simulated_data.R 3 | \docType{data} 4 | \name{simulated_data} 5 | \alias{simulated_data} 6 | \title{Simulated dataset for multilevelMatching package} 7 | \format{A data frame with 300 rows and 8 variables: 8 | \describe{ 9 | \item{outcome}{Outcome of interest} 10 | \item{treatment}{Treatment level of the unit} 11 | \item{covar1}{Baseline covariate 1} 12 | \item{covar2}{Baseline covariate 2} 13 | \item{covar3}{Baseline covariate 3} 14 | \item{covar4}{Baseline covariate 4} 15 | \item{covar5}{Baseline covariate 5} 16 | \item{covar6}{Baseline covariate 6} 17 | }} 18 | \source{ 19 | \url{http://www.diamondse.info/} 20 | } 21 | \usage{ 22 | simulated_data 23 | } 24 | \description{ 25 | This is a dataset with six baseline covariates, one column indicating 26 | treatment level, and one column indicating post-treatment outcome. This 27 | simulated data is purely for illustration, and any combination of the 28 | covariates can be assumed to sufficient to meet conditional exchangeability. 29 | } 30 | \keyword{datasets} 31 | -------------------------------------------------------------------------------- /R/multilevelMatching.R: -------------------------------------------------------------------------------- 1 | #' Propensity Score Matching and Subclassification in Observational Studies with 2 | #' Multi-level Treatments 3 | #' 4 | #' \pkg{multilevelMatching} implements the estimators introduced in Yang et al. 5 | #' (2016) \emph{Propensity Score Matching and Subclassification in Observational 6 | #' studies with Multi-level Treatments}: 7 | #' \url{https://doi.org/10.1111/biom.12505}. These are covariate- and propensity 8 | #' score-matching estimators for estimating the causal effect of multilevel 9 | #' treatment (i.e., 3 or more treatment types). 10 | #' 11 | #' The main function for estimation via matching on covariates or propensity 12 | #' scores is \code{\link{multiMatch}}. To carry out estimation via 13 | #' subclassification, use \code{\link{multilevelGPSStratification}}. 14 | #' 15 | #' 16 | #' @examples 17 | #' sim_data <- multilevelMatching::simulated_data 18 | #' Y <- sim_data$outcome 19 | #' W <- sim_data$treatment 20 | #' X <- as.matrix(sim_data[ ,-(1:2)]) 21 | #' names(Y) <- paste0("ID", 1:length(Y)) 22 | #' 23 | #' trimming <- FALSE 24 | #' method <- c("covariates", "polr", "multinom")[2] 25 | #' 26 | #' multiMatch(Y,W,X,trimming=trimming,match_on=method) 27 | #' 28 | #' 29 | #' @name multilevelMatching 30 | #' @docType package 31 | NULL 32 | 33 | 34 | 35 | -------------------------------------------------------------------------------- /man/multilevelMatching.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/multilevelMatching.R 3 | \docType{package} 4 | \name{multilevelMatching} 5 | \alias{multilevelMatching} 6 | \alias{multilevelMatching-package} 7 | \title{Propensity Score Matching and Subclassification in Observational Studies with 8 | Multi-level Treatments} 9 | \description{ 10 | \pkg{multilevelMatching} implements the estimators introduced in Yang et al. 11 | (2016) \emph{Propensity Score Matching and Subclassification in Observational 12 | studies with Multi-level Treatments}: 13 | \url{https://doi.org/10.1111/biom.12505}. These are covariate- and propensity 14 | score-matching estimators for estimating the causal effect of multilevel 15 | treatment (i.e., 3 or more treatment types). 16 | } 17 | \details{ 18 | The main function for estimation via matching on covariates or propensity 19 | scores is \code{\link{multiMatch}}. To carry out estimation via 20 | subclassification, use \code{\link{multilevelGPSStratification}}. 21 | } 22 | \examples{ 23 | sim_data <- multilevelMatching::simulated_data 24 | Y <- sim_data$outcome 25 | W <- sim_data$treatment 26 | X <- as.matrix(sim_data[ ,-(1:2)]) 27 | names(Y) <- paste0("ID", 1:length(Y)) 28 | 29 | trimming <- FALSE 30 | method <- c("covariates", "polr", "multinom")[2] 31 | 32 | multiMatch(Y,W,X,trimming=trimming,match_on=method) 33 | 34 | 35 | } 36 | -------------------------------------------------------------------------------- /DESCRIPTION: -------------------------------------------------------------------------------- 1 | Package: multilevelMatching 2 | Type: Package 3 | Title: Propensity Score Matching and Subclassification in Observational Studies 4 | with Multi-Level Treatments 5 | Authors@R: c( 6 | person("Shu", "Yang", email = "shuyang@hsph.harvard.edu", 7 | role = c("aut")), 8 | person("Brian G.", "Barkley", email = "BarkleyBG@outlook.com", 9 | role = c("aut", "cre"), comment = c(ORCID = "0000-0003-1787-4735")) 10 | ) 11 | Date: 2019-05-06 12 | Version: 1.0.0 13 | Description: Implements methods to estimate causal effects from observational 14 | studies when there are 2+ distinct levels of treatment (i.e., "multilevel 15 | treatment") using matching estimators, as introduced in Yang et al. (2016) 16 | . Matching on covariates, and matching or 17 | stratification on modeled propensity scores, are available. These methods 18 | require matching on only a scalar function of generalized propensity scores. 19 | Depends: 20 | R (>= 3.1.2) 21 | Imports: 22 | Matching (>= 4.8-3.4), 23 | MASS (>= 7.3-35), 24 | nnet (>= 7.3-8), 25 | boot (>= 1.3-13) 26 | License: GPL-2 27 | VignetteBuilder: knitr 28 | Suggests: 29 | knitr, 30 | rmarkdown, 31 | testthat, 32 | rprojroot 33 | RoxygenNote: 6.1.0 34 | LazyData: TRUE 35 | URL: https://shuyang1987.github.io/multilevelMatching/ 36 | BugReports: https://github.com/shuyang1987/multilevelMatching/issues 37 | Encoding: UTF-8 38 | -------------------------------------------------------------------------------- /man/calcKMVarFactor.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/estimateTau.R 3 | \name{calcKMVarFactor} 4 | \alias{calcKMVarFactor} 5 | \title{Calculate the variance component for number of times unit is a match.} 6 | \usage{ 7 | calcKMVarFactor(Kiw, M_matches) 8 | } 9 | \arguments{ 10 | \item{Kiw}{A vector of times each unit is matched to} 11 | 12 | \item{M_matches}{Number of matches per unit for imputing potential outcomes, 13 | as in Abadie and Imbens (2006).} 14 | } 15 | \value{ 16 | A numeric vector. 17 | 18 | This function is exported for use in other packages. 19 | } 20 | \description{ 21 | This function calculates \code{K_M_var_factor}, a numeric vector. Each entry in 22 | this vector is a function of the number of times each unit is matched to, aka 23 | \eqn{K_M(i)} (corresponding to \code{Kiw}, where \eqn{M} corresponds to \code{M_matches}. The calculation 24 | in this function comes from Theorem 7, page 251 of Abadie and Imbens (2006) 25 | Econometrica. The \code{K_M_var_factor} is an important component in the variance 26 | estimation, created in the function \code{estVarAI2006} in 27 | \code{estimateTau}. 28 | } 29 | \examples{ 30 | calcKMVarFactor(Kiw = 2, M_matches = 4) 31 | 32 | } 33 | \references{ 34 | Abadie, A., & Imbens, G. W. (2006). Large sample properties of 35 | matching estimators for average treatment effects. econometrica, 74(1), 36 | 235-267. \url{https://doi.org/10.1111/j.1468-0262.2006.00655.x} 37 | } 38 | -------------------------------------------------------------------------------- /tests/testthat/test_utilities.R: -------------------------------------------------------------------------------- 1 | 2 | # context("new naming function") 3 | context("Misc small improvements") 4 | 5 | test_that( 6 | desc="nameCols() works", 7 | code = { 8 | 9 | trtnumber <- 3 10 | trtlevels <- c("foo", "var", "bar") 11 | cname<-c() 12 | for(kk in 1:trtnumber){ 13 | thistrt<-trtlevels[kk] 14 | cname<-c(cname,c(paste(paste(paste("m",thistrt,sep=""),".",sep=""),1,sep=""), 15 | paste(paste(paste("m",thistrt,sep=""),".",sep=""),2,sep=""))) 16 | } 17 | 18 | expect_equal( 19 | cname, 20 | nameCols(trtlevels) 21 | ) 22 | } 23 | ) 24 | 25 | 26 | 27 | 28 | test_that( 29 | desc = "reorderByTreatment() can be made simpler + works with factors", 30 | { 31 | W <- 1:4 32 | temp1 <- sort(W, index.return=TRUE) 33 | temp2 <- list(x = W) 34 | temp2$ix <- 1:length(W) 35 | 36 | expect_equal( 37 | temp1, 38 | temp2 39 | ) 40 | 41 | 42 | W <- (letters[1:5]) 43 | temp1 <- sort(W, index.return=TRUE) 44 | temp2 <- list(x = W) 45 | temp2$ix <- 1:length(W) 46 | 47 | expect_equal( 48 | temp1, 49 | temp2 50 | ) 51 | 52 | W <- as.factor(letters[1:5]) 53 | temp1 <- sort(W, index.return=TRUE) 54 | expect_error(temp1$ix) 55 | ##use the below method! 56 | # temp2 <- list(x = W) 57 | # temp2$ix <- 1:length(W) 58 | # 59 | # expect_equal( 60 | # temp1, 61 | # temp2 62 | # ) 63 | } 64 | ) 65 | -------------------------------------------------------------------------------- /tests/testthat/test_GPS_Stratification.R: -------------------------------------------------------------------------------- 1 | 2 | context("Stratify on GPS") 3 | 4 | load( # Y,W,X, match4, match4_lp, 5 | file = quickLookup("test_stratification_data.Rdata") 6 | ) 7 | 8 | test_that( 9 | "GPS stratification returns original (v0.1) results", 10 | { 11 | set.seed(22) 12 | strat <- multilevelGPSStratification( 13 | Y,W,X,NS=10,GPSM="multinomiallogisticReg", 14 | linearp=0,nboot=5 15 | ) 16 | 17 | expect_equal( 18 | strat$tauestimate, 19 | match4$tauestimate, 20 | tolerance = my_tolerance, 21 | check.attributes = FALSE 22 | ) 23 | expect_equal( 24 | strat$varestimate, 25 | match4$varestimate, 26 | tolerance = my_tolerance, 27 | check.attributes = FALSE 28 | ) 29 | expect_identical( 30 | names(strat$tauestimate), 31 | names(match4$varestimate) 32 | ) 33 | 34 | 35 | set.seed(22) 36 | strat_lp <- multilevelGPSStratification( 37 | Y,W,X,NS=10, 38 | GPSM="ordinallogisticReg",linearp=1,nboot=5 39 | ) 40 | 41 | expect_equal( 42 | strat_lp$tauestimate, 43 | match4_lp$tauestimate, 44 | tolerance = my_tolerance, 45 | check.attributes = FALSE 46 | ) 47 | expect_equal( 48 | strat_lp$varestimate, 49 | match4_lp$varestimate, 50 | tolerance = my_tolerance, 51 | check.attributes = FALSE 52 | ) 53 | expect_identical( 54 | names(strat_lp$tauestimate), 55 | names(match4_lp$varestimate) 56 | ) 57 | } 58 | ) 59 | -------------------------------------------------------------------------------- /NEWS.md: -------------------------------------------------------------------------------- 1 | 2 | # multilevelMatching 1.0.0 3 | 4 | - Original CRAN release version by Shu Yang ([@shuyang1987](https://github.com/shuyang1987/)) and Brian G Barkley ([@BarkleyBG](https://github.com/BarkleyBG/)). 5 | - Added `multiMatch()` function to carry out all types of matching. This effectively combines `multilevelGPSMatch()` and `multilevelMatchX()` into one function. Features include: 6 | - Better output: 7 | - tidier estimates: see `estimateTau()` 8 | - plus more information from under-the-hood: see the `impute_mat` object for matrix off all imputed potential outcomes. 9 | - Now allows for one-to-many matches for the main matching procedure (and imputing potential outomces). The user may specify `M_matches >=1`. 10 | - Now allows for one-to-many matches to estimate the variance component. The user may specify `J_var_matches >=1`. 11 | - Allowed for more user-specified arguments (for fitting PS models) i.e. `model_options` 12 | - Divergence: Using `multiMatch()` with `match_on='existing'` does not always return the same results as using `multilevelGPSMatch()` for matching on the existing (user-specified) generalized propensity scores. 13 | - Added S3 methods for `print` and `summary` for the `multiMatch` class 14 | - Added S3 methods for `print` and `summary` for the `multiMatch` class 15 | - Users can apply the `estimateTrtModel()` function before using `multiMatch()` to verify that the model fitted in `multiMatch()` is the same as the user desires 16 | 17 | # multilevelMatching 0.1.0 18 | 19 | - Original package version, released to GitHub by Shu Yang (@shuyang1987). See [Release v0.1.0](https://github.com/shuyang1987/multilevelMatching/releases/tag/v0.1.0). 20 | -------------------------------------------------------------------------------- /R/estforboot.r: -------------------------------------------------------------------------------- 1 | 2 | # #' Statistic for bootstrapping the standard errors from GPS Stratification 3 | # #' 4 | # #' 5 | estforboot <- function( 6 | data,indices,GPSM,linearp,trtnumber,trtlevels,taunumber,NS 7 | ){ 8 | ###boot function 9 | # 10 | d <- data[indices,] # allows boot to select sample 11 | W<-d[,"W"] 12 | W<-as.factor(W) 13 | Y<-d[,"Y"] 14 | X<-d[,-c(1:2)] 15 | 16 | #PF modeling 17 | if(GPSM=="multinomiallogisticReg"){ 18 | W.ref <- stats::relevel(as.factor(W),ref="1") 19 | temp <- utils::capture.output(PF.out <- nnet::multinom(W.ref~X)) 20 | PF.fit <- stats::fitted(PF.out) 21 | if(linearp==1){ 22 | beta <- stats::coef(PF.out) 23 | Xbeta<-X%*%t(beta[,-1]) 24 | PF.fit[,-1]<-Xbeta 25 | } 26 | } 27 | if(GPSM=="ordinallogisticReg"){ 28 | PF.out <- MASS::polr(as.factor(W)~X) 29 | PF.fit <- stats::fitted(PF.out) 30 | } 31 | if(GPSM=="existing"){ 32 | PF.fit <- X 33 | } 34 | 35 | meanwj<-numberwj<-matrix(NA,trtnumber,NS) 36 | 37 | for(kk in 1:trtnumber){ 38 | pwx<-PF.fit[,kk] 39 | ranking <- stats::ave( pwx, FUN=function(x) { 40 | cut(x,stats::quantile(pwx,(0:NS)/NS,type=2), 41 | include.lowest=TRUE,right=FALSE) 42 | }) 43 | #type=2 to have the same quintiles as in SAS 44 | #right=FALSE to have left side closed intervals 45 | for(jj in 1:NS){ 46 | id<-which(W==kk&ranking==jj) 47 | meanwj[kk,jj]<-mean(Y[id]) 48 | numberwj[kk,jj]<-sum(ranking==jj) 49 | } 50 | numberwj<-numberwj*(1-is.na(meanwj)) 51 | meanw<-apply(meanwj*numberwj,1,sum,na.rm=TRUE)/apply(numberwj,1,sum) 52 | } 53 | 54 | tauestimate<-rep(NA,taunumber) 55 | cnt<-0 56 | for(jj in 1:(trtnumber-1)){ 57 | for(kk in (jj+1):trtnumber){ 58 | cnt<-cnt+1 59 | tauestimate[cnt]<-meanw[kk]-meanw[jj] 60 | } 61 | } 62 | 63 | return(tauestimate) 64 | } 65 | -------------------------------------------------------------------------------- /docs/sitemap.xml: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | https://shuyang1987.github.io/multilevelMatching//index.html 5 | 6 | 7 | https://shuyang1987.github.io/multilevelMatching//reference/calcKMVarFactor.html 8 | 9 | 10 | https://shuyang1987.github.io/multilevelMatching//reference/estimateTrtModel.html 11 | 12 | 13 | https://shuyang1987.github.io/multilevelMatching//reference/multiMatch.html 14 | 15 | 16 | https://shuyang1987.github.io/multilevelMatching//reference/multilevelGPSMatch.html 17 | 18 | 19 | https://shuyang1987.github.io/multilevelMatching//reference/multilevelGPSStratification.html 20 | 21 | 22 | https://shuyang1987.github.io/multilevelMatching//reference/multilevelMatchX.html 23 | 24 | 25 | https://shuyang1987.github.io/multilevelMatching//reference/multilevelMatching.html 26 | 27 | 28 | https://shuyang1987.github.io/multilevelMatching//reference/nameContrast.html 29 | 30 | 31 | https://shuyang1987.github.io/multilevelMatching//reference/nameMu.html 32 | 33 | 34 | https://shuyang1987.github.io/multilevelMatching//reference/prepareData.html 35 | 36 | 37 | https://shuyang1987.github.io/multilevelMatching//reference/print.multiMatch.html 38 | 39 | 40 | https://shuyang1987.github.io/multilevelMatching//reference/simulated_data.html 41 | 42 | 43 | https://shuyang1987.github.io/multilevelMatching//reference/summary.multiMatch.html 44 | 45 | 46 | https://shuyang1987.github.io/multilevelMatching//articles/multilevelMatching-v1.0.0.html 47 | 48 | 49 | -------------------------------------------------------------------------------- /tests/testthat/test_2_impute_mat.R: -------------------------------------------------------------------------------- 1 | 2 | context("test_2_impute_mat: impute_mat is ordered as original data") 3 | 4 | 5 | X <- matrix(c(5.5,10.6,3.1,8.7,5.1,10.2,9.8,4.4,4.9), ncol=1) 6 | Y <- matrix(c(102,105,120,130,100,80,94,108,96), ncol=1) 7 | W <- matrix(c(1, 1, 1, 3, 2, 3, 2, 1, 2), ncol=1) 8 | 9 | t2_in_imputemat <- multiMatch(Y,W,X,trimming = 0,match_on = "multinom") 10 | 11 | tests_data <- quickLookup("test_toy_output.Rdata") 12 | load(tests_data) 13 | 14 | my_tolerance <- 1e-3 15 | 16 | test_that("match on GPS with one X and no trimming returns same output", { 17 | 18 | ## test the estimates 19 | expect_equal( 20 | (t2_in_imputemat$results)$Estimate, 21 | (baseline_tests2$results)$Estimate, 22 | tolerance = my_tolerance 23 | ) 24 | ## test the AI 2006 variance estimates 25 | expect_equal( 26 | (t2_in_imputemat$results)$Variance, 27 | (baseline_tests2$results)$Variance, 28 | tolerance = my_tolerance 29 | ) 30 | ## test the AI 2016 variance estimates 31 | expect_equal( 32 | (t2_in_imputemat$results)$VarianceAI2016, 33 | (baseline_tests2$results)$VarianceAI2012, 34 | tolerance = my_tolerance 35 | ) 36 | ## test the impute matrix 37 | expect_equal( 38 | (t2_in_imputemat$impute_mat), 39 | (baseline_tests2$impute_mat), 40 | tolerance = my_tolerance, 41 | check.attributes = FALSE 42 | ) 43 | }) 44 | 45 | 46 | test_that( 47 | "impute_mat behaves well", 48 | { 49 | 50 | baseline_imputes <- matrix(NA,ncol=3, nrow= length(W)) 51 | for (ii in 1:nrow(baseline_imputes)){ 52 | baseline_imputes[ii,W[ii]] <- Y[ii] 53 | } 54 | 55 | 56 | new_imputes <- (t2_in_imputemat$impute_mat) 57 | new_imputes[is.na(baseline_imputes)] <- NA 58 | 59 | expect_equal( 60 | new_imputes[1:3,], 61 | baseline_imputes[1:3,], 62 | tolerance = my_tolerance, 63 | check.attributes = FALSE 64 | ) 65 | expect_equal( 66 | new_imputes , 67 | baseline_imputes , 68 | tolerance = my_tolerance, 69 | check.attributes = FALSE 70 | ) 71 | } 72 | ) 73 | 74 | -------------------------------------------------------------------------------- /man/multilevelMatchX.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/multilevelMatchX.R 3 | \name{multilevelMatchX} 4 | \alias{multilevelMatchX} 5 | \title{Matching on X with multilevel treatments} 6 | \usage{ 7 | multilevelMatchX(Y, W, X) 8 | } 9 | \arguments{ 10 | \item{Y}{A continuous response vector (1 x n)} 11 | 12 | \item{W}{A treatment vector (1 x n) with numerical values indicating 13 | treatment groups} 14 | 15 | \item{X}{A covariate matrix (p x n) with no intercept} 16 | } 17 | \value{ 18 | A list with 2 elements: \code{tauestimate}, \code{varestimate}, where 19 | \code{tauestimate} is a vector of estimates for pairwise treatment effects, 20 | and \code{varestimate} is a vector of variance estimates for 21 | \code{tauestimate}, using Abadie & Imbens (2006)'s method. 22 | } 23 | \description{ 24 | Matching on X with multilevel treatments 25 | } 26 | \examples{ 27 | X<-c(5.5,10.6,3.1,8.7,5.1,10.2,9.8,4.4,4.9) 28 | Y<-c(102,105,120,130,100,80,94,108,96) 29 | W<-c(1,1,1,3,2,3,2,1,2) 30 | multilevelMatchX(Y,W,X) 31 | 32 | } 33 | \references{ 34 | Yang, S., Imbens G. W., Cui, Z., Faries, D. E., & Kadziola, Z. 35 | (2016) Propensity Score Matching and Subclassification in Observational 36 | Studies with Multi-Level Treatments. Biometrics, 72, 1055-1065. 37 | \url{https://doi.org/10.1111/biom.12505} 38 | 39 | Abadie, A., & Imbens, G. W. (2006). Large sample properties of matching 40 | estimators for average treatment effects. econometrica, 74(1), 235-267. 41 | \url{https://doi.org/10.1111/j.1468-0262.2006.00655.x} 42 | 43 | Abadie, A., & Imbens, G. W. (2016). Matching on the estimated propensity 44 | score. Econometrica, 84(2), 781-807. 45 | \url{https://doi.org/10.3982/ECTA11293} 46 | 47 | Crump, R. K., Hotz, V. J., Imbens, G. W., & Mitnik, O. A. (2009). Dealing 48 | with limited overlap in estimation of average treatment effects. 49 | Biometrika, 96(1), 187-199. \url{https://doi.org/10.1093/biomet/asn055} 50 | } 51 | \seealso{ 52 | \code{\link{multilevelGPSMatch}}; 53 | \code{\link{multilevelGPSStratification}} 54 | } 55 | -------------------------------------------------------------------------------- /man/prepareData.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/prepareData.R 3 | \name{prepareData} 4 | \alias{prepareData} 5 | \title{Prepare data for estimation} 6 | \usage{ 7 | prepareData(Y, W, X, match_on, trimming = NULL, model_options, M_matches, 8 | J_var_matches) 9 | } 10 | \arguments{ 11 | \item{Y}{A response vector (1 x n)} 12 | 13 | \item{W}{A treatment vector (1 x n) with numerical values indicating 14 | treatment groups} 15 | 16 | \item{X}{A covariate matrix (p x n) with no intercept. When 17 | match_on="existing", then X must be a vector (1 x n) of user-specified 18 | propensity scores.} 19 | 20 | \item{match_on}{User specifies "covariates" to match on raw covariates, or 21 | "existing" to match on user-supplied propensity score values, or "polr" or 22 | "multinom" to fit a propensity score model.} 23 | 24 | \item{trimming}{an indicator of whether trimming the sample to ensure overlap} 25 | 26 | \item{model_options}{A list of the options to pass to propensity model. 27 | Currently under development. Can only pass reference level to multinomial 28 | logistic regression.} 29 | 30 | \item{M_matches}{Number of matches per unit for imputing potential outcomes, 31 | as in Abadie and Imbens (2006).} 32 | 33 | \item{J_var_matches}{Number of matches when estimating \eqn{\sigma^2(X,W)} as 34 | in Abadie and Imbens (2006).} 35 | } 36 | \value{ 37 | A list of information, including the \code{X, W, Y} arguments after 38 | sorting observeations, and information on \code{unit_ids}, etc. 39 | } 40 | \description{ 41 | A series of checks, tests, re-ordering, and other operations to prepare the 42 | data for matching. This function can be run standalone, before running 43 | \code{\link{multiMatch}}. 44 | } 45 | \examples{ 46 | 47 | sim_data <- multilevelMatching::simulated_data 48 | Y <- sim_data$outcome 49 | W <- sim_data$treatment 50 | X <- as.matrix(sim_data[ ,-(1:2)]) 51 | names(Y) <- paste0("ID", 1:length(Y)) 52 | 53 | trimming <- FALSE 54 | method <- c("covariates", "polr", "multinom")[2] 55 | 56 | prepared_data <- prepareData( 57 | Y = Y, 58 | W = W, 59 | X = X, 60 | match_on = "polr", 61 | trimming = FALSE, 62 | model_options = list(reference_level = sort(W)[1]), 63 | M_matches = 3, 64 | J_var_matches = 2 65 | ) 66 | } 67 | -------------------------------------------------------------------------------- /data_raw/simulate_data.R: -------------------------------------------------------------------------------- 1 | 2 | set.seed(111) 3 | n <- 5000*6 4 | # X1-X3 3 MVN var 2, 1, 1, covars 1, -1, -.5 5 | vars <- c(2,1,1) 6 | covars <- c(1,-1,-.5) 7 | mu <- c(0,0,0) 8 | tau <- 1 9 | Sigma <- diag(vars) 10 | Sigma[2,1] <- Sigma[1,2] <- covars[1] 11 | Sigma[3,1] <- Sigma[1,3] <- covars[2] 12 | Sigma[3,2] <- Sigma[2,3] <- covars[3] 13 | trt1 <- 100; trt1 14 | trt2 <- 100; trt2 15 | trt3 <- 100; trt3 16 | # draw Xs 17 | X13 <- MASS::mvrnorm(n,mu=mu,Sigma=Sigma, empirical = FALSE) 18 | X1 <- X13[,1] 19 | X2 <- X13[,2] 20 | X3 <- X13[,3] 21 | X4 <- runif(n,-3,3) 22 | X5 <- rchisq(n, df=1) 23 | X6 <- rbinom(n,size=1,prob=.5) 24 | 25 | xb2 <- 0.1*(X1^2+X2+X3+X4+X5+X6) 26 | xb3 <- 0.1*(X1+X2^2+X3^2+X4+X5+X6) 27 | exb2<-exp(xb2) 28 | exb3<-exp(xb3) 29 | pi1<-1/(1+exp(xb2)+exp(xb3)) 30 | pi2<-exp(xb2)/(1+exp(xb2)+exp(xb3)) 31 | pi3<-exp(xb3)/(1+exp(xb2)+exp(xb3)) 32 | pi<-cbind(pi1,pi2,pi3) 33 | apply(pi,2,mean) 34 | 35 | W<-matrix(NA,n,4) 36 | colnames(W) <- c("W1","W2","W3","W") 37 | for(kk in 1:n){ 38 | W[kk,1:3]<-rmultinom(1, 1, prob = pi[kk,]) 39 | } 40 | 41 | sim.dat <- data.frame(W,X1,X2,X3,X4,X5,X6) 42 | trt1.keep <- sample(which(sim.dat$W1==1),trt1,replace=FALSE) 43 | trt2.keep <- sample(which(sim.dat$W2==1),trt2,replace=FALSE) 44 | trt3.keep <- sample(which(sim.dat$W3==1),trt3,replace=FALSE) 45 | sim.dat <- sim.dat[c(trt1.keep,trt2.keep,trt3.keep),] 46 | sim.dat[,"W"]<-sim.dat[,"W1"]+2*sim.dat[,"W2"]+3*sim.dat[,"W3"] 47 | # sim.dat[,"W"]<-as.factor(sim.dat[,"W"]) 48 | W <- sim.dat[,"W"] 49 | X <- as.matrix(sim.dat[,names(sim.dat)[-c(1:4)]]) 50 | X1 <- X[,"X1"]; X2 <- X[,"X2"]; X3 <- X[,"X3"]; X4 <- X[,"X4"]; X5 <- X[,"X5"];X6 <- X[,"X6"] 51 | 52 | # outcome: treatment effect is zero 53 | u <- rnorm(nrow(X)) 54 | # ouctome (linear) 55 | Y <- (W==1)*( X1 + X2 + X3 + X4 + X5-1 + X6-0.5)+ 56 | (W==2)*(2*X1 + 3*X2 + X3 + 2*X4 + 2*(X5-1) + 2*(X6-0.5))+ 57 | (W==3)*(3*X1 + X2 + 2*X3 - X4 - (X5-1) - (X6-0.5))+u 58 | 59 | 60 | simulated_data <- sim.dat[, -(1:2)] 61 | 62 | names(simulated_data) <- c( 63 | "outcome", 64 | "treatment", 65 | paste0("covar", 1:6) 66 | ) 67 | simulated_data$outcome <- Y 68 | row.names(simulated_data) <- NULL 69 | 70 | save( 71 | simulated_data, 72 | file = rprojroot::find_package_root_file("data", "simulated_data.RData") 73 | ) 74 | -------------------------------------------------------------------------------- /docs/docsearch.js: -------------------------------------------------------------------------------- 1 | $(function() { 2 | 3 | // register a handler to move the focus to the search bar 4 | // upon pressing shift + "/" (i.e. "?") 5 | $(document).on('keydown', function(e) { 6 | if (e.shiftKey && e.keyCode == 191) { 7 | e.preventDefault(); 8 | $("#search-input").focus(); 9 | } 10 | }); 11 | 12 | $(document).ready(function() { 13 | // do keyword highlighting 14 | /* modified from https://jsfiddle.net/julmot/bL6bb5oo/ */ 15 | var mark = function() { 16 | 17 | var referrer = document.URL ; 18 | var paramKey = "q" ; 19 | 20 | if (referrer.indexOf("?") !== -1) { 21 | var qs = referrer.substr(referrer.indexOf('?') + 1); 22 | var qs_noanchor = qs.split('#')[0]; 23 | var qsa = qs_noanchor.split('&'); 24 | var keyword = ""; 25 | 26 | for (var i = 0; i < qsa.length; i++) { 27 | var currentParam = qsa[i].split('='); 28 | 29 | if (currentParam.length !== 2) { 30 | continue; 31 | } 32 | 33 | if (currentParam[0] == paramKey) { 34 | keyword = decodeURIComponent(currentParam[1].replace(/\+/g, "%20")); 35 | } 36 | } 37 | 38 | if (keyword !== "") { 39 | $(".contents").unmark({ 40 | done: function() { 41 | $(".contents").mark(keyword); 42 | } 43 | }); 44 | } 45 | } 46 | }; 47 | 48 | mark(); 49 | }); 50 | }); 51 | 52 | /* Search term highlighting ------------------------------*/ 53 | 54 | function matchedWords(hit) { 55 | var words = []; 56 | 57 | var hierarchy = hit._highlightResult.hierarchy; 58 | // loop to fetch from lvl0, lvl1, etc. 59 | for (var idx in hierarchy) { 60 | words = words.concat(hierarchy[idx].matchedWords); 61 | } 62 | 63 | var content = hit._highlightResult.content; 64 | if (content) { 65 | words = words.concat(content.matchedWords); 66 | } 67 | 68 | // return unique words 69 | var words_uniq = [...new Set(words)]; 70 | return words_uniq; 71 | } 72 | 73 | function updateHitURL(hit) { 74 | 75 | var words = matchedWords(hit); 76 | var url = ""; 77 | 78 | if (hit.anchor) { 79 | url = hit.url_without_anchor + '?q=' + escape(words.join(" ")) + '#' + hit.anchor; 80 | } else { 81 | url = hit.url + '?q=' + escape(words.join(" ")); 82 | } 83 | 84 | return url; 85 | } 86 | -------------------------------------------------------------------------------- /man/estimateTrtModel.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/estimateTrtModel.R 3 | \name{estimateTrtModel} 4 | \alias{estimateTrtModel} 5 | \title{Estimate Treatment Model for Generalized Propensity Scores} 6 | \usage{ 7 | estimateTrtModel(W, X, match_on, model_options, ...) 8 | } 9 | \arguments{ 10 | \item{W}{A treatment vector (1 x n) with numerical values indicating 11 | treatment groups} 12 | 13 | \item{X}{A covariate matrix (p x n) with no intercept. When 14 | match_on="existing", then X must be a vector (1 x n) of user-specified 15 | propensity scores.} 16 | 17 | \item{match_on}{User specifies "covariates" to match on raw covariates, or 18 | "existing" to match on user-supplied propensity score values, or "polr" or 19 | "multinom" to fit a propensity score model.} 20 | 21 | \item{model_options}{A list of the options to pass to propensity model. 22 | Currently under development. Can only pass reference level to multinomial 23 | logistic regression.} 24 | 25 | \item{...}{the dots argument} 26 | } 27 | \value{ 28 | A list element with two items: \itemize{ 29 | \item \code{prop_score_model} the fitted model object 30 | \item \code{prop_score_ests} the estimated generalized propensity scores 31 | for each individual in the dataset 32 | } 33 | } 34 | \description{ 35 | This function is used to fit the model for the generalized propensity score. 36 | Users can apply this function before \code{\link{multiMatch}} and verify that 37 | the output's fitted model object is the same as the user desires. 38 | } 39 | \details{ 40 | Note that the \code{model_options} argument must be a list with 41 | \code{reference_level} element. Future versions of this package may allow 42 | for the user to supply a fitted model object directly to 43 | \code{\link{multiMatch}}; to request this feature, users should go to the 44 | GitHub repository and fill out an Issue requesting it. 45 | } 46 | \examples{ 47 | 48 | sim_data <- multilevelMatching::simulated_data 49 | Y <- sim_data$outcome 50 | W <- sim_data$treatment 51 | X <- as.matrix(sim_data[ ,-(1:2)]) 52 | names(Y) <- paste0("ID", 1:length(Y)) 53 | 54 | trimming <- FALSE 55 | method <- c("covariates", "polr", "multinom")[2] 56 | 57 | prepared_data <- prepareData( 58 | Y = Y, 59 | W = W, 60 | X = X, 61 | match_on = "polr", 62 | trimming = FALSE, 63 | model_options = list(reference_level = sort(W)[1]), 64 | M_matches = 3, 65 | J_var_matches = 2 66 | ) 67 | 68 | trt_model <- do.call(estimateTrtModel, prepared_data) 69 | estimated_generalized_propensity_scores <- trt_model$prop_score_ests 70 | 71 | } 72 | -------------------------------------------------------------------------------- /man/multilevelGPSStratification.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/multilevelGPSStratification.R 3 | \name{multilevelGPSStratification} 4 | \alias{multilevelGPSStratification} 5 | \title{Stratification on GPS with multilevel treatments} 6 | \usage{ 7 | multilevelGPSStratification(Y, W, X, NS, GPSM = "multinomiallogisticReg", 8 | linearp = 0, nboot) 9 | } 10 | \arguments{ 11 | \item{Y}{A continuous response vector (1 x n)} 12 | 13 | \item{W}{A treatment vector (1 x n) with numerical values indicating 14 | treatment groups} 15 | 16 | \item{X}{A covariate matrix (p x n) with no intercept} 17 | 18 | \item{NS}{The number of strata: (only required in the function 19 | \code{\link{multilevelGPSStratification}})} 20 | 21 | \item{GPSM}{An indicator of the methods used for estimating GPS, options 22 | include "multinomiallogisticReg", "ordinallogisticReg", and "existing"} 23 | 24 | \item{linearp}{An indicator of subclassification on GPS (=0) or linear 25 | predictor of GPS (=1): (only required in the function 26 | \code{\link{multilevelGPSStratification}})} 27 | 28 | \item{nboot}{The number of boot replicates for variance estimation: (only 29 | required in the function \code{\link{multilevelGPSStratification}})} 30 | } 31 | \value{ 32 | A list with two elements, 33 | \code{tauestimate}, \code{varestimate}, where \code{tauestimate} is a 34 | vector of estimates for pairwise treatment effects, and \code{varestimate} 35 | is a vector of variance estimates, using bootstrapping method. 36 | } 37 | \description{ 38 | Stratification on GPS with multilevel treatments 39 | } 40 | \examples{ 41 | 42 | simulated_data <- multilevelMatching::simulated_data 43 | set.seed(123) 44 | multilevelGPSStratification( 45 | Y = simulated_data$outcome , 46 | W = simulated_data$treatment, 47 | X = simulated_data[ ,names(simulated_data) \%in\% paste0("covar", 1:6)], 48 | GPSM = "multinomiallogisticReg", 49 | NS = 5, 50 | linearp = TRUE, 51 | nboot = 10 52 | ) 53 | 54 | } 55 | \references{ 56 | Yang, S., Imbens G. W., Cui, Z., Faries, D. E., & Kadziola, Z. 57 | (2016) Propensity Score Matching and Subclassification in Observational 58 | Studies with Multi-Level Treatments. Biometrics, 72, 1055-1065. 59 | \url{https://doi.org/10.1111/biom.12505} 60 | 61 | Abadie, A., & Imbens, G. W. (2006). Large sample properties of matching 62 | estimators for average treatment effects. Econometrica, 74(1), 235-267. 63 | \url{https://doi.org/10.1111/j.1468-0262.2006.00655.x} 64 | 65 | Abadie, A., & Imbens, G. W. (2016). Matching on the estimated propensity 66 | score. Econometrica, 84(2), 781-807. 67 | \url{https://doi.org/10.3982/ECTA11293} 68 | } 69 | \seealso{ 70 | \code{\link{multilevelGPSMatch}}; \code{\link{multilevelMatchX}} 71 | } 72 | -------------------------------------------------------------------------------- /R/s3methods.R: -------------------------------------------------------------------------------- 1 | 2 | 3 | ### Methods for the multiMatch class 4 | 5 | 6 | #' Prints a summary of the estimates from a multiMatch object 7 | #' 8 | #' @param x object of class "multiMatch" 9 | #' @param ... dots 10 | #' 11 | #' @method print multiMatch 12 | #' 13 | #' @examples 14 | #' 15 | #' sim_data <- multilevelMatching::simulated_data 16 | #' Y <- sim_data$outcome 17 | #' W <- sim_data$treatment 18 | #' X <- as.matrix(sim_data[ ,-(1:2)]) 19 | #' names(Y) <- paste0("ID", 1:length(Y)) 20 | #' 21 | #' trimming <- FALSE 22 | #' method <- c("covariates", "polr", "multinom")[2] 23 | #' 24 | #' fit <- multiMatch(Y,W,X,trimming=trimming,match_on=method) 25 | #' print(fit) 26 | #' 27 | #' @export 28 | print.multiMatch <- function(x,...){ 29 | 30 | ests <- x$results 31 | # idx <- x$analysis_idx 32 | estimate_args <- x$estimate_args 33 | 34 | cat("-------------- Causal estimates ---------------\n") 35 | 36 | if (all(is.na(ests$VarianceAI2016))){ 37 | ests$VarianceAI2016 <- NULL 38 | } 39 | print(ests) 40 | 41 | second_message <- paste0( 42 | "--- Matching on '", estimate_args$match_on, 43 | "' with M=", 44 | estimate_args$M_matches, 45 | ", J=", 46 | estimate_args$J_var_matches, 47 | " ---\n" 48 | ) 49 | cat(second_message) 50 | } 51 | 52 | 53 | #' Prints a summary of a multiMatch object 54 | #' 55 | #' @param object object of class "multiMatch" 56 | #' @param ... dots 57 | #' 58 | #' @method summary multiMatch 59 | #' 60 | #' @author Brian G. Barkley 61 | #' 62 | #' 63 | #' @examples 64 | #' 65 | #' sim_data <- multilevelMatching::simulated_data 66 | #' Y <- sim_data$outcome 67 | #' W <- sim_data$treatment 68 | #' X <- as.matrix(sim_data[ ,-(1:2)]) 69 | #' names(Y) <- paste0("ID", 1:length(Y)) 70 | #' 71 | #' trimming <- FALSE 72 | #' method <- c("covariates", "polr", "multinom")[2] 73 | #' 74 | #' fit <- multiMatch(Y,W,X,trimming=trimming,match_on=method) 75 | #' summary(fit) 76 | #' 77 | #' @export 78 | summary.multiMatch <- function(object, ...){ 79 | 80 | 81 | ests <- object$results 82 | # idx <- object$analysis_idx 83 | estimate_args <- object$estimate_args 84 | 85 | cat("------------- Method arguments --------------\n") 86 | 87 | args2print <- estimate_args[c( 88 | "match_on", "model_options", "M_matches", "J_var_matches", 89 | "trt_levels", "N_per_trt" 90 | )] 91 | 92 | print(args2print) 93 | 94 | cat("------------- Causal estimates --------------\n") 95 | 96 | 97 | if (all(is.na(ests$VarianceAI2016))){ 98 | ests$VarianceAI2016 <- NULL 99 | } 100 | print(ests) 101 | 102 | cat("---------------------------------------------\n") 103 | } 104 | 105 | 106 | 107 | 108 | ### More methods for the legacy functions 109 | 110 | 111 | -------------------------------------------------------------------------------- /R/estimateTrtModel.R: -------------------------------------------------------------------------------- 1 | 2 | #' Estimate Treatment Model for Generalized Propensity Scores 3 | #' 4 | #' This function is used to fit the model for the generalized propensity score. 5 | #' Users can apply this function before \code{\link{multiMatch}} and verify that 6 | #' the output's fitted model object is the same as the user desires. 7 | #' 8 | #' Note that the \code{model_options} argument must be a list with 9 | #' \code{reference_level} element. Future versions of this package may allow 10 | #' for the user to supply a fitted model object directly to 11 | #' \code{\link{multiMatch}}; to request this feature, users should go to the 12 | #' GitHub repository and fill out an Issue requesting it. 13 | #' 14 | #' @inheritParams multiMatch 15 | #' @param ... the dots argument 16 | #' 17 | #' @return A list element with two items: \itemize{ 18 | #' \item \code{prop_score_model} the fitted model object 19 | #' \item \code{prop_score_ests} the estimated generalized propensity scores 20 | #' for each individual in the dataset 21 | #' } 22 | #' 23 | #' @export 24 | #' 25 | #' @examples 26 | #' 27 | #' sim_data <- multilevelMatching::simulated_data 28 | #' Y <- sim_data$outcome 29 | #' W <- sim_data$treatment 30 | #' X <- as.matrix(sim_data[ ,-(1:2)]) 31 | #' names(Y) <- paste0("ID", 1:length(Y)) 32 | #' 33 | #' trimming <- FALSE 34 | #' method <- c("covariates", "polr", "multinom")[2] 35 | #' 36 | #' prepared_data <- prepareData( 37 | #' Y = Y, 38 | #' W = W, 39 | #' X = X, 40 | #' match_on = "polr", 41 | #' trimming = FALSE, 42 | #' model_options = list(reference_level = sort(W)[1]), 43 | #' M_matches = 3, 44 | #' J_var_matches = 2 45 | #' ) 46 | #' 47 | #' trt_model <- do.call(estimateTrtModel, prepared_data) 48 | #' estimated_generalized_propensity_scores <- trt_model$prop_score_ests 49 | #' 50 | estimateTrtModel <- function( 51 | W, X, match_on, model_options, ... 52 | ){ 53 | if (match_on == "multinom") { 54 | W.ref <- stats::relevel(as.factor(W),ref=model_options$reference_level) 55 | temp <- utils::capture.output(prop_score_model <- nnet::multinom(W.ref~X)) 56 | prop_score_ests <- stats::fitted(prop_score_model) 57 | vcov_coeff <- stats::vcov(prop_score_model) 58 | } else 59 | if (match_on == "polr") { 60 | prop_score_model <- MASS::polr(as.factor(W)~X) 61 | prop_score_ests <- stats::fitted(prop_score_model) 62 | } else 63 | if (match_on == "existing") { 64 | prop_score_model <- NULL 65 | prop_score_ests <- X 66 | } else 67 | if (match_on == "covariates"){ 68 | prop_score_model <- NULL 69 | prop_score_ests <- NULL 70 | } else { 71 | stop("match_on not recognized") 72 | } 73 | out_list <- list( 74 | prop_score_model = prop_score_model, 75 | prop_score_ests = prop_score_ests 76 | ) 77 | if (match_on == "multinom"){out_list$vcov_coeff <- vcov_coeff} 78 | out_list 79 | } 80 | -------------------------------------------------------------------------------- /man/multilevelGPSMatch.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/multilevelGPSMatch.R 3 | \name{multilevelGPSMatch} 4 | \alias{multilevelGPSMatch} 5 | \title{Matching on GPS with multilevel treatments} 6 | \usage{ 7 | multilevelGPSMatch(Y, W, X, Trimming, GPSM = "multinomiallogisticReg") 8 | } 9 | \arguments{ 10 | \item{Y}{A continuous response vector (1 x n)} 11 | 12 | \item{W}{A treatment vector (1 x n) with numerical values indicating 13 | treatment groups} 14 | 15 | \item{X}{A covariate matrix (p x n) with no intercept. When 16 | \code{GPSM="existing"}, then \code{X} must be a vector (1 x n) of 17 | user-specified propensity scores.} 18 | 19 | \item{Trimming}{An indicator of whether trimming the sample to ensure overlap} 20 | 21 | \item{GPSM}{An indicator of the methods used for estimating GPS, options 22 | include \code{"multinomiallogisticReg"}, \code{"ordinallogisticReg"} for 23 | proportional odds or cumulative logit model, and \code{"existing"} for 24 | user-specified propensity score via the parameter \code{X}. Defaults to 25 | \code{"multinomiallogisticReg"}} 26 | } 27 | \value{ 28 | A list element including: 29 | \itemize{ 30 | 31 | \item \code{tauestimate}: A vector of estimates for pairwise treatment 32 | effects 33 | 34 | \item \code{varestimate}: A vector of variance estimates for 35 | \code{tauestimate}, using Abadie & Imbens (2006)'s method 36 | 37 | \item \code{varestimateAI2012}: A vector of variance estimates for 38 | \code{tauestimate}, when matching on the generalized propensity score, 39 | using Abadie & Imbens (2016)'s method. This variance estimate takes into account 40 | of the uncertainty in estimating the GPS. This variable is named AI2012 41 | (not AI2016) for backwards compatibility. 42 | 43 | \item \code{analysis_idx}: a list containing the indices_kept (analyzed) 44 | and indices_dropped (trimmed) based on Crump et al. (2009)'s method. 45 | 46 | } 47 | } 48 | \description{ 49 | Matching on GPS with multilevel treatments 50 | } 51 | \examples{ 52 | X <- c(5.5,10.6,3.1,8.7,5.1,10.2,9.8,4.4,4.9) 53 | Y <- c(102,105,120,130,100,80,94,108,96) 54 | W <- c(1,1,1,3,2,3,2,1,2) 55 | multilevelGPSMatch(Y,W,X,Trimming=0,GPSM="multinomiallogisticReg") 56 | multilevelGPSMatch(Y,W,X,Trimming=1,GPSM="multinomiallogisticReg") 57 | 58 | } 59 | \references{ 60 | Yang, S., Imbens G. W., Cui, Z., Faries, D. E., & Kadziola, Z. 61 | (2016) Propensity Score Matching and Subclassification in Observational 62 | Studies with Multi-Level Treatments. Biometrics, 72, 1055-1065. 63 | \url{https://doi.org/10.1111/biom.12505} 64 | 65 | Abadie, A., & Imbens, G. W. (2006). Large sample properties of matching 66 | estimators for average treatment effects. Econometrica, 74(1), 235-267. 67 | \url{https://doi.org/10.1111/j.1468-0262.2006.00655.x} 68 | 69 | Abadie, A., & Imbens, G. W. (2016). Matching on the estimated propensity 70 | score. Econometrica, 84(2), 781-807. 71 | \url{https://doi.org/10.3982/ECTA11293} 72 | 73 | Crump, R. K., Hotz, V. J., Imbens, G. W., & Mitnik, O. A. (2009). Dealing 74 | with limited overlap in estimation of average treatment effects. 75 | Biometrika, 96(1), 187-199. \url{https://doi.org/10.1093/biomet/asn055} 76 | } 77 | \seealso{ 78 | \code{\link{multilevelMatchX}}; 79 | \code{\link{multilevelGPSStratification}} 80 | } 81 | -------------------------------------------------------------------------------- /man/multiMatch.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/multiMatch.R 3 | \name{multiMatch} 4 | \alias{multiMatch} 5 | \title{Matching Estimators for Multiple Treatments from Yang et al. (2016).} 6 | \usage{ 7 | multiMatch(Y, W, X, trimming = NULL, match_on, 8 | model_options = list(reference_level = sort(W)[1]), M_matches = 1, 9 | J_var_matches = 1) 10 | } 11 | \arguments{ 12 | \item{Y}{A response vector (1 x n)} 13 | 14 | \item{W}{A treatment vector (1 x n) with numerical values indicating 15 | treatment groups} 16 | 17 | \item{X}{A covariate matrix (p x n) with no intercept. When 18 | match_on="existing", then X must be a vector (1 x n) of user-specified 19 | propensity scores.} 20 | 21 | \item{trimming}{an indicator of whether trimming the sample to ensure overlap} 22 | 23 | \item{match_on}{User specifies "covariates" to match on raw covariates, or 24 | "existing" to match on user-supplied propensity score values, or "polr" or 25 | "multinom" to fit a propensity score model.} 26 | 27 | \item{model_options}{A list of the options to pass to propensity model. 28 | Currently under development. Can only pass reference level to multinomial 29 | logistic regression.} 30 | 31 | \item{M_matches}{Number of matches per unit for imputing potential outcomes, 32 | as in Abadie and Imbens (2006).} 33 | 34 | \item{J_var_matches}{Number of matches when estimating \eqn{\sigma^2(X,W)} as 35 | in Abadie and Imbens (2006).} 36 | } 37 | \value{ 38 | A list of output from \code{estimateTau}, including at most: \itemize{ 39 | 40 | \item \code{tauestimate}: a vector of estimates for pairwise treatment 41 | effects 42 | 43 | \item \code{varestimate}: a vector of variance estimates for tauestimate, 44 | using Abadie and Imbens (2006)'s method 45 | 46 | \item \code{varestimateAI2016}: a vector of variance estimates for 47 | tauestimate, when matching on the generalized propensity score, using 48 | Abadie & Imbens (2016)'s method. This variance estimate takes into account 49 | of the uncertainty in estimating the GPS. 50 | 51 | \item \code{analysis_idx}: a list containing the indices_kept (analyzed) 52 | and indices_dropped (trimmed) based on Crump et al. (2009)'s method. 53 | 54 | } 55 | } 56 | \description{ 57 | This function carries out matching on covariates or on propensity scores, and 58 | is similar to the 'legacy' functions \code{\link{multilevelMatchX}} and 59 | \code{\link{multilevelGPSMatch}}. 60 | } 61 | \examples{ 62 | sim_data <- multilevelMatching::simulated_data 63 | Y <- sim_data$outcome 64 | W <- sim_data$treatment 65 | X <- as.matrix(sim_data[ ,-(1:2)]) 66 | names(Y) <- paste0("ID", 1:length(Y)) 67 | 68 | trimming <- FALSE 69 | method <- c("covariates", "polr", "multinom")[2] 70 | 71 | multiMatch(Y,W,X,trimming=trimming,match_on=method) 72 | 73 | 74 | } 75 | \references{ 76 | Yang, S., Imbens G. W., Cui, Z., Faries, D. E., & Kadziola, Z. 77 | (2016) Propensity Score Matching and Subclassification in Observational 78 | Studies with Multi-Level Treatments. Biometrics, 72, 1055-1065. 79 | \url{https://doi.org/10.1111/biom.12505} 80 | 81 | Abadie, A., & Imbens, G. W. (2006). Large sample properties of matching 82 | estimators for average treatment effects. econometrica, 74(1), 235-267. 83 | \url{https://doi.org/10.1111/j.1468-0262.2006.00655.x} 84 | 85 | Abadie, A., & Imbens, G. W. (2016). Matching on the estimated propensity 86 | score. Econometrica, 84(2), 781-807. 87 | \url{https://doi.org/10.3982/ECTA11293} 88 | 89 | Crump, R. K., Hotz, V. J., Imbens, G. W., & Mitnik, O. A. (2009). Dealing 90 | with limited overlap in estimation of average treatment effects. 91 | Biometrika, 96(1), 187-199. \url{https://doi.org/10.1093/biomet/asn055} 92 | } 93 | \seealso{ 94 | \code{\link{multilevelMatchX}}; \code{\link{multilevelGPSMatch}} 95 | } 96 | -------------------------------------------------------------------------------- /docs/pkgdown.js: -------------------------------------------------------------------------------- 1 | /* http://gregfranko.com/blog/jquery-best-practices/ */ 2 | (function($) { 3 | $(function() { 4 | 5 | $("#sidebar") 6 | .stick_in_parent({offset_top: 40}) 7 | .on('sticky_kit:bottom', function(e) { 8 | $(this).parent().css('position', 'static'); 9 | }) 10 | .on('sticky_kit:unbottom', function(e) { 11 | $(this).parent().css('position', 'relative'); 12 | }); 13 | 14 | $('body').scrollspy({ 15 | target: '#sidebar', 16 | offset: 60 17 | }); 18 | 19 | $('[data-toggle="tooltip"]').tooltip(); 20 | 21 | var cur_path = paths(location.pathname); 22 | var links = $("#navbar ul li a"); 23 | var max_length = -1; 24 | var pos = -1; 25 | for (var i = 0; i < links.length; i++) { 26 | if (links[i].getAttribute("href") === "#") 27 | continue; 28 | // Ignore external links 29 | if (links[i].host !== location.host) 30 | continue; 31 | 32 | var nav_path = paths(links[i].pathname); 33 | 34 | var length = prefix_length(nav_path, cur_path); 35 | if (length > max_length) { 36 | max_length = length; 37 | pos = i; 38 | } 39 | } 40 | 41 | // Add class to parent
  • , and enclosing
  • if in dropdown 42 | if (pos >= 0) { 43 | var menu_anchor = $(links[pos]); 44 | menu_anchor.parent().addClass("active"); 45 | menu_anchor.closest("li.dropdown").addClass("active"); 46 | } 47 | }); 48 | 49 | function paths(pathname) { 50 | var pieces = pathname.split("/"); 51 | pieces.shift(); // always starts with / 52 | 53 | var end = pieces[pieces.length - 1]; 54 | if (end === "index.html" || end === "") 55 | pieces.pop(); 56 | return(pieces); 57 | } 58 | 59 | // Returns -1 if not found 60 | function prefix_length(needle, haystack) { 61 | if (needle.length > haystack.length) 62 | return(-1); 63 | 64 | // Special case for length-0 haystack, since for loop won't run 65 | if (haystack.length === 0) { 66 | return(needle.length === 0 ? 0 : -1); 67 | } 68 | 69 | for (var i = 0; i < haystack.length; i++) { 70 | if (needle[i] != haystack[i]) 71 | return(i); 72 | } 73 | 74 | return(haystack.length); 75 | } 76 | 77 | /* Clipboard --------------------------*/ 78 | 79 | function changeTooltipMessage(element, msg) { 80 | var tooltipOriginalTitle=element.getAttribute('data-original-title'); 81 | element.setAttribute('data-original-title', msg); 82 | $(element).tooltip('show'); 83 | element.setAttribute('data-original-title', tooltipOriginalTitle); 84 | } 85 | 86 | if(ClipboardJS.isSupported()) { 87 | $(document).ready(function() { 88 | var copyButton = ""; 89 | 90 | $(".examples, div.sourceCode").addClass("hasCopyButton"); 91 | 92 | // Insert copy buttons: 93 | $(copyButton).prependTo(".hasCopyButton"); 94 | 95 | // Initialize tooltips: 96 | $('.btn-copy-ex').tooltip({container: 'body'}); 97 | 98 | // Initialize clipboard: 99 | var clipboardBtnCopies = new ClipboardJS('[data-clipboard-copy]', { 100 | text: function(trigger) { 101 | return trigger.parentNode.textContent; 102 | } 103 | }); 104 | 105 | clipboardBtnCopies.on('success', function(e) { 106 | changeTooltipMessage(e.trigger, 'Copied!'); 107 | e.clearSelection(); 108 | }); 109 | 110 | clipboardBtnCopies.on('error', function() { 111 | changeTooltipMessage(e.trigger,'Press Ctrl+C or Command+C to copy'); 112 | }); 113 | }); 114 | } 115 | })(window.jQuery || window.$) 116 | -------------------------------------------------------------------------------- /R/utilities.R: -------------------------------------------------------------------------------- 1 | 2 | # #' Name Two or All Columns in the Matching Matrix 3 | # #' 4 | # #' Useful when using Abadie and Imbens (2016) variance estimator 5 | # #' 6 | # #' @inheritParams matchAllTreatments 7 | nameCols <- function(trt_levels){ 8 | col_names <- lapply(trt_levels, function(x){ 9 | c(paste0("m",x, ".1"), paste0("m", x, ".2")) 10 | }) 11 | unlist(col_names) 12 | } 13 | 14 | 15 | 16 | #' Naming the matching contrasts 17 | #' 18 | #' @param trt1 Former treatment level 19 | #' @param trt2 Latter treatment level 20 | #' 21 | #' @examples 22 | #' nameContrast(trt1=1, trt2=0) 23 | #' 24 | #' @export 25 | nameContrast <- function(trt1,trt2){ paste0("EY(", trt2,")-EY(", trt1,")") } 26 | 27 | #' Naming the matching population mean mu's 28 | #' 29 | #' @param trt Treatment level 30 | #' 31 | #' @examples 32 | #' nameMu(1) 33 | #' 34 | #' @export 35 | nameMu <- function(trt){ paste0("EY(", trt,")") } 36 | 37 | 38 | # #' Defensive programming for data re-ordering 39 | # #' 40 | # #' @inheritParams multiMatch 41 | # #' @param N The number of unique units 42 | argChecks <- function(Y,W,X,N=NULL) { 43 | 44 | if ((length(W) != length(Y))) { 45 | # write a unit test here 46 | stop("length of Y must equal length of W") 47 | } 48 | if ((nrow(X) != length(Y))) { 49 | # write a unit test here 50 | stop("length of Y must equal the number of rows in matrix X (or length of X)") 51 | } 52 | if ( (!is.null(N)) && length(Y)!=N) { 53 | stop("Re-ordering data has failed; Y length has changed") 54 | } 55 | } 56 | 57 | 58 | 59 | 60 | # #' Orders the treatment increasingly 61 | # #' 62 | # #' @inheritParams setIDs 63 | # #' @param W A treatment vector (1 x n) with numerical values indicating treatment groups 64 | # #' @param X A covariate matrix (p x n) with no intercept 65 | # #' @param Y A continuous response vector (1 x n) 66 | # #' @param unit_ids_unsorted The \code{unit_ids} before the data is reordered 67 | # #' 68 | # #' @return The following elements, ordered according to levels of \code{W} 69 | # #' \itemize{ 70 | # #' 71 | # #' \item \code{W}: a treatment vector (1 x n) with numerical values indicating treatment groups 72 | # #' 73 | # #' \item \code{X}: a covariate matrix (p x n) with no intercept 74 | # #' 75 | # #' \item \code{Y}: a continuous response vector (1 x n) 76 | # # 77 | # #' } 78 | # #' along with these downstream elements of treatment: 79 | # #' \itemize{ 80 | # #' \item \code{num_trts}: number of treatment levels 81 | # #' \item \code{trt_levels}: all treatment levels 82 | # #' \item \code{N_per_trt}: number of observations by treatment level 83 | # #' \item \code{num_contrasts}: number of pairwise treatment effects 84 | # #' \item \code{orig_to_sorted}: vector to rearrange from original to sorted by treatment 85 | # #' \item \code{sorted_to_orig}: vector to rearrange from sorted to original order 86 | # #' } 87 | reorderByTreatment <- function(Y,W,X, unit_ids_unsorted){ 88 | 89 | N <- length(Y) 90 | 91 | if (!is.unsorted(W)) { 92 | # temp <- sort(W, index.return=TRUE) 93 | ## Above does not work with factor variables 94 | ## (See test_utilities.R) 95 | temp <- list(x = W) 96 | temp$ix <- 1:length(W) 97 | } else 98 | if (is.unsorted(W)) { 99 | temp <- sort(W,index.return=TRUE) 100 | } 101 | 102 | orig_to_sorted <- temp$ix 103 | sorted_to_orig <- order(temp$ix) 104 | 105 | ## Defensive programming 106 | stopifnot(identical(getIDs(W), unit_ids_unsorted)) 107 | stopifnot(identical(getIDs(Y), unit_ids_unsorted)) 108 | stopifnot(identical(getIDs(X), unit_ids_unsorted)) 109 | 110 | W <- W[orig_to_sorted] 111 | Y <- Y[orig_to_sorted] 112 | X <- X[orig_to_sorted, , drop=FALSE] 113 | 114 | 115 | unit_ids_sorted <- unit_ids_unsorted[orig_to_sorted] 116 | 117 | W <- setIDs(W, unit_ids_sorted) 118 | Y <- setIDs(Y, unit_ids_sorted) 119 | X <- setIDs(X, unit_ids_sorted) 120 | 121 | ## Defensive programming 122 | stopifnot(identical(getIDs(W)[sorted_to_orig], unit_ids_unsorted)) 123 | stopifnot(identical(getIDs(Y)[sorted_to_orig], unit_ids_unsorted)) 124 | stopifnot(identical(getIDs(X)[sorted_to_orig], unit_ids_unsorted)) 125 | 126 | ## Defensive checks, again 127 | argChecks(Y = Y, W = W, X = X, N = N) 128 | 129 | list_to_return <- list(W = W, X = X, Y = Y, N = N) 130 | 131 | ## Adding the following to output 132 | num_trts <- length(unique(W)) 133 | list_to_return$num_trts <- num_trts # number of treatment levels 134 | list_to_return$trt_levels <- unique(W) # all treatment levels 135 | list_to_return$N_per_trt <- table(W) # number of observations by treatment level 136 | list_to_return$num_contrasts <- (num_trts*(num_trts+1)/2)-num_trts # number of pairwise treatment effects 137 | list_to_return$orig_to_sorted <- orig_to_sorted 138 | list_to_return$sorted_to_orig <- sorted_to_orig 139 | list_to_return$unit_ids_unsorted <- unit_ids_unsorted 140 | list_to_return$unit_ids_sorted <- unit_ids_sorted 141 | 142 | 143 | list_to_return 144 | } 145 | -------------------------------------------------------------------------------- /R/multilevelGPSStratification.r: -------------------------------------------------------------------------------- 1 | #' Stratification on GPS with multilevel treatments 2 | #' 3 | #' @inheritParams multilevelMatchX 4 | #' @param GPSM An indicator of the methods used for estimating GPS, options 5 | #' include "multinomiallogisticReg", "ordinallogisticReg", and "existing" 6 | #' @param NS The number of strata: (only required in the function 7 | #' \code{\link{multilevelGPSStratification}}) 8 | #' @param linearp An indicator of subclassification on GPS (=0) or linear 9 | #' predictor of GPS (=1): (only required in the function 10 | #' \code{\link{multilevelGPSStratification}}) 11 | #' @param nboot The number of boot replicates for variance estimation: (only 12 | #' required in the function \code{\link{multilevelGPSStratification}}) 13 | #' 14 | #' @return A list with two elements, 15 | #' \code{tauestimate}, \code{varestimate}, where \code{tauestimate} is a 16 | #' vector of estimates for pairwise treatment effects, and \code{varestimate} 17 | #' is a vector of variance estimates, using bootstrapping method. 18 | #' 19 | #' @references Yang, S., Imbens G. W., Cui, Z., Faries, D. E., & Kadziola, Z. 20 | #' (2016) Propensity Score Matching and Subclassification in Observational 21 | #' Studies with Multi-Level Treatments. Biometrics, 72, 1055-1065. 22 | #' \url{https://doi.org/10.1111/biom.12505} 23 | #' 24 | #' Abadie, A., & Imbens, G. W. (2006). Large sample properties of matching 25 | #' estimators for average treatment effects. Econometrica, 74(1), 235-267. 26 | #' \url{https://doi.org/10.1111/j.1468-0262.2006.00655.x} 27 | #' 28 | #' Abadie, A., & Imbens, G. W. (2016). Matching on the estimated propensity 29 | #' score. Econometrica, 84(2), 781-807. 30 | #' \url{https://doi.org/10.3982/ECTA11293} 31 | #' 32 | #' @seealso \code{\link{multilevelGPSMatch}}; \code{\link{multilevelMatchX}} 33 | #' 34 | #' @examples 35 | #' 36 | #' simulated_data <- multilevelMatching::simulated_data 37 | #' set.seed(123) 38 | #' multilevelGPSStratification( 39 | #' Y = simulated_data$outcome , 40 | #' W = simulated_data$treatment, 41 | #' X = simulated_data[ ,names(simulated_data) %in% paste0("covar", 1:6)], 42 | #' GPSM = "multinomiallogisticReg", 43 | #' NS = 5, 44 | #' linearp = TRUE, 45 | #' nboot = 10 46 | #' ) 47 | #' 48 | #' @export 49 | multilevelGPSStratification <- function( 50 | Y,W,X,NS,GPSM="multinomiallogisticReg",linearp=0,nboot 51 | ){ 52 | 53 | N <- length(Y) # number of observations 54 | X <- as.matrix(X) 55 | 56 | trtnumber <- length(unique(W)) # number of treatment levels 57 | trtlevels <- unique(W) # all treatment levels 58 | pertrtlevelnumber <- table(W) # number of observations by treatment level 59 | taunumber <- trtnumber*(trtnumber+1)/2-trtnumber # number of pairwise treatment effects 60 | 61 | #GPS modeling 62 | if(GPSM=="multinomiallogisticReg"){ 63 | W.ref <- stats::relevel(as.factor(W),ref="1") 64 | temp <- utils::capture.output(PF.out <- nnet::multinom(W.ref~X)) 65 | PF.fit <- stats::fitted(PF.out) 66 | if(linearp==1){ 67 | beta <- stats::coef(PF.out) 68 | Xbeta <- X%*%t(beta[,-1]) 69 | PF.fit[,-1] <- Xbeta 70 | } 71 | } 72 | if (GPSM == "ordinallogisticReg") { 73 | PF.out <- MASS::polr(as.factor(W)~X) 74 | PF.fit <- stats::fitted(PF.out) 75 | } 76 | if (GPSM == "existing") { 77 | PF.fit <- X 78 | } 79 | 80 | meanwj<-numberwj<-matrix(NA,trtnumber,NS) 81 | 82 | for(kk in 1:trtnumber){ 83 | pwx<-PF.fit[,kk] 84 | ranking <- stats::ave(pwx,FUN=function(x){ 85 | cut(x,stats::quantile(pwx,(0:NS)/NS,type=2),include.lowest=TRUE,right=FALSE)}) 86 | #type=2 to have the same quintiles as in SAS 87 | #right=FALSE to have left side closed intervals 88 | for(jj in 1:NS){ 89 | id<-which(W==kk&ranking==jj) 90 | meanwj[kk,jj]<-mean(Y[id]) 91 | numberwj[kk,jj]<-sum(ranking==jj) # to get weighted sum at the end 92 | } 93 | numberwj<-numberwj*(1-is.na(meanwj)) 94 | meanw<-apply(meanwj*numberwj,1,sum,na.rm=TRUE)/apply(numberwj,1,sum) # to get weighted sum at the end 95 | } 96 | 97 | tauestimate<-rep(NA,taunumber) 98 | 99 | cnt<-0 100 | cname1<-c() 101 | for(jj in 1:(trtnumber-1)){ 102 | for(kk in (jj+1):trtnumber){ 103 | cnt<-cnt+1 104 | thistrt<-trtlevels[jj] 105 | thattrt<-trtlevels[kk] 106 | cname1<-c(cname1,paste(paste( 107 | paste(paste(paste("EY(",thattrt,sep=""),")",sep=""), 108 | "-EY(",sep=""),thistrt,sep=""),")",sep="")) 109 | tauestimate[cnt]<-meanw[kk]-meanw[jj] 110 | } 111 | } 112 | names(tauestimate)<-cname1 113 | 114 | 115 | ## Bootstrap the variance 116 | data<-cbind(W,Y,X) 117 | results <- boot::boot(data=data, statistic=estforboot,R=nboot, 118 | GPSM=GPSM,linearp=linearp,trtnumber=trtnumber, 119 | trtlevels=trtlevels,taunumber=taunumber,NS=NS) 120 | bootvar <- apply(results$t,2,stats::var,na.rm = TRUE) 121 | names(bootvar)<-cname1 122 | 123 | return(list(tauestimate=tauestimate,varestimate=bootvar)) 124 | } 125 | -------------------------------------------------------------------------------- /docs/articles/index.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 | Articles • multilevelMatching 10 | 11 | 12 | 13 | 14 | 15 | 16 | 17 | 18 | 19 | 20 | 21 | 22 | 23 | 24 | 25 | 26 | 27 | 28 | 29 | 30 | 31 | 32 | 33 | 34 | 35 | 36 | 37 | 38 | 39 | 40 | 41 | 45 | 46 | 47 | 48 | 49 | 50 |
    51 |
    52 | 102 | 103 | 104 |
    105 | 106 |
    107 |
    108 |
    109 |

    Articles

    110 |
    111 | 112 |
    113 |

    All vignettes

    114 |

    115 | 116 | 119 |
    120 |
    121 |
    122 | 123 |
    124 |
    125 |

    Developed by Shu Yang, Brian G. Barkley.

    126 |
    127 | 128 |
    129 |

    Site built with pkgdown 1.3.0.

    130 |
    131 |
    132 |
    133 | 134 | 135 | 136 | 137 | 138 | 139 | -------------------------------------------------------------------------------- /docs/pkgdown.css: -------------------------------------------------------------------------------- 1 | /* Sticky footer */ 2 | 3 | /** 4 | * Basic idea: https://philipwalton.github.io/solved-by-flexbox/demos/sticky-footer/ 5 | * Details: https://github.com/philipwalton/solved-by-flexbox/blob/master/assets/css/components/site.css 6 | * 7 | * .Site -> body > .container 8 | * .Site-content -> body > .container .row 9 | * .footer -> footer 10 | * 11 | * Key idea seems to be to ensure that .container and __all its parents__ 12 | * have height set to 100% 13 | * 14 | */ 15 | 16 | html, body { 17 | height: 100%; 18 | } 19 | 20 | body > .container { 21 | display: flex; 22 | height: 100%; 23 | flex-direction: column; 24 | 25 | padding-top: 60px; 26 | } 27 | 28 | body > .container .row { 29 | flex: 1 0 auto; 30 | } 31 | 32 | footer { 33 | margin-top: 45px; 34 | padding: 35px 0 36px; 35 | border-top: 1px solid #e5e5e5; 36 | color: #666; 37 | display: flex; 38 | flex-shrink: 0; 39 | } 40 | footer p { 41 | margin-bottom: 0; 42 | } 43 | footer div { 44 | flex: 1; 45 | } 46 | footer .pkgdown { 47 | text-align: right; 48 | } 49 | footer p { 50 | margin-bottom: 0; 51 | } 52 | 53 | img.icon { 54 | float: right; 55 | } 56 | 57 | img { 58 | max-width: 100%; 59 | } 60 | 61 | /* Fix bug in bootstrap (only seen in firefox) */ 62 | summary { 63 | display: list-item; 64 | } 65 | 66 | /* Typographic tweaking ---------------------------------*/ 67 | 68 | .contents .page-header { 69 | margin-top: calc(-60px + 1em); 70 | } 71 | 72 | /* Section anchors ---------------------------------*/ 73 | 74 | a.anchor { 75 | margin-left: -30px; 76 | display:inline-block; 77 | width: 30px; 78 | height: 30px; 79 | visibility: hidden; 80 | 81 | background-image: url(./link.svg); 82 | background-repeat: no-repeat; 83 | background-size: 20px 20px; 84 | background-position: center center; 85 | } 86 | 87 | .hasAnchor:hover a.anchor { 88 | visibility: visible; 89 | } 90 | 91 | @media (max-width: 767px) { 92 | .hasAnchor:hover a.anchor { 93 | visibility: hidden; 94 | } 95 | } 96 | 97 | 98 | /* Fixes for fixed navbar --------------------------*/ 99 | 100 | .contents h1, .contents h2, .contents h3, .contents h4 { 101 | padding-top: 60px; 102 | margin-top: -40px; 103 | } 104 | 105 | /* Static header placement on mobile devices */ 106 | @media (max-width: 767px) { 107 | .navbar-fixed-top { 108 | position: absolute; 109 | } 110 | .navbar { 111 | padding: 0; 112 | } 113 | } 114 | 115 | 116 | /* Sidebar --------------------------*/ 117 | 118 | #sidebar { 119 | margin-top: 30px; 120 | } 121 | #sidebar h2 { 122 | font-size: 1.5em; 123 | margin-top: 1em; 124 | } 125 | 126 | #sidebar h2:first-child { 127 | margin-top: 0; 128 | } 129 | 130 | #sidebar .list-unstyled li { 131 | margin-bottom: 0.5em; 132 | } 133 | 134 | .orcid { 135 | height: 16px; 136 | vertical-align: middle; 137 | } 138 | 139 | /* Reference index & topics ----------------------------------------------- */ 140 | 141 | .ref-index th {font-weight: normal;} 142 | 143 | .ref-index td {vertical-align: top;} 144 | .ref-index .icon {width: 40px;} 145 | .ref-index .alias {width: 40%;} 146 | .ref-index-icons .alias {width: calc(40% - 40px);} 147 | .ref-index .title {width: 60%;} 148 | 149 | .ref-arguments th {text-align: right; padding-right: 10px;} 150 | .ref-arguments th, .ref-arguments td {vertical-align: top;} 151 | .ref-arguments .name {width: 20%;} 152 | .ref-arguments .desc {width: 80%;} 153 | 154 | /* Nice scrolling for wide elements --------------------------------------- */ 155 | 156 | table { 157 | display: block; 158 | overflow: auto; 159 | } 160 | 161 | /* Syntax highlighting ---------------------------------------------------- */ 162 | 163 | pre { 164 | word-wrap: normal; 165 | word-break: normal; 166 | border: 1px solid #eee; 167 | } 168 | 169 | pre, code { 170 | background-color: #f8f8f8; 171 | color: #333; 172 | } 173 | 174 | pre code { 175 | overflow: auto; 176 | word-wrap: normal; 177 | white-space: pre; 178 | } 179 | 180 | pre .img { 181 | margin: 5px 0; 182 | } 183 | 184 | pre .img img { 185 | background-color: #fff; 186 | display: block; 187 | height: auto; 188 | } 189 | 190 | code a, pre a { 191 | color: #375f84; 192 | } 193 | 194 | a.sourceLine:hover { 195 | text-decoration: none; 196 | } 197 | 198 | .fl {color: #1514b5;} 199 | .fu {color: #000000;} /* function */ 200 | .ch,.st {color: #036a07;} /* string */ 201 | .kw {color: #264D66;} /* keyword */ 202 | .co {color: #888888;} /* comment */ 203 | 204 | .message { color: black; font-weight: bolder;} 205 | .error { color: orange; font-weight: bolder;} 206 | .warning { color: #6A0366; font-weight: bolder;} 207 | 208 | /* Clipboard --------------------------*/ 209 | 210 | .hasCopyButton { 211 | position: relative; 212 | } 213 | 214 | .btn-copy-ex { 215 | position: absolute; 216 | right: 0; 217 | top: 0; 218 | visibility: hidden; 219 | } 220 | 221 | .hasCopyButton:hover button.btn-copy-ex { 222 | visibility: visible; 223 | } 224 | 225 | /* mark.js ----------------------------*/ 226 | 227 | mark { 228 | background-color: rgba(255, 255, 51, 0.5); 229 | border-bottom: 2px solid rgba(255, 153, 51, 0.3); 230 | padding: 1px; 231 | } 232 | 233 | /* vertical spacing after htmlwidgets */ 234 | .html-widget { 235 | margin-bottom: 10px; 236 | } 237 | -------------------------------------------------------------------------------- /docs/authors.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 | Authors • multilevelMatching 10 | 11 | 12 | 13 | 14 | 15 | 16 | 17 | 18 | 19 | 20 | 21 | 22 | 23 | 24 | 25 | 26 | 27 | 28 | 29 | 30 | 31 | 32 | 33 | 34 | 35 | 36 | 37 | 38 | 39 | 40 | 41 | 45 | 46 | 47 | 48 | 49 | 50 |
    51 |
    52 | 102 | 103 | 104 |
    105 | 106 |
    107 |
    108 |
    109 |

    Authors

    110 |
    111 | 112 |
      113 |
    • 114 |

      Shu Yang. Author. 115 |

      116 |
      • 117 |
    • 118 |

      Brian G. Barkley. Author, maintainer. ORCID 119 |

      120 |
      • 121 |
    122 | 123 |
    124 | 125 |
    126 | 127 | 128 |
    129 |
    130 |

    Developed by Shu Yang, Brian G. Barkley.

    131 |
    132 | 133 |
    134 |

    Site built with pkgdown 1.3.0.

    135 |
    136 |
    137 |
    138 | 139 | 140 | 141 | 142 | 143 | 144 | -------------------------------------------------------------------------------- /tests/testthat/test_existing_GPS_matching.R: -------------------------------------------------------------------------------- 1 | 2 | context("Matching on existing GPS works (with limited discrepancy)") 3 | # skip("skip this test for now") 4 | 5 | 6 | # X<-c(5.5,10.6,3.1,8.7,5.1,10.2,9.8,4.4,4.9) 7 | Y<-c(102,105,120,130,100,80,94,108,96) 8 | W<-c(1,1,1,3,2,3,2,1,2) 9 | 10 | 11 | existing_GPS_matrix <- cbind( 12 | c(0.5, 0.3, 0.5, 0.5, 0.5, 0.3, 0.3, 0.5, 0.3), 13 | c(1,1.6, 1, 1, 1, 1.6,1.6, 1,1.6)/6, 14 | c(2, 2.6, 2, 2, 2, 2.6, 2.6, 2, 2.6)/6 15 | ) 16 | rownames(existing_GPS_matrix) <- LETTERS[6+(10:2)] 17 | 18 | set.seed(12345) 19 | 20 | run_legacy <- multilevelGPSMatch( 21 | Y=Y,W=W,X=existing_GPS_matrix, 22 | Trimming=0,GPSM="existing") 23 | 24 | test_that( 25 | "multilevelGPSMatch (with existing GPS) returns original (v0.1) output", 26 | { 27 | 28 | expect_equal( 29 | run_legacy$tauestimate, 30 | c(-8.888889, 1.111111, 10.000000), 31 | tolerance = my_tolerance, 32 | check.names = FALSE 33 | ) 34 | expect_equal( 35 | run_legacy$varestimate, 36 | c(26.01097, 578.20850, 551.50617), 37 | tolerance = my_tolerance, 38 | check.names = FALSE 39 | ) 40 | } 41 | ) 42 | 43 | 44 | set.seed(12345) 45 | run_multiMatch <- multiMatch( 46 | Y=Y, 47 | W=W, 48 | X=existing_GPS_matrix, 49 | trimming=0, 50 | match_on="existing" 51 | ) 52 | 53 | ## Some tests fail! 54 | ## I think this is when there are ties to break 55 | ## because the order of the matching process is different in multiMatch 56 | test_that( 57 | "Discrepancy when matching on existing GPS with ties", 58 | { 59 | 60 | expect_identical( 61 | object = names(run_legacy$varestimate), 62 | expected = (run_multiMatch$results)$Param 63 | ) 64 | expect_failure( 65 | expect_equal( 66 | run_legacy$tauestimate, 67 | (run_multiMatch$results)$Estimate, 68 | tolerance = my_tolerance, 69 | check.attributes = FALSE 70 | ) 71 | ) 72 | expect_failure( 73 | expect_equal( 74 | run_legacy$varestimate, 75 | (run_multiMatch$results)$Variance, 76 | tolerance = my_tolerance, 77 | check.attributes = FALSE 78 | ) 79 | ) 80 | } 81 | ) 82 | 83 | 84 | ## multiMatch has been stable for a while though. 85 | test_that( 86 | "multiMatch() on GPS with existing GPS returns same values as it used to", 87 | { 88 | run_multiMatch_orig <- readRDS(file = quickLookup("existingGPS_t4mm_orig.Rds")) 89 | 90 | names(run_multiMatch_orig$results)[6] <- "VarianceAI2016" #2018-06-10 91 | 92 | expect_equal( 93 | (run_multiMatch_orig$results) , 94 | (run_multiMatch$results) , 95 | tolerance = my_tolerance 96 | ) 97 | } 98 | ) 99 | 100 | 101 | ## Existing GPS matching via multiMatch() is not perfect, but close 102 | 103 | test_that( 104 | "multiMatch() on existing GPS returns SIMILAR to multilevelGPSMatch() from v0.1", 105 | { 106 | set.seed(11) 107 | N <- 300 108 | X <- rnorm(N, 0, 1) 109 | prW1 <- sample(size = N, x=(1:4)/10, replace = TRUE) 110 | prW2 <- (1-prW1)*sample(size = N, x=(1:4)/5, replace = TRUE) 111 | prW3 <- 1- (prW1+prW2) 112 | existing_GPS_matrix <- cbind(prW1, prW2, prW3) 113 | W <- rep(NA, N) 114 | for(ii in 1:N){ 115 | W[ii] <- sample(1:3, size = 1, replace = TRUE, 116 | prob = existing_GPS_matrix[ii,]) 117 | } 118 | Y <- round(rnorm(N, 10 - W +0.2*X, 1),1) 119 | 120 | # existing_GPS_matrix <- cbind(pr_w1, pr_w2,pr_w3) 121 | 122 | set.seed(12345) 123 | run_legacy <- multilevelGPSMatch( 124 | Y = Y, 125 | W = W, 126 | X = existing_GPS_matrix, 127 | Trimming = 0, 128 | GPSM = "existing" 129 | ) 130 | 131 | set.seed(12345) 132 | expect_message( 133 | run_multiMatch <- multiMatch( 134 | Y = Y, 135 | W = W, 136 | X = existing_GPS_matrix, 137 | trimming = 0, 138 | match_on = "existing" 139 | ) 140 | ) 141 | 142 | expect_identical( 143 | object = names(run_legacy$varestimate), 144 | expected = (run_multiMatch$results)$Param 145 | ) 146 | expect_equal( 147 | run_legacy$tauestimate, 148 | (run_multiMatch$results)$Estimate, 149 | tolerance = 0.04, 150 | check.names = FALSE 151 | ) 152 | expect_equal( 153 | run_legacy$varestimate, 154 | (run_multiMatch$results)$Variance, 155 | tolerance = 0.008, 156 | check.attributes = FALSE 157 | ) 158 | } 159 | ) 160 | 161 | 162 | 163 | ## When there are no ties, the multiMatch() may return the same thing as orig 164 | 165 | test_that( 166 | paste( 167 | "multiMatch on GPS with existing GPS agrees with multilevelGPSMatch", 168 | "output when there are no ties to break in the existing GPS" 169 | ), { 170 | 171 | 172 | 173 | 174 | eX <- existing_GPS_matrix+rnorm(27,0,0.01) 175 | eX <- eX / rowSums(eX) 176 | set.seed(12345) 177 | 178 | run_multiMatch_eX <- multiMatch( 179 | Y=Y,W=W,X=eX, 180 | trimming=0,match_on="existing" 181 | ) 182 | 183 | 184 | set.seed(12345) 185 | run_legacy_eX <- multilevelGPSMatch( 186 | Y=Y,W=W,X=eX,Trimming=0,GPSM="existing" 187 | ) 188 | 189 | expect_equal( 190 | run_legacy_eX$tauestimate, 191 | (run_multiMatch_eX$results)$Estimate, 192 | tolerance = my_tolerance, 193 | check.names = FALSE 194 | ) 195 | expect_equal( 196 | run_legacy_eX$varestimate, 197 | (run_multiMatch_eX$results)$Variance, 198 | tolerance = my_tolerance, 199 | check.names = FALSE 200 | ) 201 | 202 | }) 203 | -------------------------------------------------------------------------------- /tests/testthat/test_multiMatch.R: -------------------------------------------------------------------------------- 1 | 2 | context("test_multiMatch() versus legacy matching funs") 3 | 4 | 5 | X <- matrix(c(5.5,10.6,3.1,8.7,5.1,10.2,9.8,4.4,4.9), ncol=1) 6 | Y <- matrix(c(102,105,120,130,100,80,94,108,96), ncol=1) 7 | W <- matrix(c(1, 1, 1, 3, 2, 3, 2, 1, 2), ncol=1) 8 | 9 | 10 | existing_GPS_matrix <- cbind( 11 | c(0.5, 0.3, 0.5, 0.5, 0.5, 0.3, 0.3, 0.5, 0.3), 12 | c(1,1.6, 1, 1, 1, 1.6,1.6, 1,1.6)/6, 13 | c(2, 2.6, 2, 2, 2, 2.6, 2.6, 2, 2.6)/6 14 | ) 15 | eps_legacy <- multilevelGPSMatch( 16 | Y = Y, 17 | W = W, 18 | X = existing_GPS_matrix, 19 | Trimming = 0, 20 | GPSM = "existing" 21 | ) 22 | 23 | expect_message( 24 | eps_multiMatch <- multiMatch( 25 | Y = Y, 26 | W = W, 27 | X = existing_GPS_matrix, 28 | trimming = 0, 29 | match_on = "existing" 30 | ) 31 | ) 32 | 33 | 34 | ## Matching on "existing" is not passing when ties are present 35 | ## For more tests, see test_existing_GPS_matching.R script. 36 | test_that( 37 | "Discrepancy when matching on existing GPS between multiMatch() and multilvelGPSMatch()", 38 | { 39 | 40 | 41 | expect_identical( 42 | object = names(eps_legacy$varestimate), 43 | expected = (eps_multiMatch$results)$Param 44 | ) 45 | expect_failure( 46 | expect_equal( 47 | object = eps_legacy$tauestimate, 48 | expected = (eps_multiMatch$results)$Estimate, 49 | tolerance = 1e-7, 50 | check.names = FALSE 51 | ) 52 | ) 53 | expect_failure( 54 | expect_equal( 55 | object = eps_legacy$varestimate, 56 | expected = (eps_multiMatch$results)$Variance, 57 | tolerance = 1e-7, 58 | check.names = FALSE 59 | ) 60 | ) 61 | 62 | } 63 | ) 64 | 65 | 66 | ## not passing tests 67 | test_that("match on GPS with existing GPS DOES NOT RETURN same output", { 68 | 69 | # Fails testthat::test() but passes devtools::check() ?? 70 | # expect_failure( 71 | # expect_equal( (eps_legacy$results)$Estimate, 72 | # c( -8.000000 , 1.777778 , 9.777778), 73 | # tolerance = my_tolerance) 74 | # ) 75 | 76 | expect_failure( 77 | expect_equal( (eps_legacy$results)$Variance, 78 | c( 18.04938 ,573.25377, 552.78464), 79 | tolerance = my_tolerance) 80 | ) 81 | }) 82 | 83 | test_that( 84 | "multiMatch() on existing GPS has discrepant results when ties present", 85 | { 86 | expect_failure( 87 | expect_equal( 88 | (eps_multiMatch$results)$Estimate, 89 | c( -8.000000 , 1.777778 , 9.777778), 90 | tolerance = my_tolerance 91 | ) 92 | ) 93 | 94 | expect_failure( 95 | expect_equal( 96 | (eps_multiMatch$results)$Variance, 97 | c( 18.04938 ,573.25377, 552.78464), 98 | tolerance = my_tolerance 99 | ) 100 | ) 101 | } 102 | ) 103 | 104 | 105 | 106 | test_that( 107 | "multinom-matching works same between multiMatch() and legacy", 108 | { 109 | 110 | ## old function 111 | mnom_legacy <- multilevelGPSMatch(Y,W,X,Trimming=0,GPSM="multinomiallogisticReg") 112 | 113 | # new function 114 | expect_message( 115 | mnom_multiMatch <- 116 | multiMatch(Y, W, X, trimming=0, match_on = "multinom") 117 | ) 118 | 119 | expect_identical( 120 | object = names(mnom_legacy$varestimate), 121 | expected = (mnom_multiMatch$results)$Param 122 | ) 123 | 124 | expect_equal( 125 | object = mnom_legacy$tauestimate, 126 | expected = (mnom_multiMatch$results)$Estimate, 127 | tolerance = 1e-7, 128 | check.names = FALSE 129 | ) 130 | 131 | expect_equal( 132 | object = mnom_legacy$varestimate, 133 | expected = (mnom_multiMatch$results)$Variance, 134 | tolerance = 1e-7, 135 | check.names = FALSE 136 | ) 137 | expect_equal( 138 | object = mnom_legacy$varestimateAI2012, 139 | expected = (mnom_multiMatch$results)$VarianceAI2016, 140 | tolerance = 1e-7, 141 | check.names = FALSE 142 | ) 143 | } 144 | ) 145 | 146 | 147 | 148 | 149 | 150 | 151 | test_that( 152 | "polr-matching works same between multiMatch() and legacy", 153 | { 154 | 155 | ##old 156 | polr_legacy <- multilevelGPSMatch(Y,W,X,Trimming=0,GPSM="ordinallogisticReg") 157 | #new 158 | expect_message( 159 | polr_multiMatch <- 160 | multiMatch(Y, W, X, trimming=0, match_on = "polr") 161 | ) 162 | 163 | expect_identical( 164 | object = names(polr_legacy$varestimate), 165 | expected = (polr_multiMatch$results)$Param 166 | ) 167 | 168 | expect_equal( 169 | object = polr_legacy$tauestimate, 170 | expected = (polr_multiMatch$results)$Estimate, 171 | tolerance = 1e-7, 172 | check.names = FALSE 173 | ) 174 | 175 | expect_equal( 176 | object = polr_legacy$varestimate, 177 | expected = (polr_multiMatch$results)$Variance, 178 | tolerance = 1e-7, 179 | check.names = FALSE 180 | ) 181 | expect_equal( 182 | object = polr_legacy$varestimateAI2012, 183 | expected = (polr_multiMatch$results)$VarianceAI2016, 184 | tolerance = 1e-7, 185 | check.names = FALSE 186 | ) 187 | } 188 | ) 189 | 190 | 191 | 192 | 193 | 194 | test_that( 195 | "covariate-matching works same between multiMatch() and legacy", 196 | { 197 | ## old 198 | covar_legacy <- multilevelMatchX(Y=Y,W=W,X=X) 199 | 200 | ## new 201 | expect_message( 202 | covar_multiMatch <- 203 | multiMatch(Y=Y,W=W,X=X,trimming=0,match_on="covariates") 204 | ) 205 | 206 | expect_identical( 207 | object = names(covar_legacy$varestimate), 208 | expected = (covar_multiMatch$results)$Param 209 | ) 210 | 211 | expect_equal( 212 | object = covar_legacy$tauestimate, 213 | expected = (covar_multiMatch$results)$Estimate, 214 | tolerance = 1e-7, 215 | check.names = FALSE 216 | ) 217 | 218 | expect_equal( 219 | object = covar_legacy$varestimate, 220 | expected = (covar_multiMatch$results)$Variance, 221 | tolerance = 1e-7, 222 | check.names = FALSE 223 | ) 224 | } 225 | ) 226 | 227 | -------------------------------------------------------------------------------- /docs/reference/nameCols.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 | Name Two or All Columns in the Matching Matrix — nameCols • multilevelMatching 10 | 11 | 12 | 13 | 14 | 15 | 16 | 17 | 18 | 19 | 20 | 21 | 22 | 23 | 24 | 25 | 26 | 27 | 28 | 29 | 30 | 31 | 32 | 33 | 34 | 35 | 36 | 37 | 38 | 39 | 40 | 41 | 42 | 43 | 44 | 48 | 49 | 50 | 51 | 52 | 53 |
    54 |
    55 | 105 | 106 | 107 |
    108 | 109 |
    110 |
    111 |
    112 |

    Name Two or All Columns in the Matching Matrix

    113 | 114 | 115 |
    116 | 117 |
    118 | 119 |

    Useful when using Abadie and Imbens (2016) variance estimator

    120 | 121 |
    122 | 123 | 
    nameCols(trt_levels)
    124 | 125 |

    Arguments

    126 | 127 | 128 | 129 | 130 | 132 | 133 |
    trt_levels

    A vector (of length num_trts providing the unique 131 | treatment levels

    134 | 135 | 136 |
    137 | 144 |
    145 | 146 |
    147 |
    148 |

    Developed by Shu Yang, Brian G. Barkley.

    149 |
    150 | 151 |
    152 |

    Site built with pkgdown 1.3.0.

    153 |
    154 |
    155 |
    156 | 157 | 158 | 159 | 160 | 161 | 162 | -------------------------------------------------------------------------------- /docs/reference/nameMu.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 | Naming the matching population mean mu's — nameMu • multilevelMatching 10 | 11 | 12 | 13 | 14 | 15 | 16 | 17 | 18 | 19 | 20 | 21 | 22 | 23 | 24 | 25 | 26 | 27 | 28 | 29 | 30 | 31 | 32 | 33 | 34 | 35 | 36 | 37 | 38 | 39 | 40 | 41 | 42 | 43 | 44 | 48 | 49 | 50 | 51 | 52 | 53 |
    54 |
    55 | 105 | 106 | 107 |
    108 | 109 |
    110 |
    111 |
    112 |

    Naming the matching population mean mu's

    113 | 114 | 115 |
    116 | 117 |
    118 | 119 |

    Naming the matching population mean mu's

    120 | 121 |
    122 | 123 | 
    nameMu(trt)
    124 | 125 |

    Arguments

    126 | 127 | 128 | 129 | 130 | 131 | 132 |
    trt

    Treatment level

    133 | 134 | 135 |

    Examples

    136 | 
     nameMu(1)
    #> [1] "EY(1)"
    
137 |
    138 |
    139 | 148 |
    149 | 150 |
    151 |
    152 |

    Developed by Shu Yang, Brian G. Barkley.

    153 |
    154 | 155 |
    156 |

    Site built with pkgdown 1.3.0.

    157 |
    158 |
    159 |
    160 | 161 | 162 | 163 | 164 | 165 | 166 | -------------------------------------------------------------------------------- /docs/reference/getIDs.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 | Get/grab identifiers from vector/matrix/dataframe — getIDs • multilevelMatching 10 | 11 | 12 | 13 | 14 | 15 | 16 | 17 | 18 | 19 | 20 | 21 | 22 | 23 | 24 | 25 | 26 | 27 | 28 | 29 | 30 | 31 | 32 | 33 | 34 | 35 | 36 | 37 | 38 | 39 | 40 | 41 | 42 | 43 | 44 | 48 | 49 | 50 | 51 | 52 | 53 |
    54 |
    55 | 105 | 106 | 107 |
    108 | 109 |
    110 |
    111 |
    112 |

    Get/grab identifiers from vector/matrix/dataframe

    113 | 114 | 115 |
    116 | 117 |
    118 | 119 |

    This is a helper function for determineIDs

    120 | 121 |
    122 | 123 | 
    getIDs(x)
    124 | 125 |

    Arguments

    126 | 127 | 128 | 129 | 130 | 131 | 132 |
    x

    An object

    133 | 134 |

    Value

    135 | 136 |

    names(x), row.names(x), or NULL.

    137 | 138 | 139 |
    140 | 149 |
    150 | 151 |
    152 |
    153 |

    Developed by Shu Yang, Brian G. Barkley.

    154 |
    155 | 156 |
    157 |

    Site built with pkgdown 1.3.0.

    158 |
    159 |
    160 |
    161 | 162 | 163 | 164 | 165 | 166 | 167 | -------------------------------------------------------------------------------- /docs/reference/overlap.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 | Function to determine overlap from Crump et al. (2009)'s method. — overlap • multilevelMatching 10 | 11 | 12 | 13 | 14 | 15 | 16 | 17 | 18 | 19 | 20 | 21 | 22 | 23 | 24 | 25 | 26 | 27 | 28 | 29 | 30 | 31 | 32 | 33 | 34 | 35 | 36 | 37 | 38 | 39 | 40 | 41 | 42 | 43 | 44 | 48 | 49 | 50 | 51 | 52 | 53 |
    54 |
    55 | 105 | 106 | 107 |
    108 | 109 |
    110 |
    111 |
    112 |

    Function to determine overlap from Crump et al. (2009)'s method.

    113 | 114 | 115 |
    116 | 117 |
    118 | 119 |

    Function to determine overlap from Crump et al. (2009)'s method.

    120 | 121 |
    122 | 123 | 
    overlap(PF.fit)
    124 | 125 |

    Arguments

    126 | 127 | 128 | 129 | 130 | 131 | 132 |
    PF.fit

    fitted propensity model

    133 | 134 |

    References

    135 | 136 |

    Crump, R. K., Hotz, V. J., Imbens, G. W., & Mitnik, O. A. (2009). 137 | Dealing with limited overlap in estimation of average treatment effects. 138 | Biometrika, 96(1), 187-199. https://doi.org/10.1093/biomet/asn055

    139 | 140 | 141 |
    142 | 151 |
    152 | 153 |
    154 |
    155 |

    Developed by Shu Yang, Brian G. Barkley.

    156 |
    157 | 158 |
    159 |

    Site built with pkgdown 1.3.0.

    160 |
    161 |
    162 |
    163 | 164 | 165 | 166 | 167 | 168 | 169 | -------------------------------------------------------------------------------- /docs/reference/nameContrast.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 | Naming the matching contrasts — nameContrast • multilevelMatching 10 | 11 | 12 | 13 | 14 | 15 | 16 | 17 | 18 | 19 | 20 | 21 | 22 | 23 | 24 | 25 | 26 | 27 | 28 | 29 | 30 | 31 | 32 | 33 | 34 | 35 | 36 | 37 | 38 | 39 | 40 | 41 | 42 | 43 | 44 | 48 | 49 | 50 | 51 | 52 | 53 |
    54 |
    55 | 105 | 106 | 107 |
    108 | 109 |
    110 |
    111 |
    112 |

    Naming the matching contrasts

    113 | 114 | 115 |
    116 | 117 |
    118 | 119 |

    Naming the matching contrasts

    120 | 121 |
    122 | 123 | 
    nameContrast(trt1, trt2)
    124 | 125 |

    Arguments

    126 | 127 | 128 | 129 | 130 | 131 | 132 | 133 | 134 | 135 | 136 |
    trt1

    Former treatment level

    trt2

    Latter treatment level

    137 | 138 | 139 |

    Examples

    140 | 
      nameContrast(trt1=1, trt2=0)
    #> [1] "EY(0)-EY(1)"
    
141 |
    142 |
    143 | 152 |
    153 | 154 |
    155 |
    156 |

    Developed by Shu Yang, Brian G. Barkley.

    157 |
    158 | 159 |
    160 |

    Site built with pkgdown 1.3.0.

    161 |
    162 |
    163 |
    164 | 165 | 166 | 167 | 168 | 169 | 170 | -------------------------------------------------------------------------------- /R/estimateTau.R: -------------------------------------------------------------------------------- 1 | # #' Calculate the estimates of population-level estimands (e.g., \code{tau}). 2 | # #' 3 | # #' This is a major plumbing function for the package. All matching procedures 4 | # #' are carried out in \code{\link{matchImputePO}} (for point estimates) and 5 | # #' \code{\link{estSigSq}} (for variance), which are subfunctions of 6 | # #' \code{\link{matchAllTreatments}}. Most of the necessary arguments to this 7 | # #' function are output from these two subfunctions. 8 | # #' 9 | # #' @inheritParams estimateTrtModel 10 | # #' @inheritParams multiMatch 11 | # #' @param trt_levels A vector of the unique levels of treatment W 12 | # #' @param num_trts A scalar for the number of treatment levels 13 | # #' @param num_contrasts A scalar for the number of tau contrasts to estimate 14 | # #' @param N A scalar for the number of rows in the data 15 | # #' @param Yiw A matrix of all imputed potential outcomes 16 | # #' @param mean_Yiw A vector of the estimated mean w.r.t. each treatment w 17 | # #' @param Kiw A vector of times each unit is matched to 18 | # #' @param sigsqiw Estimated sigma squared (variance), from Abadie and Imbens 19 | # #' (2006) 20 | # #' 21 | # #' @seealso \code{\link{multiMatch}} 22 | # #' 23 | # #' @return A list, including the tidy dataframes estimates of target estimands 24 | # #' 25 | # #' 26 | # #' @references Yang, S., Imbens G. W., Cui, Z., Faries, D. E., & Kadziola, Z. 27 | # #' (2016) Propensity Score Matching and Subclassification in Observational 28 | # #' Studies with Multi-Level Treatments. Biometrics, 72, 1055-1065. 29 | # #' \url{https://doi.org/10.1111/biom.12505} 30 | # #' 31 | # #' Abadie, A., & Imbens, G. W. (2006). Large sample properties of 32 | # #' matching estimators for average treatment effects. econometrica, 74(1), 33 | # #' 235-267. \url{https://doi.org/10.1111/j.1468-0262.2006.00655.x} 34 | # #' 35 | estimateTau <- function( 36 | trt_levels, mean_Yiw, 37 | num_trts, num_contrasts, N, M_matches, 38 | Yiw, Kiw, sigsqiw, W, 39 | ... 40 | ){ 41 | 42 | blank_vec <- rep(NA, num_contrasts) 43 | tau_dfm <- list( 44 | # stringsAsFactors = FALSE, row.names = NULL, 45 | # Easier to construct this as a list object 46 | Param = blank_vec, 47 | Trt1 = blank_vec, 48 | Trt2 = blank_vec, 49 | Estimate = blank_vec, 50 | Variance = blank_vec, 51 | VarianceAI2016 = blank_vec 52 | ) 53 | 54 | 55 | mu_dfm <- data.frame( 56 | Param = nameMu(trt_levels), 57 | Trt = trt_levels, 58 | Estimate = mean_Yiw, 59 | stringsAsFactors = FALSE, 60 | row.names = NULL 61 | ) 62 | 63 | row_num <- 0 64 | 65 | for(jj in 1:(num_trts-1)){ 66 | for(kk in (jj+1):num_trts){ 67 | row_num <- row_num+1 68 | 69 | tau_dfm$Trt1[row_num] <- trt_levels[jj] 70 | tau_dfm$Trt2[row_num] <- trt_levels[kk] 71 | tau_dfm$Param[row_num] <- nameContrast(trt1=tau_dfm$Trt1[row_num], trt2=tau_dfm$Trt2[row_num]) 72 | tau_dfm$Estimate[row_num] <- mean_Yiw[kk]-mean_Yiw[jj] 73 | tau_dfm$Variance[row_num] <- estVarAI2006( 74 | N = N, W = W, Kiw = Kiw, sigsqiw = sigsqiw, M_matches = M_matches, 75 | Yiw1 = Yiw[,kk], 76 | Yiw2 = Yiw[,jj], 77 | trt_level_1 = tau_dfm$Trt1[row_num], 78 | trt_level_2 = tau_dfm$Trt2[row_num], 79 | tau = tau_dfm$Estimate[row_num] 80 | ) 81 | } 82 | } 83 | 84 | tau_dfm <- 85 | as.data.frame(tau_dfm, stringsAsFactors = FALSE, row.names = NULL) 86 | results <- list( 87 | tau_dfm = tau_dfm, 88 | mu_dfm = mu_dfm 89 | ) 90 | results 91 | } 92 | 93 | # #' Computes Estimated Asymptotic Variance of matching estimators. 94 | # #' 95 | # #' See Theorem 7 of Abadie and Imbens (2006) Econometrica for the formula. 96 | # #' 97 | # #' @inheritParams estimateTau 98 | # #' @inheritParams multiMatch 99 | # #' @param tau Estimated value of \eqn{\tau(W_1, W_2)}. 100 | # #' @param trt_level_1 Unique treatment level 1; aka \eqn{W_1} in \eqn{\tau(W_1, 101 | # #' W_2)} 102 | # #' @param trt_level_2 Unique treatment level 2; aka \eqn{W_2} in \eqn{\tau(W_1, 103 | # #' W_2)} 104 | # #' @param Yiw1 Vector of imputed outcomes for all units for \code{trt_level_2}. 105 | # #' @param Yiw2 Vector of imputed outcomes for all units for \code{trt_level_2}. 106 | # #' 107 | # #' @return A single numeric value for the estimated asymptotic variance of the 108 | # #' estimator. 109 | # #' 110 | # #' @references Abadie, A., & Imbens, G. W. (2006). Large sample properties of 111 | # #' matching estimators for average treatment effects. econometrica, 74(1), 112 | # #' 235-267. \url{https://doi.org/10.1111/j.1468-0262.2006.00655.x} 113 | # #' 114 | # #' 115 | estVarAI2006 <- function( 116 | N, W, M_matches, 117 | trt_level_1, trt_level_2, 118 | Yiw1, Yiw2, tau, Kiw, sigsqiw 119 | ){ 120 | 121 | Y_contrasts <- (Yiw1-Yiw2)-tau 122 | Y_contrasts_sq <- Y_contrasts^2 123 | ## Estimating variance of conditional mean 124 | V_taux <- mean(Y_contrasts_sq) 125 | 126 | K_M_var_factor <- calcKMVarFactor(Kiw, M_matches) 127 | W_indicator <- (W == trt_level_1 | W == trt_level_2) 128 | ## Estimating conditional variance 129 | V_E <- mean( K_M_var_factor * sigsqiw * W_indicator ) 130 | 131 | ## Estimating marginal variance 132 | ## From Theorem 7, page 251 of Abadie and Imbens 2006 Econometrica 133 | V_hat <- V_taux + V_E 134 | estimated_asymptotic_variance <- (1/N)*(V_hat) 135 | 136 | estimated_asymptotic_variance 137 | } 138 | 139 | #' Calculate the variance component for number of times unit is a match. 140 | #' 141 | #' This function calculates \code{K_M_var_factor}, a numeric vector. Each entry in 142 | #' this vector is a function of the number of times each unit is matched to, aka 143 | #' \eqn{K_M(i)} (corresponding to \code{Kiw}, where \eqn{M} corresponds to \code{M_matches}. The calculation 144 | #' in this function comes from Theorem 7, page 251 of Abadie and Imbens (2006) 145 | #' Econometrica. The \code{K_M_var_factor} is an important component in the variance 146 | #' estimation, created in the function \code{estVarAI2006} in 147 | #' \code{estimateTau}. 148 | #' 149 | #' @inheritParams multiMatch 150 | #' @param Kiw A vector of times each unit is matched to 151 | #' 152 | #' @return A numeric vector. 153 | #' 154 | #' This function is exported for use in other packages. 155 | #' 156 | #' @references Abadie, A., & Imbens, G. W. (2006). Large sample properties of 157 | #' matching estimators for average treatment effects. econometrica, 74(1), 158 | #' 235-267. \url{https://doi.org/10.1111/j.1468-0262.2006.00655.x} 159 | #' 160 | #' @examples 161 | #' calcKMVarFactor(Kiw = 2, M_matches = 4) 162 | #' 163 | #' @export 164 | calcKMVarFactor <- function(Kiw, M_matches){ 165 | (Kiw/M_matches)^2 + ( (2*M_matches-1)/(M_matches) ) * (Kiw/M_matches) 166 | } 167 | -------------------------------------------------------------------------------- /docs/reference/argChecks.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 | Defensive programming for data re-ordering — argChecks • multilevelMatching 10 | 11 | 12 | 13 | 14 | 15 | 16 | 17 | 18 | 19 | 20 | 21 | 22 | 23 | 24 | 25 | 26 | 27 | 28 | 29 | 30 | 31 | 32 | 33 | 34 | 35 | 36 | 37 | 38 | 39 | 40 | 41 | 42 | 43 | 44 | 48 | 49 | 50 | 51 | 52 | 53 |
    54 |
    55 | 105 | 106 | 107 |
    108 | 109 |
    110 |
    111 |
    112 |

    Defensive programming for data re-ordering

    113 | 114 | 115 |
    116 | 117 |
    118 | 119 |

    Defensive programming for data re-ordering

    120 | 121 |
    122 | 123 | 
    argChecks(Y, W, X, N = NULL)
    124 | 125 |

    Arguments

    126 | 127 | 128 | 129 | 130 | 131 | 132 | 133 | 134 | 136 | 137 | 138 | 139 | 142 | 143 | 144 | 145 | 146 | 147 |
    Y

    A response vector (1 x n)

    W

    A treatment vector (1 x n) with numerical values indicating 135 | treatment groups

    X

    A covariate matrix (p x n) with no intercept. When 140 | match_on="existing", then X must be a vector (1 x n) of user-specified 141 | propensity scores.

    N

    The number of unique units

    148 | 149 | 150 |
    151 | 158 |
    159 | 160 |
    161 |
    162 |

    Developed by Shu Yang, Brian G. Barkley.

    163 |
    164 | 165 |
    166 |

    Site built with pkgdown 1.3.0.

    167 |
    168 |
    169 |
    170 | 171 | 172 | 173 | 174 | 175 | 176 | -------------------------------------------------------------------------------- /tests/testthat/test_1_toy_output.R: -------------------------------------------------------------------------------- 1 | 2 | context("toy dataset results") 3 | # skip("skip this test for now") 4 | 5 | 6 | X <- matrix(c(5.5,10.6,3.1,8.7,5.1,10.2,9.8,4.4,4.9), ncol=1) 7 | Y <- matrix(c(102,105,120,130,100,80,94,108,96), ncol=1) 8 | rownames(Y) <- letters[4+(1:9)] 9 | W <- matrix(c(1, 1, 1, 3, 2, 3, 2, 1, 2), ncol=1) 10 | existing_GPS_matrix <- cbind( 11 | c(0.5, 0.3, 0.5, 0.5, 0.5, 0.3, 0.3, 0.5, 0.3), 12 | c(1,1.6, 1, 1, 1, 1.6,1.6, 1,1.6)/6, 13 | c(2, 2.6, 2, 2, 2, 2.6, 2.6, 2, 2.6)/6 14 | ) 15 | 16 | my_tolerance <- 0.0001 17 | Param_names <- c( "EY(2)-EY(1)", "EY(3)-EY(1)" ,"EY(3)-EY(2)") 18 | Trt1s <- c(1,1,2) 19 | Trt2s <- c(2,3,3) 20 | 21 | 22 | 23 | # t4 <- multilevelGPSMatch(Y=Y,W=W,X=existing_GPS_matrix,Trimming=0,GPSM="existing") 24 | ## Tests for matching on existing GPS are 25 | ## moved to test_existing_GPS_matching.R 26 | ## 27 | ## In summary, multiMatch() can sometimes produce slightly different results 28 | ## than multilevelGPSMatching(), like when there are ties. 29 | 30 | 31 | # t_factorW <- multilevelMatchX(Y, as.factor(W), X) 32 | ## Tests for when W is a factor not yet implemented; issue BarkleyBG/#1 33 | 34 | 35 | test_that("multilevelMatchX() on one X returns same output as v0.1", { 36 | run_legacyX <- multilevelMatchX(Y, W, X) 37 | 38 | expect_equal( 39 | object = run_legacyX$tauestimate, 40 | expected = c( -10.666667, 6.666667 , 17.333333), 41 | tolerance = my_tolerance, 42 | check.names = FALSE 43 | ) 44 | expect_equal( 45 | object = run_legacyX$varestimate, 46 | expected = c( 9.111111 ,615.580247, 613.925926), 47 | tolerance = my_tolerance, 48 | check.names = FALSE 49 | ) 50 | expect_identical( 51 | object = names(run_legacyX$tauestimate), 52 | expected = Param_names 53 | ) 54 | expect_identical( 55 | object = as.numeric(substr(names(run_legacyX$tauestimate),10,10)), 56 | expected = Trt1s 57 | ) 58 | expect_identical( 59 | object = as.numeric(substr(names(run_legacyX$tauestimate),4,4)), 60 | expected = Trt2s 61 | ) 62 | }) 63 | 64 | ## More tests between multiMatch() and multilevelMatchX() are in other files 65 | test_that( 66 | "multiMatch() returns same as multilevelMatchX() on one covariate", 67 | { 68 | run_legacy <- multilevelMatchX(Y, W, X) 69 | run_multiMatch <- multiMatch(Y, W, X, match_on = "covariates") 70 | 71 | ## Test the parameter orders 72 | expect_identical( 73 | object = names(run_legacy$tauestimate), 74 | expected = run_multiMatch$results$Param 75 | ) 76 | ## Test the estimates values 77 | expect_equal( 78 | object = run_legacy$tauestimate, 79 | expected = run_multiMatch$results$Estimate, 80 | tolerance = 1e-7, 81 | check.names = FALSE 82 | ) 83 | ## Test the variance estimates values 84 | expect_equal( 85 | object = run_legacy$varestimate, 86 | expected = run_multiMatch$results$Variance, 87 | tolerance = 1e-7, 88 | check.names = FALSE 89 | ) 90 | } 91 | ) 92 | 93 | 94 | 95 | 96 | 97 | 98 | test_that( 99 | "multilevelGPSMatch() with one X, no tri, returns same output as v0.1", 100 | { 101 | run_legacyGPS <- multilevelGPSMatch(Y,W,X,Trimming=0,GPSM="multinomiallogisticReg") 102 | 103 | tests_data <- quickLookup("test_toy_output.Rdata") 104 | load(tests_data) 105 | 106 | 107 | 108 | expect_equal( 109 | object = run_legacyGPS$tauestimate, 110 | expected = c( -10.444444 , 6.666667 , 17.111111), 111 | tolerance = my_tolerance, 112 | check.names = FALSE 113 | ) 114 | expect_equal( 115 | object = run_legacyGPS$varestimate, 116 | expected = c( 8.545953, 616.913580 ,611.122085), 117 | tolerance = my_tolerance, 118 | check.names = FALSE 119 | ) 120 | expect_equal( 121 | object = run_legacyGPS$varestimateAI2012, 122 | expected = c( 8.302024, 411.456234 ,434.247037), 123 | tolerance = my_tolerance, 124 | check.names = FALSE 125 | ) 126 | expect_identical( 127 | object = names(run_legacyGPS$tauestimate), 128 | expected = Param_names 129 | ) 130 | expect_identical( 131 | object = as.numeric(substr(names(run_legacyGPS$tauestimate),10,10)), 132 | expected = Trt1s 133 | ) 134 | expect_identical( 135 | object = as.numeric(substr(names(run_legacyGPS$tauestimate),4,4)), 136 | expected = Trt2s 137 | ) 138 | } 139 | ) 140 | 141 | test_that( 142 | "multilevelGPSMatch() one X and trimming returns same output as v0.1", 143 | { 144 | 145 | run_legacyGPS <- multilevelGPSMatch(Y,W,X,Trimming=1,GPSM="multinomiallogisticReg") 146 | 147 | expect_equal( 148 | object = run_legacyGPS$tauestimate, 149 | expected = c( -9.375 , 5.875, 15.250), 150 | tolerance = my_tolerance, 151 | check.names = FALSE 152 | ) 153 | expect_equal( 154 | object = run_legacyGPS$varestimate, 155 | expected = c( 7.794922 ,582.654297 ,576.304688), 156 | tolerance = my_tolerance, 157 | check.names = FALSE 158 | ) 159 | expect_equal( 160 | object = run_legacyGPS$varestimateAI2012, 161 | expected = c( 5.072057 ,383.848575, 430.978089), 162 | tolerance = my_tolerance, 163 | check.names = FALSE 164 | ) 165 | expect_identical( 166 | object = names(run_legacyGPS$tauestimate), 167 | expected = Param_names 168 | ) 169 | expect_identical( 170 | object = as.numeric(substr(names(run_legacyGPS$tauestimate),10,10)), 171 | expected = Trt1s 172 | ) 173 | expect_identical( 174 | object = as.numeric(substr(names(run_legacyGPS$tauestimate),4,4)), 175 | expected = Trt2s 176 | ) 177 | 178 | 179 | } 180 | ) 181 | 182 | 183 | test_that( 184 | "multilevelMatchX() with one-column matrix X returns same output as v0.1", 185 | { 186 | 187 | run_legacyX <- multilevelMatchX(Y, W, as.matrix(X)) 188 | 189 | 190 | expect_equal( 191 | object = run_legacyX$tauestimate, 192 | expected = c( -10.666667 , 6.666667 , 17.333333), 193 | tolerance = my_tolerance, 194 | check.names = FALSE 195 | ) 196 | expect_equal( 197 | object = run_legacyX$varestimate, 198 | expected = c( 9.111111 ,615.580247, 613.925926), 199 | tolerance = my_tolerance, 200 | check.names = FALSE 201 | ) 202 | expect_identical( 203 | object = names(run_legacyX$tauestimate), 204 | expected = Param_names 205 | ) 206 | expect_identical( 207 | object = as.numeric(substr(names(run_legacyX$tauestimate),10,10)), 208 | expected = Trt1s 209 | ) 210 | expect_identical( 211 | object = as.numeric(substr(names(run_legacyX$tauestimate),4,4)), 212 | expected = Trt2s 213 | ) 214 | 215 | 216 | } 217 | ) 218 | -------------------------------------------------------------------------------- /docs/reference/setIDs.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 | Set identifiers from vector/matrix/dataframe — setIDs • multilevelMatching 10 | 11 | 12 | 13 | 14 | 15 | 16 | 17 | 18 | 19 | 20 | 21 | 22 | 23 | 24 | 25 | 26 | 27 | 28 | 29 | 30 | 31 | 32 | 33 | 34 | 35 | 36 | 37 | 38 | 39 | 40 | 41 | 42 | 43 | 44 | 48 | 49 | 50 | 51 | 52 | 53 |
    54 |
    55 | 105 | 106 | 107 |
    108 | 109 |
    110 |
    111 |
    112 |

    Set identifiers from vector/matrix/dataframe

    113 | 114 | 115 |
    116 | 117 |
    118 | 119 |

    This is a helper function for determineIDs

    120 | 121 |
    122 | 123 | 
    setIDs(x, unit_ids)
    124 | 125 |

    Arguments

    126 | 127 | 128 | 129 | 130 | 131 | 132 | 133 | 134 | 135 | 136 |
    x

    An object

    unit_ids

    Character vector to identify study units.

    137 | 138 |

    Value

    139 | 140 |

    The object x after setting its names(x), 141 | row.names(x), or rownames(x) to unit_ids.

    142 | 143 | 144 |
    145 | 154 |
    155 | 156 |
    157 |
    158 |

    Developed by Shu Yang, Brian G. Barkley.

    159 |
    160 | 161 |
    162 |

    Site built with pkgdown 1.3.0.

    163 |
    164 |
    165 |
    166 | 167 | 168 | 169 | 170 | 171 | 172 | -------------------------------------------------------------------------------- /README.Rmd: -------------------------------------------------------------------------------- 1 | --- 2 | output: github_document 3 | --- 4 | 5 | 6 | 7 | 8 | [![CRAN_Status_Badge](http://www.r-pkg.org/badges/version/multilevelMatching)](https://cran.r-project.org/package=multilevelMatching) 9 | [![lifecycle](https://img.shields.io/badge/lifecycle-stable-brightgreen.svg)](https://www.tidyverse.org/lifecycle/#stable) 10 | [![Travis-CI Build Status](https://travis-ci.org/shuyang1987/multilevelMatching.svg?branch=master)](https://travis-ci.org/shuyang1987/multilevelMatching) 11 | [![AppveyorCI Build status](https://ci.appveyor.com/api/projects/status/eu7vlcbu2j854cdo?svg=true)](https://ci.appveyor.com/project/BarkleyBG/multilevelmatching-3hh85) 12 | [![Coverage status](https://codecov.io/gh/shuyang1987/multilevelMatching/branch/master/graph/badge.svg)](https://codecov.io/github/shuyang1987/multilevelMatching?branch=master) 13 | 14 | 15 | ```{r, echo = FALSE} 16 | knitr::opts_chunk$set( 17 | collapse = TRUE, 18 | comment = "#>", 19 | # fig.path = "README-" 20 | fig.path = "man/figures/README-" 21 | ) 22 | ``` 23 | 24 | # multilevelMatching 25 | 26 | 27 | ### Propensity Score Matching and Subclassification in Observational Studies with Multi-Level Treatments 28 | 29 | Installation: 30 | 31 | ```{r, eval = FALSE} 32 | devtools::install_github("shuyang1987/multilevelMatching") 33 | ``` 34 | 35 | 36 | ### Visit the [package website](https://shuyang1987.github.io/multilevelMatching/) 37 | 38 | 39 | # Description 40 | 41 | 42 | This package implements methods to estimate causal effects from observational studies when there are 2+ distinct levels of treatment (i.e., "multilevel treatment") using matching estimators, as introduced in [Yang et al. (2016) Biometrics](https://doi.org/10.1111/biom.12505). Matching on covariates, and matching or stratification on modeled propensity scores, are made available. These methods require matching on only a scalar function of generalized propensity scores. For more information, see the Extended Description below or the main paper: 43 | 44 | - Yang, S., Imbens G. W., Cui, Z., Faries, D. E., & Kadziola, Z. (2016) Propensity Score Matching and Subclassification in Observational Studies with Multi-Level Treatments. *Biometrics*, 72, 1055-1065. https://doi.org/10.1111/biom.12505 45 | 46 | 47 | Visit the [package website](https://shuyang1987.github.io/multilevelMatching/) 48 | 49 | 50 | # Estimators available 51 | 52 | - Matching on raw covariates: via `multiMatch()` and `multilevelMatchX()` 53 | - Matching on estimated propensity scores: via `multiMatch()` and `multilevelGPSMatch()` 54 | - using ordinal logistic regression 55 | - using multinomial logistic regression 56 | - This method also provides two types of variance estimates 57 | - using user-provided propensity score values 58 | - This method does not provide variance estimates 59 | - Stratification on propensity scores: via `multilevelGPSStratification()` 60 | 61 | # Tutorial 62 | 63 | This is a brief tutorial; an extended tutorial is provided in the vignette for [version 1.0.0](https://github.com/shuyang1987/multilevelMatching/releases/). 64 | We will use the dataset provided with this package 65 | 66 | ```{r} 67 | library(multilevelMatching) 68 | simulated_data <- multilevelMatching::simulated_data 69 | knitr::kable(head(simulated_data), digits = 2) 70 | ``` 71 | 72 | We restructure the dataframe slightly, and use identifying names for the observations: 73 | 74 | ```{r} 75 | outcome <- simulated_data$outcome 76 | treatment <- simulated_data$treatment 77 | covar_matrix <- as.matrix( 78 | simulated_data[ ,names(simulated_data) %in% paste0("covar", 1:6)] 79 | ) 80 | identifying_names <- paste0( 81 | rep(letters[1:25],each = 12), rep(letters[1:25], 12) 82 | ) 83 | names(treatment) <- identifying_names 84 | ``` 85 | 86 | ## Matching on covariates 87 | 88 | ```{r} 89 | set.seed(123) 90 | fit <- multiMatch( 91 | Y = outcome, 92 | W = treatment, 93 | X = covar_matrix, 94 | match_on = "covariates" 95 | ) 96 | 97 | fit 98 | ``` 99 | 100 | ## Matching on the Estimated Generalized Propensity Score (GPS) 101 | 102 | Propensity scores can be estimated with either of the following options 103 | 104 | - `match_on="multinom"` for multinomial logistic regression from `nnet::multinom()` 105 | - `match_on="polr"` for ordinal logistic regression from `MASS::polr()` 106 | - Or, estimated propensity scores can be supplied via the `X` argument when `match_on="existing"` 107 | 108 | ```{r} 109 | match_on <- "multinom" 110 | # match_on <- "polr" 111 | 112 | set.seed(123) 113 | fit2 <- multiMatch( 114 | Y = outcome, 115 | W = treatment, 116 | X = covar_matrix, 117 | match_on = match_on, 118 | trimming = FALSE 119 | ) 120 | 121 | fit 122 | ``` 123 | 124 | 125 | Please see the vignette for an extended tutorial. 126 | 127 | # Extended Description 128 | 129 | ## Matching with 3 or more levels of treatment 130 | 131 | In setting with where 3 or more levels of treatment (i.e., multilevel treatment), our goal is to estimate pairwise average treatment effects from a common population using matching methods. 132 | 133 | This goal can not be acheived by matching one treatment with another one at a time, since the pairwise matched samples may differ from the target population systematically, and thus they are not compatitable. One implication is that from this approach, it is possible that treatment A is better than treatment B, treatment B is better than treatment C, and treatment C is better than treatment A. 134 | 135 | We focus on estimating the average values of potential outcomes for each treatment level by matching methods, which facilitate estimation of pairwise average treatment effects for a common population. 136 | 137 | The estimation methods include generalized propensity score (GPS) matching, GPS stratification, matching with the full set of covariates, matching with the full set of GPS vector. Note that GPS matching and GPS straticication only require matching on a scalar function when estimating the average value of the potential outcome at a particular treatment level, which reduces the matching dimension to one, regardless of the number of covariates and the number of treatment levels. 138 | 139 | In order to ensure sufficient overlap, [Crump et al. (2009)](https://doi.org/10.1093/biomet/asn055)'s trimming method can be extended to this setting as well. 140 | 141 | 142 | # News 143 | 144 | See [the News site](https://shuyang1987.github.io/multilevelMatching/news/index.html) for the changelog. 145 | 146 | #### A note on `multiMatch()` 147 | 148 | The `multiMatch()` function may return slightly different estimates than the original 2 matching functions in certain circumstances. We attempt to ensure that the functions implement are identical methods up to perhaps random number generation. Please file an issue if you have any questions or concerns. 149 | -------------------------------------------------------------------------------- /docs/reference/simulated_data.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 | Simulated dataset for multilevelMatching package — simulated_data • multilevelMatching 10 | 11 | 12 | 13 | 14 | 15 | 16 | 17 | 18 | 19 | 20 | 21 | 22 | 23 | 24 | 25 | 26 | 27 | 28 | 29 | 30 | 31 | 32 | 33 | 34 | 35 | 39 | 40 | 41 | 42 | 43 | 44 | 45 | 46 | 47 | 51 | 52 | 53 | 54 | 55 | 56 |
    57 |
    58 | 108 | 109 | 110 |
    111 | 112 |
    113 |
    114 |
    115 |

    Simulated dataset for multilevelMatching package

    116 | 117 | 118 |
    119 | 120 |
    121 | 122 |

    This is a dataset with six baseline covariates, one column indicating 123 | treatment level, and one column indicating post-treatment outcome. This 124 | simulated data is purely for illustration, and any combination of the 125 | covariates can be assumed to sufficient to meet conditional exchangeability.

    126 | 127 |
    128 | 129 | 
    simulated_data
    130 | 131 |

    Format

    132 | 133 |

    A data frame with 300 rows and 8 variables:

    134 |
    outcome

    Outcome of interest

    135 |
    treatment

    Treatment level of the unit

    136 |
    covar1

    Baseline covariate 1

    137 |
    covar2

    Baseline covariate 2

    138 |
    covar3

    Baseline covariate 3

    139 |
    covar4

    Baseline covariate 4

    140 |
    covar5

    Baseline covariate 5

    141 |
    covar6

    Baseline covariate 6

    142 |
    143 | 144 |

    Source

    145 | 146 |

    http://www.diamondse.info/

    147 | 148 | 149 |
    150 | 160 |
    161 | 162 |
    163 |
    164 |

    Developed by Shu Yang, Brian G. Barkley.

    165 |
    166 | 167 |
    168 |

    Site built with pkgdown 1.3.0.

    169 |
    170 |
    171 |
    172 | 173 | 174 | 175 | 176 | 177 | 178 | -------------------------------------------------------------------------------- /R/estSigSq.R: -------------------------------------------------------------------------------- 1 | 2 | 3 | # #' Perform matching methods to estimate variance for one treatment level 4 | # #' 5 | # #' This function executes the matching methods to estimate the components for 6 | # #' estimating the variance (sigma squared) of the matching estimator. All 7 | # #' matching methods (specified with \code{match_on}) will estimate the variance 8 | # #' as in Abadie and Imbens (2006). When \code{match_on = "multinom"} this function 9 | # #' will carry out additional matching procedures to estimate the variance as 10 | # #' described in Abadie and Imbens (2016). 11 | # #' 12 | # #' @inheritParams multiMatch 13 | # #' @inheritParams matchAllTreatments 14 | # #' @inheritParams matchImputePO 15 | # #' @param var_options Options for carrying out matching for variance estimation. 16 | # #' @param N_this_trt The number of units observed to have this treatment level. 17 | # #' @param var_args_AI2016 A list of arguments for carrying out matching 18 | # #' procedures to estimate components in the \code{VarianceAI2016} variance estimates 19 | # #' (see \code{\link{calcSigSqAI2016}}). 20 | # #' 21 | # #' Note that these variance components are combined in 22 | # #' \code{\link{estimateTau}} (and perhaps \code{\link{calcSigSqAI2016}}). 23 | # #' 24 | # #' @return A list of one or two elements. \code{sigsqiw_kk} is a vector with the 25 | # #' estimated variance component for units observed to have the \code{kk}^th treatment 26 | # #' level. When \code{match_on = "multinom"}, the list will also have an 27 | # #' element for \code{match_mat_AI2016_kk_two_cols}, which is a \code{Ntot}-by-2 28 | # #' matrix with matching information that will eventually be passed to 29 | # #' \code{\link{calcSigSqAI2016}}. 30 | # #' 31 | # #' @references Abadie, A., & Imbens, G. W. (2006). Large sample properties of 32 | # #' matching estimators for average treatment effects. econometrica, 74(1), 33 | # #' 235-267. \url{https://doi.org/10.1111/j.1468-0262.2006.00655.x} 34 | # #' 35 | # #' Abadie, A., & Imbens, G. W. (2016). Matching on the estimated propensity 36 | # #' score. Econometrica, 84(2), 781-807. 37 | # #' \url{https://doi.org/10.3982/ECTA11293} 38 | estSigSq <- function( 39 | X, Y, 40 | which_same_trt, N_this_trt, 41 | var_options, 42 | match_on, 43 | var_args_AI2016 44 | ){ 45 | 46 | # # 47 | # Step 1: Prepare matching arguments # 48 | # # 49 | 50 | if ( !is.matrix(X) ) { 51 | X_mat_same_trt <- as.matrix(X[which_same_trt]) 52 | } else { 53 | X_mat_same_trt <- as.matrix(X[which_same_trt, ]) 54 | } 55 | 56 | ## Repeat trtd individuals 2x 57 | outcome_repeated <- rep(Y[which_same_trt], times=2) 58 | trt_repeated <- rep(c(1,0), each=N_this_trt) 59 | restriction_matrix <- matrix( 60 | c(1:(2*N_this_trt), 61 | rep(-1,N_this_trt)), 62 | nrow = N_this_trt, ncol = 3, byrow = FALSE 63 | ) ## restriction_matrix will not allow an individual to match to itself 64 | 65 | same_trt_match_args <- append( 66 | var_options, 67 | list( 68 | Y = outcome_repeated, 69 | Tr = trt_repeated, 70 | X = rbind(X_mat_same_trt, X_mat_same_trt), 71 | restrict = restriction_matrix 72 | ) 73 | ) 74 | 75 | # # 76 | # Step 2: Call matching procedure # 77 | # # 78 | 79 | ## Matching to estimate variance component as in Abadie&Imbens2006 80 | same_trt_match <- do.call(Matching::Match, args = same_trt_match_args) 81 | 82 | 83 | # # 84 | # Step 3: Calculate some components # 85 | # # 86 | 87 | out_sigma <- list( 88 | sigsqiw_kk = calcSigSqAI2006( 89 | match_output = same_trt_match, 90 | J_var_matches = same_trt_match_args$M 91 | ## originally J_var_matches in `multiMatch()` 92 | ) 93 | ) 94 | 95 | ## Abadie & Imbens (2016) variance estimator for multinomial logistic regression 96 | if (match_on=="multinom") { 97 | 98 | ## First, matching to find two outsiders (different treatments) closest 99 | 100 | outside_match_args <- append( 101 | var_args_AI2016$var_options_AI2016, 102 | list( 103 | Y = Y, 104 | Tr = var_args_AI2016$vec_diff_trt, ## Outsiders (between-trt-levels) 105 | X = X, 106 | M = 2 ## Two matches per unit 107 | ) 108 | ) 109 | 110 | outside_match <- do.call(Matching::Match, outside_match_args) 111 | 112 | 113 | ## Then, match to find one insider (same treatment) closest 114 | 115 | X_GPS_vec_same_trt <- X[which_same_trt] 116 | inside_match_args <- append( 117 | var_args_AI2016$var_options_AI2016, 118 | list( 119 | Y = outcome_repeated, 120 | Tr = rep(c(0,1), each=N_this_trt), 121 | X = c(X_GPS_vec_same_trt,X_GPS_vec_same_trt), ## Insiders (same treatment) 122 | restrict = restriction_matrix, ## Don't match to self 123 | M = 1 ## Only one 124 | ) 125 | ) 126 | 127 | inside_match <- do.call(Matching::Match, inside_match_args) 128 | 129 | # # 130 | # Step 4b: Organize output, again # 131 | # # 132 | 133 | mat_kk <- 134 | var_args_AI2016$match_mat_AI2016_kk_two_cols 135 | 136 | mat_kk[unique(outside_match$index.treated), ] <- 137 | matrix( outside_match$index.control, ncol=2, byrow=TRUE) 138 | 139 | mat_kk[which_same_trt,] <- 140 | matrix( c(which_same_trt, which_same_trt[inside_match$index.control]), 141 | ncol=2, byrow=FALSE) 142 | 143 | 144 | 145 | ## Add match_mat to output of estSigSq() 146 | out_sigma$match_mat_AI2016_kk_two_cols <- mat_kk 147 | } 148 | 149 | out_sigma 150 | } 151 | 152 | 153 | # #' Calculates \code{sigsqiw} 154 | # #' 155 | # #' This function estimates the conditional variance as seen in equation 14 in 156 | # #' Section 4.1 of Abadie and Imbens 2006 Econometrica. The matching procedure in 157 | # #' \code{\link{estSigSq}} matches units within the same treatment level (level 158 | # #' kk), and compares their outcomes to estimate a variance component. This 159 | # #' function was introduced to extend this variance matching procedure to 160 | # #' \code{J_var_matches >=1}, as it takes care of some of the bookkeeping aspects 161 | # #' of one-to-many matching. 162 | # #' 163 | # #' @inheritParams multiMatch 164 | # #' @param match_output Output of the \code{Matching::Match()} function for the 165 | # #' same-treatment matching, from \code{\link{estSigSq}}. 166 | # #' 167 | # #' @return A vector of the \code{sigsqiw} values for those individuals observed 168 | # #' to have the \code{kk}th treatment level 169 | calcSigSqAI2006 <- function(match_output,J_var_matches){ 170 | md <- match_output$mdata 171 | J_factor <- ( (J_var_matches)/(1+J_var_matches) ) 172 | 173 | outcomes_list <- averageMultipleMatches( 174 | num_matches = J_var_matches, 175 | orig_outcomes = md$Y[which(md$Tr==1)], 176 | matched_outcomes = md$Y[which(md$Tr==0)] 177 | ) 178 | orig_outcomes <- outcomes_list$orig_outcomes 179 | matched_outcomes <- outcomes_list$matched_outcomes 180 | 181 | ## The estimated conditional variance as in AI2006 182 | ## for those units observed to have the kk^th treatment level 183 | sigsqiw_kk <- J_factor * ( orig_outcomes - matched_outcomes )^2 184 | } 185 | 186 | -------------------------------------------------------------------------------- /docs/reference/averageMultipleMatches.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 | Plumbing function for one-to-many matches — averageMultipleMatches • multilevelMatching 10 | 11 | 12 | 13 | 14 | 15 | 16 | 17 | 18 | 19 | 20 | 21 | 22 | 23 | 24 | 25 | 26 | 27 | 28 | 29 | 30 | 31 | 32 | 33 | 34 | 35 | 37 | 38 | 39 | 40 | 41 | 42 | 43 | 44 | 45 | 49 | 50 | 51 | 52 | 53 | 54 |
    55 |
    56 | 106 | 107 | 108 |
    109 | 110 |
    111 |
    112 |
    113 |

    Plumbing function for one-to-many matches

    114 | 115 | 116 |
    117 | 118 |
    119 | 120 |

    This is called from wrangleImputations and from 121 | calcSigSqAI2006.

    122 | 123 |
    124 | 125 | 
    averageMultipleMatches(num_matches, matched_outcomes,
126 |   orig_outcomes = NULL)
    127 | 128 |

    Arguments

    129 | 130 | 131 | 132 | 133 | 134 | 135 | 136 | 137 | 139 | 140 | 141 | 142 | 146 | 147 |
    num_matches

    Either M_matches or J_var_matches

    matched_outcomes

    These are the num_matches-many imputed 138 | potential outcomes. These need to be averaged if num_matches>1.

    orig_outcomes

    When called from calcSigSqAI2006, these 143 | are repeated outcomes that simply need to be subsetted; in the case of 144 | wrangleImputations this is left to NULL and is 145 | ignored.

    148 | 149 |

    Value

    150 | 151 |

    A list including the averaged matched_outcomes, and also 152 | orig_outcomes which is sometimes NULL.

    153 | 154 | 155 |
    156 | 165 |
    166 | 167 |
    168 |
    169 |

    Developed by Shu Yang, Brian G. Barkley.

    170 |
    171 | 172 |
    173 |

    Site built with pkgdown 1.3.0.

    174 |
    175 |
    176 |
    177 | 178 | 179 | 180 | 181 | 182 | 183 | -------------------------------------------------------------------------------- /docs/reference/determineIDs.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 | Determines Unique Unit Identifiers — determineIDs • multilevelMatching 10 | 11 | 12 | 13 | 14 | 15 | 16 | 17 | 18 | 19 | 20 | 21 | 22 | 23 | 24 | 25 | 26 | 27 | 28 | 29 | 30 | 31 | 32 | 33 | 34 | 35 | 40 | 41 | 42 | 43 | 44 | 45 | 46 | 47 | 48 | 52 | 53 | 54 | 55 | 56 | 57 |
    58 |
    59 | 109 | 110 | 111 |
    112 | 113 |
    114 |
    115 |
    116 |

    Determines Unique Unit Identifiers

    117 | 118 | 119 |
    120 | 121 |
    122 | 123 |

    This function attempts to determine unique identifying information, 124 | unit_ids, for each unit in the dataset. Users can apply this function 125 | on their raw data ahead of using multiMatch to ensure that the 126 | matching procedure will work. unit_ids will be used to identify study 127 | units in some of the information output from multiMatch.

    128 | 129 |
    130 | 131 | 
    determineIDs(Y, W, X)
    132 | 133 |

    Arguments

    134 | 135 | 136 | 137 | 138 | 139 | 140 | 141 | 142 | 144 | 145 | 146 | 147 | 150 | 151 |
    Y

    A response vector (1 x n)

    W

    A treatment vector (1 x n) with numerical values indicating 143 | treatment groups

    X

    A covariate matrix (p x n) with no intercept. When 148 | match_on="existing", then X must be a vector (1 x n) of user-specified 149 | propensity scores.

    152 | 153 |

    Value

    154 | 155 |

    unit_ids

    156 | 157 | 158 |
    159 | 168 |
    169 | 170 |
    171 |
    172 |

    Developed by Shu Yang, Brian G. Barkley.

    173 |
    174 | 175 |
    176 |

    Site built with pkgdown 1.3.0.

    177 |
    178 |
    179 |
    180 | 181 | 182 | 183 | 184 | 185 | 186 | -------------------------------------------------------------------------------- /R/multilevelMatchX.r: -------------------------------------------------------------------------------- 1 | #' Matching on X with multilevel treatments 2 | #' 3 | #' @param Y A continuous response vector (1 x n) 4 | #' @param W A treatment vector (1 x n) with numerical values indicating 5 | #' treatment groups 6 | #' @param X A covariate matrix (p x n) with no intercept 7 | #' 8 | #' @return A list with 2 elements: \code{tauestimate}, \code{varestimate}, where 9 | #' \code{tauestimate} is a vector of estimates for pairwise treatment effects, 10 | #' and \code{varestimate} is a vector of variance estimates for 11 | #' \code{tauestimate}, using Abadie & Imbens (2006)'s method. 12 | #' 13 | #' @references Yang, S., Imbens G. W., Cui, Z., Faries, D. E., & Kadziola, Z. 14 | #' (2016) Propensity Score Matching and Subclassification in Observational 15 | #' Studies with Multi-Level Treatments. Biometrics, 72, 1055-1065. 16 | #' \url{https://doi.org/10.1111/biom.12505} 17 | #' 18 | #' Abadie, A., & Imbens, G. W. (2006). Large sample properties of matching 19 | #' estimators for average treatment effects. econometrica, 74(1), 235-267. 20 | #' \url{https://doi.org/10.1111/j.1468-0262.2006.00655.x} 21 | #' 22 | #' Abadie, A., & Imbens, G. W. (2016). Matching on the estimated propensity 23 | #' score. Econometrica, 84(2), 781-807. 24 | #' \url{https://doi.org/10.3982/ECTA11293} 25 | #' 26 | #' Crump, R. K., Hotz, V. J., Imbens, G. W., & Mitnik, O. A. (2009). Dealing 27 | #' with limited overlap in estimation of average treatment effects. 28 | #' Biometrika, 96(1), 187-199. \url{https://doi.org/10.1093/biomet/asn055} 29 | #' 30 | #' @seealso \code{\link{multilevelGPSMatch}}; 31 | #' \code{\link{multilevelGPSStratification}} 32 | #' 33 | #' @examples 34 | #' X<-c(5.5,10.6,3.1,8.7,5.1,10.2,9.8,4.4,4.9) 35 | #' Y<-c(102,105,120,130,100,80,94,108,96) 36 | #' W<-c(1,1,1,3,2,3,2,1,2) 37 | #' multilevelMatchX(Y,W,X) 38 | #' 39 | #' @export 40 | multilevelMatchX <- function(Y,W,X){ 41 | 42 | ## order the treatment increasingly 43 | if(1-is.unsorted(W)){ 44 | temp <- sort(W,index.return=TRUE) 45 | temp <- list(x=temp) 46 | temp$ix <- 1:length(W) 47 | } 48 | if(is.unsorted(W)){ 49 | temp <- sort(W,index.return=TRUE) 50 | } 51 | W <- W[temp$ix] 52 | N <- length(Y) # number of observations 53 | 54 | X <- as.matrix(X) 55 | X <- X[temp$ix,] 56 | Y <- Y[temp$ix] 57 | 58 | # number of treatment levels 59 | trtnumber <- length(unique(W)) 60 | # all treatment levels 61 | trtlevels <- unique(W) 62 | # number of observations by treatment level 63 | pertrtlevelnumber <- table(W) 64 | # number of pairwise treatment effects 65 | taunumber <- (trtnumber*(trtnumber+1)/2)-trtnumber 66 | 67 | # prepared_data <- prepareData_legacy( 68 | # Y=Y, W=W, X=X, 69 | # match_method = match_method#, 70 | # # Trimming = FALSE 71 | # #Trimming_fit_args 72 | # ) 73 | # W <- prepared_data$W 74 | # X <- prepared_data$X 75 | # Y <- prepared_data$Y 76 | # N <- prepared_data$N 77 | # trtnumber <- prepared_data$trtnumber 78 | # trtlevels <- prepared_data$trtlevels 79 | # pertrtlevelnumber <- prepared_data$pertrtlevelnumber 80 | # taunumber <- prepared_data$taunumber 81 | # analysis_idx <- prepared_data$analysis_idx 82 | 83 | tauestimate <- varestimate <- rep(NA,taunumber) 84 | meanw <- rep(NA,trtnumber) 85 | ## Yiw is the full imputed data set 86 | Yiw <- matrix(NA,N,trtnumber) 87 | ## Kiw is vector of number of times unit i used as a match 88 | Kiw <- sigsqiw <- matrix(NA,N,1) 89 | 90 | Matchmat <- matrix(NA,N,trtnumber*2) 91 | cname <- c() 92 | for(kk in 1:trtnumber){ 93 | thistrt <- trtlevels[kk] 94 | cname <- c(cname,c(paste(paste(paste("m",thistrt,sep=""),".",sep=""),1,sep=""), 95 | paste(paste(paste("m",thistrt,sep=""),".",sep=""),2,sep=""))) 96 | } 97 | colnames(Matchmat) <- cname 98 | 99 | 100 | for(kk in 1:trtnumber){ 101 | 102 | thistrt <- trtlevels[kk] 103 | if(kk==1){fromto <- 1:pertrtlevelnumber[1]} 104 | if(kk>1){fromto <- (1:pertrtlevelnumber[kk])+sum(pertrtlevelnumber[1:(kk-1)])} 105 | W1 <- W!=thistrt 106 | out1 <- Matching::Match(Y=Y,Tr=W1,X=X,distance.tolerance=0,ties=FALSE,Weight=2) 107 | mdata1 <- out1$mdata 108 | meanw[kk] <- stats::weighted.mean(c(Y[which(W==thistrt)],mdata1$Y[which(mdata1$Tr==0)]),c(rep(1,length(which(W==thistrt))),out1$weights)) 109 | Kiw[fromto,1] <- table(factor(out1$index.control,levels=fromto)) 110 | Yiw[which(W==thistrt),kk] <- Y[which(W==thistrt)] 111 | Yiw[which(W!=thistrt),kk] <- mdata1$Y[which(mdata1$Tr==0)] 112 | WW1 <- W==thistrt 113 | X <- as.matrix(X) 114 | out11 <- Matching::Match(Y=rep(Y[which(WW1)],times=2),Tr=rep(c(1,0),each=sum(WW1)), 115 | X=rbind(as.matrix(X[which(WW1),]),as.matrix(X[which(WW1),])),M=1,distance.tolerance=0,ties=FALSE,Weight=2, 116 | restrict=matrix(c(1:sum(WW1),(1:sum(WW1))+sum(WW1),rep(-1,sum(WW1))),nrow=sum(WW1),ncol=3,byrow=FALSE)) 117 | 118 | mdata11 <- out11$mdata 119 | temp11 <- (mdata11$Y[which(mdata11$Tr==1)]-mdata11$Y[which(mdata11$Tr==0)])^2/2 120 | sigsqiw[which(W==thistrt),1] <- temp11 121 | 122 | thiscnames <- c(paste(paste(paste("m",thistrt,sep=""),".",sep=""),1,sep=""), 123 | paste(paste(paste("m",thistrt,sep=""),".",sep=""),2,sep="")) 124 | 125 | # find two outsiders closest 126 | findmatch1 <- Matching::Match(Y=Y,Tr=W1,X=X,distance.tolerance=0,ties=FALSE,Weight=2,M=2) 127 | Matchmat[unique(findmatch1$index.treated),thiscnames] <- matrix(findmatch1$index.control,ncol=2,byrow=TRUE) 128 | # find one insider closest 129 | out111 <- Matching::Match(Y=rep(Y[which(WW1)],times=2),Tr=rep(c(0,1),each=sum(WW1)), 130 | X=rbind(as.matrix(X[which(WW1),]),as.matrix(X[which(WW1),])),M=1,distance.tolerance=0,ties=FALSE,Weight=2, 131 | restrict=matrix(c(1:sum(WW1),(1:sum(WW1))+sum(WW1),rep(-1,sum(WW1))),nrow=sum(WW1),ncol=3,byrow=FALSE)) 132 | Matchmat[which(WW1),thiscnames] <- matrix(c(which(WW1),which(WW1)[out111$index.control]),ncol=2,byrow=FALSE) 133 | 134 | } 135 | 136 | cnt <- 0 137 | cname1 <- c() 138 | for(jj in 1:(trtnumber-1)){ 139 | for(kk in (jj+1):trtnumber){ 140 | cnt <- cnt+1 141 | thistrt <- trtlevels[jj] 142 | thattrt <- trtlevels[kk] 143 | cname1 <- c(cname1,paste(paste(paste(paste(paste("EY(",thattrt,sep=""),")",sep=""),"-EY(",sep=""),thistrt,sep=""),")",sep="")) 144 | tauestimate[cnt] <- meanw[kk]-meanw[jj] 145 | varestimate[cnt] <- mean((Yiw[,kk]-Yiw[,jj]-(meanw[kk]-meanw[jj]))^2)+mean((Kiw^2+Kiw)*sigsqiw*(W==thistrt | W==thattrt)) 146 | } 147 | } 148 | varestimate <- varestimate/N 149 | names(tauestimate) <- cname1 150 | names(varestimate) <- cname1 151 | 152 | out_list <- list( 153 | tauestimate = tauestimate, 154 | varestimate = varestimate 155 | ) 156 | return(out_list) 157 | 158 | 159 | # estimate_args <- list( 160 | # trtlevels = trtlevels, 161 | # meanw = meanw, 162 | # trtnumber = trtnumber, 163 | # taunumber = taunumber, 164 | # N=N, 165 | # #also get variance estimates 166 | # Yiw=Yiw, Kiw=Kiw,sigsqiw=sigsqiw,W=W 167 | # ) 168 | # results_list <- do.call(estimateTau_legacy,estimate_args) 169 | # 170 | # 171 | # tau_dfm <- results_list$tau_dfm 172 | # 173 | # 174 | # # untidy_output <- list(tauestimate=tauestimate,varestimate=varestimate) 175 | # # tidy_output <- tidyOutput(untidy_output=untidy_output) 176 | # 177 | # 178 | # tidy_output <- list( 179 | # results = tau_dfm, 180 | # analysis_idx = analysis_idx, 181 | # mu = results_list$mu_dfm, 182 | # impute_mat = Yiw[prepared_data$sorted_to_orig,], 183 | # estimate_args = estimate_args 184 | # ) 185 | # return(tidy_output) 186 | } 187 | 188 | -------------------------------------------------------------------------------- /docs/reference/reorderByTreatment.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 | Orders the treatment increasingly — reorderByTreatment • multilevelMatching 10 | 11 | 12 | 13 | 14 | 15 | 16 | 17 | 18 | 19 | 20 | 21 | 22 | 23 | 24 | 25 | 26 | 27 | 28 | 29 | 30 | 31 | 32 | 33 | 34 | 35 | 36 | 37 | 38 | 39 | 40 | 41 | 42 | 43 | 44 | 48 | 49 | 50 | 51 | 52 | 53 |
    54 |
    55 | 105 | 106 | 107 |
    108 | 109 |
    110 |
    111 |
    112 |

    Orders the treatment increasingly

    113 | 114 | 115 |
    116 | 117 |
    118 | 119 |

    Orders the treatment increasingly

    120 | 121 |
    122 | 123 | 
    reorderByTreatment(Y, W, X, unit_ids_unsorted)
    124 | 125 |

    Arguments

    126 | 127 | 128 | 129 | 130 | 131 | 132 | 133 | 134 | 135 | 136 | 137 | 138 | 139 | 140 | 141 | 142 | 143 | 144 |
    Y

    A continuous response vector (1 x n)

    W

    A treatment vector (1 x n) with numerical values indicating treatment groups

    X

    A covariate matrix (p x n) with no intercept

    unit_ids_unsorted

    The unit_ids before the data is reordered

    145 | 146 |

    Value

    147 | 148 |

    The following elements, ordered according to levels of W

      149 |

    • W: a treatment vector (1 x n) with numerical values indicating treatment groups

      • 150 |

    • X: a covariate matrix (p x n) with no intercept

      • 151 |

    • Y: a continuous response vector (1 x n)

      • 152 |

    along with these downstream elements of treatment:

      153 |

    • num_trts: number of treatment levels

      • 154 |

    • trt_levels: all treatment levels

      • 155 |

    • N_per_trt: number of observations by treatment level

      • 156 |

    • num_contrasts: number of pairwise treatment effects

      • 157 |

    • orig_to_sorted: vector to rearrange from original to sorted by treatment

      • 158 |

    • sorted_to_orig: vector to rearrange from sorted to original order

      • 159 |
    160 | 161 | 162 | 163 |
    164 | 173 |
    174 | 175 |
    176 |
    177 |

    Developed by Shu Yang, Brian G. Barkley.

    178 |
    179 | 180 |
    181 |

    Site built with pkgdown 1.3.0.

    182 |
    183 |
    184 |
    185 | 186 | 187 | 188 | 189 | 190 | 191 | -------------------------------------------------------------------------------- /docs/reference/calcSigSqAI2006.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 | Calculates <code>sigsqiw</code> — calcSigSqAI2006 • multilevelMatching 10 | 11 | 12 | 13 | 14 | 15 | 16 | 17 | 18 | 19 | 20 | 21 | 22 | 23 | 24 | 25 | 26 | 27 | 28 | 29 | 30 | 31 | 32 | 33 | 34 | 35 | 42 | 43 | 44 | 45 | 46 | 47 | 48 | 49 | 50 | 54 | 55 | 56 | 57 | 58 | 59 |
    60 |
    61 | 111 | 112 | 113 |
    114 | 115 |
    116 |
    117 |
    118 |

    Calculates sigsqiw

    119 | 120 | 121 |
    122 | 123 |
    124 | 125 |

    This function estimates the conditional variance as seen in equation 14 in 126 | Section 4.1 of Abadie and Imbens 2006 Econometrica. The matching procedure in 127 | estSigSq matches units within the same treatment level (level 128 | kk), and compares their outcomes to estimate a variance component. This 129 | function was introduced to extend this variance matching procedure to 130 | J_var_matches >=1, as it takes care of some of the bookkeeping aspects 131 | of one-to-many matching.

    132 | 133 |
    134 | 135 | 
    calcSigSqAI2006(match_output, J_var_matches)
    136 | 137 |

    Arguments

    138 | 139 | 140 | 141 | 142 | 144 | 145 | 146 | 147 | 149 | 150 |
    match_output

    Output of the Matching::Match() function for the 143 | same-treatment matching, from estSigSq.

    J_var_matches

    Number of matches when estimating \(\sigma^2(X,W)\) as 148 | in Abadie and Imbens (2006).

    151 | 152 |

    Value

    153 | 154 |

    A vector of the sigsqiw values for those individuals observed 155 | to have the kkth treatment level

    156 | 157 | 158 |
    159 | 168 |
    169 | 170 |
    171 |
    172 |

    Developed by Shu Yang, Brian G. Barkley.

    173 |
    174 | 175 |
    176 |

    Site built with pkgdown 1.3.0.

    177 |
    178 |
    179 |
    180 | 181 | 182 | 183 | 184 | 185 | 186 | -------------------------------------------------------------------------------- /docs/reference/index.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 | Function reference • multilevelMatching 10 | 11 | 12 | 13 | 14 | 15 | 16 | 17 | 18 | 19 | 20 | 21 | 22 | 23 | 24 | 25 | 26 | 27 | 28 | 29 | 30 | 31 | 32 | 33 | 34 | 35 | 36 | 37 | 38 | 39 | 40 | 41 | 45 | 46 | 47 | 48 | 49 | 50 |
    51 |
    52 | 102 | 103 | 104 |
    105 | 106 |
    107 |
    108 |
    109 |

    Reference

    110 |
    111 | 112 | 113 | 114 | 115 | 116 | 117 | 118 | 119 | 120 | 121 | 122 | 126 | 127 | 128 | 129 | 132 | 133 | 134 | 135 | 138 | 139 | 140 | 141 | 142 | 146 | 147 | 148 | 149 | 152 | 153 | 154 | 155 | 158 | 159 | 160 | 161 | 162 | 166 | 167 | 168 | 169 | 172 | 173 | 174 | 175 |
    123 |

    Matching on raw covariates

    124 |

    125 |
    130 |

    multiMatch()

    131 |

    Matching Estimators for Multiple Treatments from Yang et al. (2016).

    136 |

    multilevelMatchX()

    137 |

    Matching on X with multilevel treatments

    143 |

    Matching on generalized propensity scores

    144 |

    145 |
    150 |

    multiMatch()

    151 |

    Matching Estimators for Multiple Treatments from Yang et al. (2016).

    156 |

    multilevelGPSMatch()

    157 |

    Matching on GPS with multilevel treatments

    163 |

    Stratification on generalized propensity scores

    164 |

    165 |
    170 |

    multilevelGPSStratification()

    171 |

    Stratification on GPS with multilevel treatments

    176 |
    177 | 178 | 186 |
    187 | 188 | 197 |
    198 | 199 | 200 | 201 | 202 | 203 | 204 | --------------------------------------------------------------------------------