[Gsdesign-commits] r145 - pkg/R
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Mon May 4 22:38:31 CEST 2009
Author: keaven
Date: 2009-05-04 22:38:31 +0200 (Mon, 04 May 2009)
New Revision: 145
Modified:
pkg/R/gsCP.R
pkg/R/gsMethods.R
pkg/R/gsSpending.R
pkg/R/gsSurvival.R
Log:
Minor fixes to gsSpending.R, gsSurvival.R, gsMethods.R, gsCP.R
Modified: pkg/R/gsCP.R
===================================================================
--- pkg/R/gsCP.R 2009-05-04 20:33:26 UTC (rev 144)
+++ pkg/R/gsCP.R 2009-05-04 20:38:31 UTC (rev 145)
@@ -56,9 +56,11 @@
knew <- x$k-i
Inew <- x$n.I[(i+1):x$k]-x$n.I[i]
- bnew <- (x$upper$bound[(i+1):x$k]-zi*sqrt(x$n.I[i]/x$n.I[(i+1):x$k]))/sqrt(Inew/x$n.I[(i+1):x$k])
+ bnew <- (x$upper$bound[(i+1):x$k] - zi * sqrt(x$n.I[i] / x$n.I[(i+1):x$k]))/
+ sqrt(Inew/x$n.I[(i+1):x$k])
if (test.type > 1){
- anew <- (x$lower$bound[(i+1):x$k]-zi*sqrt(x$n.I[i]/x$n.I[(i+1):x$k]))/sqrt(Inew/x$n.I[(i+1):x$k])
+ anew <- (x$lower$bound[(i+1):x$k]-zi*sqrt(x$n.I[i]/x$n.I[(i+1):x$k]))/
+ sqrt(Inew/x$n.I[(i+1):x$k])
}
else
{
@@ -74,30 +76,19 @@
test.type <- ifelse(is(x, "gsProbability"), 3, x$test.type)
- if (!is(x, "gsDesign") || theta != "thetahat")
+ if (is(x, "gsDesign") || theta != "thetahat")
{
- thetahi <- array(theta, len)
-
- if (test.type > 1)
- {
- thetalow <- theta
- }
+ thetahi <- x$delta
+ if (test.type > 1) thetalow <- thetahi
}
else
{
- if (test.type>1)
- {
- thetalow <- x$lower$bound[1:len]/sqrt(x$n.I[1:len])
- }
-
+ if (test.type>1) thetalow <- x$lower$bound[1:len]/sqrt(x$n.I[1:len])
thetahi <- x$upper$bound[1:len]/sqrt(x$n.I[1:len])
}
CPhi <- array(0, len)
- if (test.type > 1)
- {
- CPlo <- CPhi
- }
+ if (test.type > 1) CPlo <- CPhi
for(i in 1:len)
{
@@ -115,4 +106,4 @@
###
# Hidden Functions
-###
\ No newline at end of file
+###
Modified: pkg/R/gsMethods.R
===================================================================
--- pkg/R/gsMethods.R 2009-05-04 20:33:26 UTC (rev 144)
+++ pkg/R/gsMethods.R 2009-05-04 20:38:31 UTC (rev 145)
@@ -35,13 +35,13 @@
"plot.gsDesign" <- function(x, plottype=1, ...)
{
- checkScalar(plottype, "integer", c(1, 7))
+# checkScalar(plottype, "integer", c(1, 7))
invisible(do.call(gsPlotName(plottype), list(x, ...)))
}
"plot.gsProbability" <- function(x, plottype=2, ...)
{
- checkScalar(plottype, "integer", c(1, 7))
+# checkScalar(plottype, "integer", c(1, 7))
invisible(do.call(gsPlotName(plottype), list(x, ...)))
}
@@ -567,18 +567,11 @@
else
{
xval <- theta
-
- if (is.null(xlab))
- {
- xlab <- expression(theta)
- }
+ if (is.null(xlab)) xlab <- expression(theta)
}
}
- if (is.null(xlab))
- {
- xlab <- ""
- }
+ if (is.null(xlab)) xlab <- ""
x <- if (is(x, "gsDesign")) gsProbability(d=x, theta=theta) else
gsProbability(k=x$k, a=x$lower$bound, b=x$upper$bound, n.I=x$n.I, theta=theta)
Modified: pkg/R/gsSpending.R
===================================================================
--- pkg/R/gsSpending.R 2009-05-04 20:33:26 UTC (rev 144)
+++ pkg/R/gsSpending.R 2009-05-04 20:38:31 UTC (rev 145)
@@ -255,7 +255,6 @@
z <- - qnorm(alpha / 2)
t[t > 1] <- 1
-
x <- list(name="Lan-DeMets O'brien-Fleming approximation", param=NULL, parname="none", sf=sfLDOF,
spend=2 * (1 - pnorm(z / sqrt(t))), bound=NULL, prob=NULL)
@@ -297,6 +296,7 @@
}
else if (len == 4)
{
+ checkRange(param, inclusion=c(FALSE, FALSE))
t0 <- param[1:2]
p0 <- param[3:4]
Modified: pkg/R/gsSurvival.R
===================================================================
--- pkg/R/gsSurvival.R 2009-05-04 20:33:26 UTC (rev 144)
+++ pkg/R/gsSurvival.R 2009-05-04 20:38:31 UTC (rev 145)
@@ -36,11 +36,10 @@
# Exported Functions
###
-"nSurvival" <- function(lambda.0, lambda.1, eta = 0,
- rand.ratio = 1, Ts, Tr,
+"nSurvival" <- function(lambda.0, lambda.1, Ts, Tr,
+ eta = 0, rand.ratio = 1,
alpha = 0.05, beta = 0.10, sided = 2,
- approx = FALSE,
- type = c("rr", "rd"),
+ approx = FALSE, type = c("rr", "rd"),
entry = c("unif", "expo"), gamma = NA)
{
############################################################
@@ -48,10 +47,10 @@
## calculate sample size #
## lambda.0 -- hazard rate for placebo group #
## lambda.1 -- hazard rate for treatment group #
+ ## Ts -- study duration #
+ ## Tr -- accrual duration #
## eta -- exponential dropout rate #
## rand.ratio -- randomization ratio (T/P) #
- ## Ts -- study duration #
- ## Tr -- accural duration #
## alpha -- type I error rate #
## beta -- type II error rate #
## sided -- one or two-sided test #
@@ -68,7 +67,7 @@
entry <- match.arg(entry)
method <- match(type, c("rr", "rd"))
- accural <- match(entry, c("unif", "expo")) == 1
+ accrual <- match(entry, c("unif", "expo")) == 1
xi0 <- 1 / (1 + rand.ratio)
xi1 <- 1 - xi0
@@ -85,7 +84,7 @@
haz <- c(lambda.0, lambda.1, ave.haz)
prob.e <- sapply(haz, pe, eta = eta, Ts = Ts, Tr = Tr,
- gamma = gamma, unif = accural)
+ gamma = gamma, unif = accrual)
zalpha <- qnorm(1 - alpha / sided)
zbeta <- qnorm(1 - beta)
@@ -124,7 +123,7 @@
Hazard.p = lambda.0, Hazard.t = lambda.1,
Dropout = eta, Frac.p = xi0, Frac.t = xi1,
Gamma = gamma, Alpha = alpha, Beta = beta, Sided = sided,
- Study.dura = Ts, Accural = Tr)
+ Study.dura = Ts, Accrual = Tr)
outd
}
@@ -162,5 +161,3 @@
resu
}
-
-
More information about the Gsdesign-commits
mailing list