# R/ivdesc.R In ivdesc: Profiling Compliers and Non-Compliers for Instrumental Variable Analysis

#### Documented in ivdesc

#' Profiling compliers and non-compliers for instrumental variable analysis
#'
#'
#' Estimates the mean and variance of a covariate for the complier, never-taker and always-taker subpopulation.
#'
#'
#' @param X vector with numeric covariate
#' @param D vector with binary treatment
#' @param Z vector with binary instrument
#' @param boot Replace all standard errors with bootstrap standard errors?
#' @param bootn number of bootstraps (ignored if \code{boot=FALSE} )
#' @param variance Calculate the variance of the covariate for each subgroup?
#' @param balance Run balance test?
#' @param ... additional arguments to be passed to \code{ivdesc_all}
#'
#' @details
#' This function estimates the mean and the associated standard error of \code{X} for the complier, never-taker and always-taker subpopulation within a sample where some, but not all, units are encouraged by instrument \code{Z} to take the treatment \code{D}.
#' Observations with missing values in either \code{X}, \code{D}, or \code{Z} are droppped (listwise deletion).
#'
#' One-sided noncompliance is supported. The mean for the always-/never-taker subpopulation will only be computed if there are at least two observed units in these subpopulations.
#'
#' If \code{boot=FALSE}, standard errors based on asymptotic theory are estimated.
#'
#' The balance test is a t-test allowing for unequal variances.
#'
#' @return
#' Returns a object \code{ivdesc} with estimates for each subgroup (\code{co}: complier, \code{nt}: never-taker, \code{at} : always-taker) and the full sample:
#'
#' \itemize{
#' 	\item \code{mu} and \code{mu_se} : Mean of \code{X} and standard error
#'  \item \code{pi} and \code{pi_se}: Proportion of each subgroup in the sample and standard error
#'  \item \code{var}: Variance of \code{X} (if \code{variance=TRUE})
#' }
#'
#' Can be coerced to a proper \code{data.frame} using \code{as.data.frame}.
#'
#' @seealso
#'
#'
#' @references
#' M. Marbach and D. Hangartner. 2020. Profiling Compliers and Non-compliers for Instrumental Variable Analysis. \emph{Political Analysis}, 28(3), 435-444.
#'
#' D. Hangartner, M. Marbach, L. Henckel, M. H. Maathuis, R. R. Kelz, and L. Keele. 2021. Profiling Compliers in Instrumental Variables Designs. Available at arXiv: \href{https://arxiv.org/abs/2103.06328}{https://arxiv.org/abs/2103.06328}.
#'
#' @examples
#'
#'
#'  # Example 1: Albertson/Lawrence (2009)
#'  # see Marbach/Hangartner (2019) for details/discussion
#'
#'  library(icsw)
#'  data(FoxDebate)
#'
#'
#'
#'
#'  \donttest{
#'
#'  # Example 2: JTPA Data
#'
#'  library(haven)
#'
#'  with(jtpa, ivdesc(age, training, assignmt, bootn=500))
#'  with(jtpa, ivdesc(hispanic, training, assignmt, boot=FALSE))
#'
#'  }
#'
#'
#'
#'
#' @importFrom knitr kable
#'
#' @export
ivdesc <- function(X,D,Z, variance=FALSE, boot=TRUE, bootn=1000, balance=TRUE, ...){

# Checks
if(!is.numeric(D)) stop("D has to be numeric with values c(0,1,NA).")
if(!is.numeric(Z)) stop("Z has to be numeric with values c(0,1,NA).")

if( sum(D %in% c(0,1,NA))!=length(D) ) stop("D can only contain values c(0,1,NA).")
if( sum(Z %in% c(0,1,NA))!=length(Z) ) stop("Z can only contain values c(0,1,NA).")

if( length(D)!=length(Z) ) stop("D has to be of the same length of Z.")
if( length(X)!=length(Z) ) stop("X has to be of the same length of Z.")
if( length(X)!=length(D) ) stop("X has to be of the same length of D.")

if( boot==TRUE & bootn<2 ) stop("bootn has be larger than 2.")

if (!is.numeric(X)){
X <- as.numeric(X)
warning("X coerced to numeric.")
}

# Listwise deletion
nomiss <- !is.na(X) & !is.na(D) & !is.na(Z)
X <- X[nomiss]
D <- D[nomiss]
Z <- Z[nomiss]

if(boot==FALSE) { boot <- 0 }
else { boot <- bootn }

if( (mean(D[Z==1]==1)-mean(D[Z==0]==1))<0 ) stop("First-stage is negative. Please reverse coding of Z.")
if( sum(D==Z)==length(D) ) stop("There is full compliance with the instrument (D=Z).")

res <- ivdesc_all(X,D,Z,boot=boot,variance=variance,...)

if( balance ){
bal <- t.test(X ~ Z, var.equal=FALSE)
attr(res, "balance_pval") <- bal\$p.value
}

class(res) <- c('ivdesc', 'data.frame')

return(res)
}

#' @method print ivdesc
#' @export
print.ivdesc <- function(x,...) {
class(x) <- 'data.frame'
print(kable(x))
pvals <- attr(x, 'pvals')
balance_pval <- attr(x, 'balance_pval')
if( !is.null(pvals) ){
cat("\nBootstrapped p-values:")
print(kable(pvals, col.names=c("group","Pr(T<t)", "Pr(T>t)")))
cat("\n\n")
} else {cat("\n")}
if( !is.null(balance_pval) ){
cat("Balance test: H0: E[X|Z=0]=E[X|Z=1]\n")
cat("Pr(|T| > |t|) = ", format(attr(x,'balance_pval'),digits=3), "\n\n")
}
invisible(x)
}


## Try the ivdesc package in your browser

Any scripts or data that you put into this service are public.

ivdesc documentation built on March 21, 2021, 1:07 a.m.