Learn R Programming

carat (version 1.1)

HuHuCAR: Hu and Hu's General Covariate-Adaptive Randomization

Description

Allocates patients to one of two treatments using Hu and Hu's general covariate-adaptive randomization proposed by Hu Y, Hu F (2012) <Doi:10.1214/12-AOS983>.

Usage

# S3 method for carandom
HuHuCAR(data, omega = NULL, p = 0.85)

Arguments

data

a dataframe or matrix. A row of the dataframe contains the covariate profile of some patient.

omega

the vector of weights at the overall, within-stratum, and maginal levels. It is required that at least one element is larger than 0. If omega = NULL (default), it weights the overall, within-stratum as well as marginal levels with porportion 1/cov_num.

p

the probability of assigning one patient to treatment 1. p should be larger than 1/2 to obtain balance. The default is 0.85.

Value

It returns an object of class "carandom".

The function print is used to obtain results. The generic accessor functions Cov_Assig, Diff, data, All strata and others extract various useful features of the value returned by HuHuCAR.

An object of class "carandom" is a list containing at least the following components:

cov_num

the number of covariates.

n

the number of patients.

Cov_Assign

a (cov_num + 1) * n matrix containing covariate profiles for all patients and corresponding assignments. The \(i\)th column represents the \(i\)th patient. The first cov_num rows include a patient's covariate profile and the last row contains the assignment.

All strata

a matrix containing all strata involved.

Diff

a matrix with only one column. There are final differences at the overall, within-stratum, and marginal levels.

Data Type

the data type. Real or Simulated.

Details

Consider \(I\) covariates and \(m_i\) levels for the \(i\)th covariate. \(T_j\) is the assignment of the \(j\)th ptient and \(Z_j = (k_1,\dots,k_I)\) indicates the covariate profile of this patient. For convenience, \((k_1,\dots,k_I)\) and \((i;k_i)\) denote the stratum and margin respectively. \(D_n(.)\) is the difference between the numbers of assigned patients in treatment \(1\) and treatment \(2\) at the corresponding level after \(n\) patinets have been assigned.The general CAR procedure is as follows:

(1) The first patient is assigned to treatment \(1\) with probability \(1/2\);

(2) Suppose that \(n-1\) patients have been assigned to a treatment (\(n>1\)), and the \(n\)th patient falls within \((k_1^*,\dots,k_I^*)\);

(3)If the \(n\)th patient was assigned to treatment \(1\), then the potential overall, marginal, and within-stratum differences in the two groups are $$D_n^{(1)}=D_{n-1}+1$$ $$D_n^{(1)}(i;k_i^*)=D_{n-1}(i,k_i^*)+1$$ $$D_n^{(1)}(k_1^*,\dots,k_I^*)=D_n(k_1^*,\dots,k_I^*)+1.$$ Similarly, the potential differences if the \(n\)th patinent was assigned to treatment \(1\) would be obtained in the same way.

(4) An imbalance measure is defined by $$Imb_n^{(l)}=\omega_0[D_n^{(1)}]^2+\sum_{i=1}^{I}\omega_{m,i}[D_n^{(1)}(i;k_i^*)]^2+\omega_s[D_n^{(1)}(k_1^*,\dots,k_I^*)]^2,l=1,2;$$

(5)Conditional on the assignments of the first (\(n-1\)) patients as well as the covariate profiles of the first \(n\) patients, assign the nth patient to treatment \(1\) with probability $$P(T_n=1|Z_n,T_1,\dots,T_{n-1})=q$$ for \(Imb_n^{(1)}>Imb_n^{(2)},\) $$P(T_n=1|Z_n,T_1,\dots,T_{n-1})=p$$ for \(Imb_n^{(1)}<Imb_n^{(2)}\), and $$P(T_n=1|Z_n,T_1,\dots,T_{n-1})=0.5,$$ for \(Imb_n^{(1)}=Imb_n^{(2)}.\)

References

Hu Y, Hu F. Asymptotic properties of covariate-adaptive randomization[J]. The Annals of Statistics, 2012, 40(3): 1794-1815.

See Also

See HuHuCAR.sim for allocating patients with covariate data generating mechanism. See HuHuCAR.ui for the command-line user interface.

Examples

Run this code
# NOT RUN {
# a simple use
## Real Data
## create a dataframe
df <- data.frame("gender" = sample(c("female", "male"), 1000, TRUE, c(1 / 3, 2 / 3)), 
                 "age" = sample(c("0-30", "30-50", ">50"), 1000, TRUE), 
                 "jobs" = sample(c("stu.", "teac.", "others"), 1000, TRUE), 
                 stringsAsFactors = TRUE)
