drdrtest_em.base: The base function for testing effect modifiers

Description Usage Arguments Value Examples

View source: R/drdrtest_em.R

Description

This is the base function for testing whether a discrete covariate is an effect modifier.

Usage

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
drdrtest_em.base(
  ylist,
  alist,
  pilist,
  varpilist,
  mulist,
  malist,
  arange,
  h = NULL,
  b = 1000,
  dist = "TwoPoint",
  a.grid.size = 401
)

Arguments

ylist

A list containing vectors of outcomes for each class

alist

A list containing vectors of treatment levels (dosage) for each class

pilist

A list containing vectors of propensity scores for each class

varpilist

A list containing vectors of mean propensity scores for each class

mulist

A list containing vectors of outcome regression function values for each class

malist

A list containing vectors of mean outcome regression values for each class

arange

A vector of length 2 giving the lower bound and upper bound of treatment levels

h

bandwidth to be used in kernel regression. If not specified, will by default use "rule of thumb" bandwidth selector

b

number of Bootstrap samples to be generated

dist

distibution used to generate residuals for Bootstrap samples. Currently only have two options, "TwoPoint" and "Rademachar"

a.grid.size

size of equally spaced grid points over arange to be generate for numerically evaluating the integral in test statistic

Value

A list containing

p.value:

P value of the test result

test.stat:

Value of the observed test statistic

Bootstrap.samples:

A vector containing test statistic values from Bootstrap samples

bandwidth:

Bandwidth used in kernel regression

Examples

 1
 2
 3
 4
 5
 6
 7
 8
 9
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
45
46
47
48
49
50
51
52
53
54
55
d <- 4
n <- 200
sigma <- 0.5
delta <- 1
height <-1
arange <- c(0,5)
triangle <- function(a,height){
   y <- exp(-a^2/((1/2)^2))*height
   return(y)
}
mu.mod<-function(a,l,delta,height){
   mu <- as.numeric(l%*%c(0.2,0.2,0.3,-0.1*delta))+
         triangle(a-2.5,height)+a*(-0.1*l[,1]+0.1*delta*l[,4])
   return(mu)
}
l <- matrix(rnorm(n*d),ncol=d)
l[,4] <- ifelse(l[,4]>0,1,0)
colnames(l) <- paste("l",1:4,sep="")

logit.lambda <- as.numeric(l%*%c(0.1,0.1,-0.1,0))
lambda <- exp(logit.lambda)/(1+exp(logit.lambda))
a <- rbeta(n, shape1 = lambda, shape2 =1-lambda)*5

mu <- mu.mod(a,l,delta,height)
residual.list <- rnorm(n,mean=0,sd =sigma)
y <- mu+residual.list

class_label <- l[,4]
ylist <- split(y,class_label)
alist <- split(a,class_label)
pilist <- split(pmin(dbeta(a/5,shape1=lambda,shape2=1-lambda)/5,100),class_label)
mulist <- split(mu,class_label)

varpilist <- list()
malist <- list()
for(c in c(0,1)){
   ac <- a[class_label==c]
   lc <- l[class_label==c,]

   logit.lambdac <- as.numeric(lc[rep(1:nrow(lc),nrow(lc)),]%*%c(0.1,0.1,-0.1,0))
   lambdac <- exp(logit.lambdac)/(1+exp(logit.lambdac))
   varpic <- colMeans(matrix(pmin(dbeta(rep(ac,each=length(ac))/5,
                                  shape1=lambdac,
                                  shape2 = 1-lambdac)/5,100),nrow=length(ac)))

   mac <- colMeans(matrix(mu.mod(rep(ac,each=length(ac)),
                                     lc[rep(1:nrow(lc),nrow(lc)),],
                                     delta,height),
                          nrow=length(ac)))

   varpilist[[as.character(c)]]<-varpic
   malist[[as.character(c)]] <- mac
   }
   
out <- drdrtest_em.base(ylist,alist,pilist,varpilist,mulist,malist,arange)

DRDRtest documentation built on Sept. 28, 2021, 5:07 p.m.