|
| 1 | +#' Chronic progressive repeated measures (CPRM) model sample size calculations. |
| 2 | +#' |
| 3 | +#' This function performs sample size calculations for the chronic progressive |
| 4 | +#' repeated measures (CPRM) model when used to test for differences of change scores |
| 5 | +#' between groups at last visit. Input parameters are random effect variance |
| 6 | +#' and residual error variance as estimated by a REML fit to representative |
| 7 | +#' pilot data or data from a representative prior clinical trial or cohort |
| 8 | +#' study. |
| 9 | +#' |
| 10 | +#' Default settings perform sample size / power / effect size calculations assuming |
| 11 | +#' equal covariance of repeated measures in the 2 groups, equal residual error |
| 12 | +#' variance across groups, equal allocation to groups, and assuming no study subject |
| 13 | +#' attrition. Specifically, variance parameters required for default settings |
| 14 | +#' are `sig2.s`, the variance of random slopes, and `sig2.e`, the residual error |
| 15 | +#' variance, both either known or estimated from a mixed model fit by REML |
| 16 | +#' to prior data. |
| 17 | +#' |
| 18 | +#' This function accommodates different variance parameters across groups, |
| 19 | +#' unequal allocation across groups, and study subject attrition (loss to followup), |
| 20 | +#' which may also vary across groups. Details can be found in the description of |
| 21 | +#' \code{\link{edland.linear.power}} |
| 22 | +#' |
| 23 | +#' @md |
| 24 | +#' |
| 25 | +#' @name cprm.power |
| 26 | +#' @param n sample size, group 1 |
| 27 | +#' @param lambda allocation ratio (sample size group 1 divided by sample size group 2) |
| 28 | +#' @param delta group difference in fixed effect slopes |
| 29 | +#' @param t the observation times |
| 30 | +#' @param sig2.s variance of random slopes, group 1 |
| 31 | +#' @param sig2.s_2 variance of random slopes, group 2 (defaults to `sig2.s`) |
| 32 | +#' @param sig2.int variance of random intercepts, group 1 |
| 33 | +#' @param sig2.int_2 variance of random intercepts, group 2 (defaults to `sig2.int`) |
| 34 | +#' @param sig.b0b1 covariance of random slopes and intercepts,group 1 |
| 35 | +#' @param sig.b0b1_2 covariance of random slopes and intercepts, group 2 (defaults to `sig.b0b1`) |
| 36 | +#' @param sig2.e residual variance, group 1 |
| 37 | +#' @param sig2.e_2 residual variance, group 2 (defaults to `sig2.e`) |
| 38 | +#' @param p proportion vector for group 1, if i indexes visits, `p[i]` = the proportion whose last visit was at visit `i` (`p` sums to `1`) |
| 39 | +#' @param p_2 proportion vector for group 2 (defaults to `p`) |
| 40 | +#' @param sig.level type one error |
| 41 | +#' @param power power |
| 42 | +#' @param alternative one- or two-sided test |
| 43 | +#' @param tolnot used (no root finding used in this implementation). |
| 44 | +#' @return One of the number of subject required per arm, the `power`, or detectable effect size |
| 45 | +#' given `sig.level` and the other parameter estimates. |
| 46 | +#' @author Michael C. Donohue, Steven D. Edland, Yu Zhao |
| 47 | +#' @seealso [`lmmpower`], [`diggle.linear.power`], [`liu.liang.linear.power`], [`edland.linear.power`], [`hu.mackey.thomas.linear.power`] |
| 48 | +#' @references Zhao Y, Edland SD. The chronic progressive repeated measures (CPRM) model for longitudinal data. |
| 49 | +#' \emph{In process.} |
| 50 | +#' @keywords power sample size mixed effects random effects |
| 51 | +#' @examples |
| 52 | +#' |
| 53 | +#' \dontrun{ |
| 54 | +#' browseVignettes(package = "longpower") |
| 55 | +#' } |
| 56 | +#' # An Alzheimer's Disease example using ADAS-cog pilot estimates |
| 57 | +#' t <- seq(0,1.5,0.25) |
| 58 | +#' cprm.power(delta=1.5, t=t, sig2.s = 24, sig2.e = 10, sig.level=0.05, power = 0.80) |
| 59 | +#' |
| 60 | +#' @export cprm.power |
| 61 | +#' |
| 62 | +cprm.power<-function(n=NULL,delta=NULL,power=NULL,t=NULL,lambda=1, |
| 63 | +sig2.int=0,sig2.s=NULL,sig.b0b1=0,sig2.e=NULL, |
| 64 | +sig2.int_2=NULL,sig2.s_2=NULL,sig.b0b1_2=NULL,sig2.e_2=NULL, |
| 65 | +sig.level=0.05,p=NULL ,p_2=NULL, |
| 66 | +alternative= c("two.sided","one.sided"),tol=NULL) { |
| 67 | +if (sum(sapply(list(n,delta,power),is.null))!=1) |
| 68 | + stop("exactly one of 'n', 'delta', and 'power' must be NULL") |
| 69 | + |
| 70 | +if (!is.null(sig.level)&&!is.numeric(sig.level)|| any(0>sig.level|sig.level>1)) |
| 71 | + stop("'sig.level' must be numeric in [0, 1]") |
| 72 | + |
| 73 | +if (is.null(sig2.s)| is.null(sig2.e)) |
| 74 | + stop("input values are required for each of sig2.s and sig2.e") |
| 75 | + |
| 76 | +if (is.null(p))p=rep(c(0,1),c(length(t)-1,1)) |
| 77 | +if (is.null(p_2))p_2=p |
| 78 | + |
| 79 | +if (is.null(sig2.int_2))sig2.int_2=sig2.int |
| 80 | +if (is.null(sig2.s_2))sig2.s_2=sig2.s |
| 81 | +if (is.null(sig.b0b1_2))sig.b0b1_2=sig.b0b1 |
| 82 | +if (is.null(sig2.e_2))sig2.e_2=sig2.e |
| 83 | + |
| 84 | +if (length(t)!= length(p)| length(p)!= length(p_2)) |
| 85 | + stop("t, p, and p_2 must be the same length") |
| 86 | + |
| 87 | +if (sum(p)!=1| sum(p_2)!=1) |
| 88 | + stop("p and p_2 must sum to 1") |
| 89 | + |
| 90 | +if ( (p[length(p)]!=1|p_2[length(p)]!=1)& (is.null(sig2.int)| is.null(sig.b0b1)) ) |
| 91 | + stop("input values are required for each of sig2.int and sig.b0b1 when study subject attrition is specified using p or p_2") |
| 92 | + |
| 93 | +alternative<- match.arg(alternative, c("two.sided", |
| 94 | +"one.sided")) |
| 95 | + |
| 96 | + |
| 97 | +ind_X<-matrix(rep(0,length(t)^2),nrow= length(t)) |
| 98 | +ind_X[,1]<-1 |
| 99 | + diag(ind_X)[2:length(t)]<-1 |
| 100 | + |
| 101 | + |
| 102 | +getTerm=function(t,X,sig2.b0,sig.b0b1,sig2.b1,sig2.e,p){ |
| 103 | + |
| 104 | +V=matrix(rep(NA,length(t)^2),ncol=length(t)) |
| 105 | +for(iin1:length(t)){ |
| 106 | +for(jin1:length(t)){ |
| 107 | +V[i,j]=sig2.int+(t[i]+t[j])*sig.b0b1+t[i]*t[j]*sig2.s |
| 108 | + }} |
| 109 | + diag(V)= diag(V)+sig2.e |
| 110 | + |
| 111 | +term=0 |
| 112 | +k.max=length(t) |
| 113 | +for(kin2:k.max){ |
| 114 | +V.k=V[1:k,1:k] |
| 115 | +X.k=X[1:k,] |
| 116 | +term=term+p[k]*t(X.k)%*%solve(V.k)%*%X.k |
| 117 | + } |
| 118 | + solve(term)[length(t),length(t)] |
| 119 | + } |
| 120 | +term1=getTerm(t,ind_X,sig2.int ,sig.b0b1 ,sig2.s ,sig2.e ,p) |
| 121 | +term2=getTerm(t,ind_X,sig2.int_2,sig.b0b1_2,sig2.s_2,sig2.e_2,p_2) |
| 122 | + |
| 123 | + |
| 124 | +if (!is.null(n)) |
| 125 | +n_2=n/lambda |
| 126 | + |
| 127 | +if (is.null(sig.level)| is.null(sig2.s)| is.null(sig2.e)) |
| 128 | + stop("solving for sig.level, sig2.s, or sig2.e is no longer supported") |
| 129 | +elseif (is.null(power)) { |
| 130 | +power= pnorm(sqrt(n*delta^2/(term1+term2*lambda))+qnorm(ifelse(alternative=="two.sided",sig.level/2,sig.level))) |
| 131 | + } |
| 132 | +elseif (is.null(delta)) { |
| 133 | +delta= sqrt((qnorm(ifelse(alternative=="two.sided",sig.level/2,sig.level))+qnorm(1-power))^2*(term1+term2*lambda)/n) |
| 134 | + } |
| 135 | +elseif (is.null(n)) { |
| 136 | +n= (qnorm(ifelse(alternative=="two.sided",sig.level/2,sig.level))+qnorm(1-power))^2*(term1+term2*lambda)/delta^2 |
| 137 | +n_2=n/lambda |
| 138 | + } |
| 139 | +else# (Shouldn't happen) |
| 140 | + stop("internal error",domain=NA) |
| 141 | + |
| 142 | +METHOD<-"Zhao and Edland, in process" |
| 143 | + structure(list(N=n+n_2,n= c(n,n_2),delta=delta, |
| 144 | +t=t,p=p,p_2=p_2,sig2.int=sig2.int,sig.b0b1=sig.b0b1, |
| 145 | +sig2.s=sig2.s,sig2.e=sig2.e,sig2.int_2=sig2.int_2, |
| 146 | +sig.b0b1_2=sig.b0b1_2,sig2.s_2=sig2.s_2,sig2.e_2=sig2.e_2, |
| 147 | +sig.level=sig.level,power=power,alternative=alternative, |
| 148 | +note="N is *total* sample size and n is sample size in *each* group", |
| 149 | +method=METHOD),class="power.longtest") |
| 150 | +} |