omega <- c(1, 2, rep(1, 3))
Res <- HuHuCAR(data = df, omega)
## view the output
Res
# }
# NOT RUN {
## view all patients' profile and assignments
Res$Cov_Assig
# }
# NOT RUN {
## Simulated data
cov_num <- 3
level_num <- c(2, 3, 3)
pr <- c(0.4, 0.6, 0.3, 0.4, 0.3, 0.4, 0.3, 0.3)
omega <- rep(0.2, times = 5)
Res.sim <- HuHuCAR.sim(n = 100, cov_num, level_num, pr, omega)
## view the output
Res.sim
# }
# NOT RUN {
## view the detials of difference
Res.sim$Diff
# }
# NOT RUN {
# }
# NOT RUN {
N <- 100 # << adjust according to your CPU
n <- 1000
cov_num <- 3
level_num <- c(2, 3, 5) # << adjust to your CPU and the length should correspond to cov_num
# Set pr to follow two tips:
#(1) length of pr should be sum(level_num);
#(2)sum of probabilities for each margin should be 1.
pr <- c(0.4, 0.6, 0.3, 0.4, 0.3, rep(0.2, times = 5))
omega <- c(0.2, 0.2, rep(0.6 / cov_num, times = cov_num))
# Set omega0 = omegaS = 0
omegaP <- c(0, 0, rep(1 / cov_num, times = cov_num))

## generate a container to contain Diff
DH <- matrix(NA, ncol = N, nrow = 1 + prod(level_num) + sum(level_num))
DP <- matrix(NA, ncol = N, nrow = 1 + prod(level_num) + sum(level_num))
for(i in 1 : N){
  result <- HuHuCAR.sim(n, cov_num, level_num, pr, omega)
  resultP <- HuHuCAR.sim(n, cov_num, level_num, pr, omegaP)
  DH[ , i] <- result$Diff; DP[ , i] <- resultP$Diff
}

## do some analysis
require(dplyr)

## analyze the overall imbalance
Ana_O <- matrix(NA, nrow = 2, ncol = 3)
rownames(Ana_O) <- c("NEW", "PS")
colnames(Ana_O) <- c("mean", "median", "95%quantile")
temp <- DH[1, ] %>% abs
tempP <- DP[1, ] %>% abs
Ana_O[1, ] <- c((temp %>% mean), (temp %>% median),
                (temp %>% quantile(0.95)))
Ana_O[2, ] <- c((tempP %>% mean), (tempP %>% median),
                (tempP %>% quantile(0.95)))
## analyze the within-stratum imbalances
tempW <- DH[2 : (1 + prod(level_num)), ] %>% abs
tempWP <- DP[2 : 1 + prod(level_num), ] %>% abs
Ana_W <- matrix(NA, nrow = 2, ncol = 3)
rownames(Ana_W) <- c("NEW", "PS")
colnames(Ana_W) <- c("mean", "median", "95%quantile")
Ana_W[1, ] = c((tempW %>% apply(1, mean) %>% mean),
               (tempW %>% apply(1, median) %>% mean),
               (tempW %>% apply(1, mean) %>% quantile(0.95)))
Ana_W[2, ] = c((tempWP %>% apply(1, mean) %>% mean),
               (tempWP %>% apply(1, median) %>% mean),
               (tempWP %>% apply(1, mean) %>% quantile(0.95)))

## analyze the marginal imbalance
tempM <- DH[(1 + prod(level_num) + 1) : (1 + prod(level_num) + sum(level_num)), ] %>% abs
tempMP <- DP[(1 + prod(level_num) + 1) : (1 + prod(level_num) + sum(level_num)), ] %>% abs
Ana_M <- matrix(NA, nrow = 2, ncol = 3)
rownames(Ana_M) <- c("NEW", "PS"); colnames(Ana_M) <- c("mean", "median", "95%quantile")
Ana_M[1, ] = c((tempM %>% apply(1, mean) %>% mean),
               (tempM %>% apply(1, median) %>% mean),
               (tempM %>% apply(1, mean) %>% quantile(0.95)))
Ana_M[2, ] = c((tempMP %>% apply(1, mean) %>% mean),
               (tempMP %>% apply(1, median) %>% mean),
               (tempMP %>% apply(1, mean) %>% quantile(0.95)))

AnaHP <- list(Ana_O, Ana_M, Ana_W)
names(AnaHP) <- c("Overall", "Marginal", "Within-stratum")

AnaHP
# }

Run the code above in your browser using DataLab