From noreply at r-forge.r-project.org Sun Feb 10 12:07:34 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Sun, 10 Feb 2013 12:07:34 +0100 (CET) Subject: [Gsdesign-commits] r341 - pkg/gsDesign/R Message-ID: <20130210110734.3CF051844BC@r-forge.r-project.org> Author: keaven Date: 2013-02-10 12:07:33 +0100 (Sun, 10 Feb 2013) New Revision: 341 Modified: pkg/gsDesign/R/gsBinomialExact.R Log: Eliminated as.real to be compatible with R 3.0 Modified: pkg/gsDesign/R/gsBinomialExact.R =================================================================== --- pkg/gsDesign/R/gsBinomialExact.R 2013-01-17 11:14:15 UTC (rev 340) +++ pkg/gsDesign/R/gsBinomialExact.R 2013-02-10 11:07:33 UTC (rev 341) @@ -6,7 +6,7 @@ checkVector(a, "integer", interval=c(-Inf, Inf), inclusion=c(FALSE, FALSE)) checkVector(b, "integer", interval=c(1, Inf), inclusion=c(FALSE, FALSE)) ntheta <- as.integer(length(theta)) - theta <- as.real(theta) + theta <- as.double(theta) if (k != length(n.I) || k!=length(a) || k != length(b)) stop("Lengths of n.I, a, and b must equal k on input") m <- c(n.I[1], diff(n.I)) From noreply at r-forge.r-project.org Sun Feb 10 22:37:11 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Sun, 10 Feb 2013 22:37:11 +0100 (CET) Subject: [Gsdesign-commits] r342 - pkg/gsDesign/R Message-ID: <20130210213711.AD1561846AD@r-forge.r-project.org> Author: keaven Date: 2013-02-10 22:37:11 +0100 (Sun, 10 Feb 2013) New Revision: 342 Modified: pkg/gsDesign/R/gsBinomial.R Log: Replaced nBinomial allowing n as input argument. Modified: pkg/gsDesign/R/gsBinomial.R =================================================================== --- pkg/gsDesign/R/gsBinomial.R 2013-02-10 11:07:33 UTC (rev 341) +++ pkg/gsDesign/R/gsBinomial.R 2013-02-10 21:37:11 UTC (rev 342) @@ -108,11 +108,11 @@ upper <- exp(upper) } } - list(lower=lower,upper=upper) + cbind(lower=lower,upper=upper) } "nBinomial"<-function(p1, p2, alpha=0.025, beta=0.1, delta0=0, ratio=1, - sided=1, outtype=1, scale="Difference") + sided=1, outtype=1, scale="Difference", n=NULL) { # check input arguments checkVector(p1, "numeric", c(0, 1), c(FALSE, FALSE)) @@ -124,9 +124,10 @@ checkVector(ratio, "numeric", c(0, Inf), c(FALSE, FALSE)) checkScalar(outtype, "integer", c(1, 3)) checkScalar(scale, "character") + if (!is.null(n)) checkVector(n, "numeric") scale <- match.arg(tolower(scale), c("difference", "rr", "or", "lnor")) - checkLengths(p1, p2, beta, delta0, ratio, allowSingle=TRUE) - + if (is.null(n)) checkLengths(p1, p2, beta, delta0, ratio, allowSingle=TRUE) + else checkLengths(n, p1, p2, delta0, ratio, allowSingle=TRUE) # make all vector arguments the same length len<-max(sapply(list(p1, p2, beta, delta0, ratio),length)) if (len > 1) @@ -172,23 +173,37 @@ sigma0 <- sqrt((p10 * (1 - p10) + p20 * (1 - p20) / ratio) * (ratio + 1)) sigma1 <- sqrt((p1 * (1 - p1) + p2 * (1 - p2) / ratio) * (ratio + 1)) - n <- ((z.alpha * sigma0 + z.beta * sigma1) / (p1 - p2 - delta0)) ^ 2 - if (outtype == 2) - { - return(list(n1=n / (ratio + 1), n2=ratio * n / (ratio + 1))) + if (is.null(n)){ + n <- ((z.alpha * sigma0 + z.beta * sigma1) / (p1 - p2 - delta0)) ^ 2 + if (outtype == 2) + { + return(data.frame(cbind(n1=n / (ratio + 1), n2=ratio * n / (ratio + 1)))) + } + else if (outtype == 3) + { + return(data.frame(cbind(n=n, n1=n / (ratio + 1), n2=ratio * n / (ratio + 1), + alpha = alpha, sided=sided, beta = beta, Power = 1-beta, + sigma0=sigma0, sigma1=sigma1, p1=p1 ,p2=p2, + delta0=delta0, p10=p10, p20=p20))) + } + else return(n=n) } - else if (outtype == 3) - { - return(list(n=n, n1=n / (ratio + 1), n2=ratio * n / (ratio + 1), - sigma0=sigma0, sigma1=sigma1, p1=p1 ,p2=p2, - delta0=delta0, p10=p10, p20=p20)) - } else - { - return(n=n) + { pwr <- pnorm(-(qnorm(1-alpha/sided)-sqrt(n) * ((p1 - p2 - delta0)/sigma0))*sigma0/sigma1) + if (outtype == 2) + { + return(data.frame(cbind(n1=n / (ratio + 1), n2=ratio * n / (ratio + 1), Power=pwr))) + } + else if (outtype == 3) + { + return(data.frame(cbind(n=n, n1=n / (ratio + 1), n2=ratio * n / (ratio + 1), + alpha = alpha, sided=sided, beta = 1-pwr, Power = pwr, + sigma0=sigma0, sigma1=sigma1, p1=p1 ,p2=p2, + delta0=delta0, p10=p10, p20=p20))) + } + else return(Power=pwr) } } - # sample size for risk ratio - Farrington and Manning else if (scale == "rr") { @@ -208,24 +223,38 @@ (p10 * (1 - p10) + RR ^ 2 * p20 * (1 - p20) / ratio)) sigma1 <- sqrt((ratio + 1) * (p1 * (1 - p1) + RR ^ 2 * p2 * (1 - p2) / ratio)) - n <- ((z.alpha * sigma0 + z.beta * sigma1) / (p1 - p2 * RR)) ^ 2 - - if (outtype == 2) - { - return(list(n1=n / (ratio + 1), - n2=ratio * n / (ratio + 1))) - } - else if (outtype == 3) - { - return(list(n=n, n1=n / (ratio + 1), n2=ratio * n / (ratio + 1), + if (is.null(n)){ + n <- ((z.alpha * sigma0 + z.beta * sigma1) / (p1 - p2 * RR)) ^ 2 + if (outtype == 2) + { + return(data.frame(data.frame(cbind(n1=n / (ratio + 1), + n2=ratio * n / (ratio + 1))))) + } + else if (outtype == 3) + { + return(data.frame(cbind(n=n, n1=n / (ratio + 1), n2=ratio * n / (ratio + 1), + alpha = alpha, sided=sided, beta = 1-pwr, Power = pwr, sigma0=sigma0, sigma1=sigma1, p1=p1, p2=p2, - delta0=delta0, p10=p10, p20=p20)) + delta0=delta0, p10=p10, p20=p20))) + } + else return(n=n) } else - { - return(n=n) + { pwr <- pnorm(-(qnorm(1-alpha/sided)-sqrt(n) * ((p1 - p2 * RR)/sigma0))*sigma0/sigma1) + if (outtype == 2) + { + return(data.frame(cbind(n1=n / (ratio + 1), n2=ratio * n / (ratio + 1), Power=pwr))) + } + else if (outtype == 3) + { + return(data.frame(cbind(n=n, n1=n / (ratio + 1), n2=ratio * n / (ratio + 1), + alpha = alpha, sided=sided, beta = 1-pwr, Power = pwr, + sigma0=sigma0, sigma1=sigma1, p1=p1 ,p2=p2, + delta0=delta0, p10=p10, p20=p20))) + } + else return(Power=pwr) } - } + } # sample size for log-odds-ratio - based on Miettinen and Nurminen max # likelihood estimate and asymptotic variance from, e.g., Lachin (2000) @@ -248,22 +277,41 @@ sigma1 <- sqrt((ratio + 1) * (1 / p1 / (1 - p1) + 1 / p2 / (1 - p2) / ratio)) - n <- ((z.alpha * sigma0 + z.beta * sigma1) / + if (is.null(n)){ + n <- ((z.alpha * sigma0 + z.beta * sigma1) / log(OR / p2 * (1 - p2) * p1 / (1 - p1))) ^ 2 - if (outtype == 2) - { - return(list(n1=n / (ratio + 1),n2=ratio * n / (ratio + 1))) - } - else if (outtype == 3) - { - return(list(n=n, n1=n / (ratio+1), n2=ratio * n / (ratio + 1), + if (outtype == 2) + { + return(data.frame(cbind(n1=n / (ratio + 1), n2=ratio * n / (ratio + 1)))) + } + else if (outtype == 3) + { + return(data.frame(cbind(n=n, n1=n / (ratio+1), n2=ratio * n / (ratio + 1), + alpha = alpha, sided=sided, beta = 1-pwr, Power = pwr, sigma0=sigma0, sigma1=sigma1, p1=p1, p2=p2, - delta0=delta0, p10=p10, p20=p20)) + delta0=delta0, p10=p10, p20=p20))) + } + else + { + return(n=n) + } } else - { - return(n=n) + { pwr <- pnorm(-(qnorm(1-alpha/sided)-sqrt(n) * + (log(OR / p2 * (1 - p2) * p1 / (1 - p1))/sigma0))*sigma0/sigma1) + if (outtype == 2) + { + return(data.frame(cbind(n1=n / (ratio + 1), n2=ratio * n / (ratio + 1), Power=pwr))) + } + else if (outtype == 3) + { + return(data.frame(cbind(n=n, n1=n / (ratio + 1), n2=ratio * n / (ratio + 1), + alpha = alpha, sided=sided, beta = 1-pwr, Power = pwr, + sigma0=sigma0, sigma1=sigma1, p1=p1 ,p2=p2, + delta0=delta0, p10=p10, p20=p20))) + } + else return(Power=pwr) } } } From noreply at r-forge.r-project.org Wed Feb 20 18:18:27 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Wed, 20 Feb 2013 18:18:27 +0100 (CET) Subject: [Gsdesign-commits] r343 - pkg/gsDesign/man Message-ID: <20130220171827.B2B63184E3A@r-forge.r-project.org> Author: keaven Date: 2013-02-20 18:18:27 +0100 (Wed, 20 Feb 2013) New Revision: 343 Modified: pkg/gsDesign/man/binomial.Rd Log: Eliminated as.real in documentation example (binomial.Rd) Modified: pkg/gsDesign/man/binomial.Rd =================================================================== --- pkg/gsDesign/man/binomial.Rd 2013-02-10 21:37:11 UTC (rev 342) +++ pkg/gsDesign/man/binomial.Rd 2013-02-20 17:18:27 UTC (rev 343) @@ -160,9 +160,9 @@ # Perform 50k simulations to test validity of the above # asymptotic p-values # (you may want to perform more to reduce standard error of estimate) -sum(as.real(x0) <= +sum(as.double(x0) <= simBinomial(p1=.078, p2=.078, n1=500, n2=500, nsim=10000)) / 10000 -sum(as.real(x0) <= +sum(as.double(x0) <= simBinomial(p1=.052, p2=.052, n1=500, n2=500, nsim=10000)) / 10000 # Perform a non-inferiority test to see if p2=400 / 500 is within 5% of From noreply at r-forge.r-project.org Fri Feb 22 11:07:11 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Fri, 22 Feb 2013 11:07:11 +0100 (CET) Subject: [Gsdesign-commits] r344 - pkg/gsDesign/R Message-ID: <20130222100711.5021218493A@r-forge.r-project.org> Author: keaven Date: 2013-02-22 11:07:11 +0100 (Fri, 22 Feb 2013) New Revision: 344 Modified: pkg/gsDesign/R/gsNormalGrid.R Log: Fixed invCDF minor check issue; not a routine currently in use, but left in as it could be exported at some point. Modified: pkg/gsDesign/R/gsNormalGrid.R =================================================================== --- pkg/gsDesign/R/gsNormalGrid.R 2013-02-20 17:18:27 UTC (rev 343) +++ pkg/gsDesign/R/gsNormalGrid.R 2013-02-22 10:07:11 UTC (rev 344) @@ -58,7 +58,7 @@ list(z=z, density=d, gridwgts=w, wgts=d*w) } -invCDF <- function(q, x, discrete=FALSE, upper=FALSE) +invCDF <- function(q, x, discrete=FALSE, upper=FALSE, tol=.000001) { checkLengths(x$z, x$density, x$gridwgts, x$wgts) len <- length(x$z) checkVector(x$z[2:len]-x$z[1:(len-1)],"numeric",c(0,Inf), c(TRUE, FALSE))