[Gsdesign-commits] r260 - in pkg/gsDesign: . R

[noreply at r-forge.r-project.org]

Author: keaven
Date: 2010-01-22 23:17:23 +0100 (Fri, 22 Jan 2010)
New Revision: 260

Modified:
   pkg/gsDesign/DESCRIPTION
   pkg/gsDesign/R/gsqplot.R
Log:
2.2-10 minor plot fixes

Modified: pkg/gsDesign/DESCRIPTION
===================================================================
--- pkg/gsDesign/DESCRIPTION	2010-01-18 20:04:29 UTC (rev 259)
+++ pkg/gsDesign/DESCRIPTION	2010-01-22 22:17:23 UTC (rev 260)
@@ -1,5 +1,5 @@
 Package: gsDesign
-Version: 2.2-9
+Version: 2.2-10
 Title: Group Sequential Design
 Author: Keaven Anderson 
 Maintainer: Keaven Anderson <keaven_anderson at merck.com>

Modified: pkg/gsDesign/R/gsqplot.R
===================================================================
--- pkg/gsDesign/R/gsqplot.R	2010-01-18 20:04:29 UTC (rev 259)
+++ pkg/gsDesign/R/gsqplot.R	2010-01-22 22:17:23 UTC (rev 260)
@@ -77,7 +77,7 @@
     Bval
 }
 gsDeltaHat <- function(z, i, x, ylab=NULL,...)
-{   deltaHat <- z / sqrt(x$n.I[i]) * x$delta1 / x$delta - x$delta0
+{   deltaHat <- z / sqrt(x$n.I[i]) * (x$delta1-x$delta0) / x$delta + x$delta0
     deltaHat
 }
 gsHRHat <- function(z, i, x, ratio, ylab="Estimated hazard ratio",...)
@@ -177,12 +177,18 @@
 "plotgsCP" <- function(x, theta="thetahat", main="Conditional power at interim stopping boundaries", 
         ylab=NULL, geom=c("line","text"),
         xlab=ifelse(x$n.fix == 1, "Sample size relative to fixed design", "N"), xlim=NULL,
-        lty=1, col=1, lwd=1, pch=22, textcex=1, legtext=NULL,  dgt=3, nlabel=TRUE, 
+        lty=c(1,2), col=c(1,1), lwd=c(1,1), pch=" ", textcex=1.25, legtext=NULL,  dgt=c(3,2), nlabel=TRUE, 
         base=FALSE, ...)
 {  if (length(lty)==1) lty <- array(lty, 2)
    if (length(col)==1) col <- array(col, 2)
    if (length(lwd)==1) lwd <- array(lwd, 2)
    if (length(dgt)==1) dgt <- array(dgt, 2)
+	if (x$k == 2) stop("No conditional power plot available for k=2")
+# switch order of parameters
+	lty <- lty[2:1]
+	col <- col[2:1]
+	lwd <- lwd[2:1]
+	dgt <- dgt[2:1]
 	if (is.null(ylab))
 	{	ylab <- ifelse(theta == "thetahat",
                        expression(paste("Conditional power at",
@@ -210,15 +216,10 @@
 	ymin <- - 0.1
     
     if (x$k > 3)
-    {
-        xtext <- x$n.I[2]
+    {   xtext <- x$n.I[2]
     }else if (x$k == 3)
-    {
-        xtext <- (x$n.I[2] + x$n.I[1]) / 2
-    }else
-    {
-        xtext <- x$n.I[1]
-    }
+    {   xtext <- (x$n.I[2] + x$n.I[1]) / 2
+    }else xtext <- x$n.I[1]
     
     if (test.type > 1)
     {
@@ -230,8 +231,9 @@
     {	if (test.type == 1)
 		{    
 			plot(x$n.I[1:(x$k-1)], y,  xlab=xlab,  ylab=ylab,  main = main, 
-				ylim=c(ymin,  ymax),  xlim=xlim, type="l", ...)
+				ylim=c(ymin,  ymax),  xlim=xlim, col=col[2], lwd=lwd[2], lty=lty[2], type="l", ...)
 			points(x$n.I[1:(x$k-1)],  y, ...)
+			text(x$n.I[1:(x$k-1)], y, as.character(round(y,dgt[2])), cex=textcex)
 			ymid <- ymin
 		}
 		else
@@ -240,37 +242,42 @@
 				lty=lty, col=col, lwd=lwd, ylim=c(ymin,  ymax), xlim=xlim,  type="l", ...)
 				matpoints(x$n.I[1:(x$k-1)],  y, pch=pch, col=col, ...)
 				text(xtext, ymin, legtext[3], cex=textcex)
+				text(x$n.I[1:(x$k-1)], y[,1], as.character(round(y[,1],dgt[1])), col=col[1], cex=textcex)
+				text(x$n.I[1:(x$k-1)], y[,2], as.character(round(y[,2],dgt[2])), col=col[2], cex=textcex)
 		}
 		text(xtext, ymid, legtext[2], cex=textcex)
 		text(xtext, 1.03, legtext[1], cex=textcex)
 	}else
 	{	N <- as.numeric(x$n.I[1:(x$k-1)])
-		CP <- y[,2] 
+		if (test.type > 1) CP <- y[,2]
+		else CP <- y 
 		Bound <- array("Upper", x$k-1)
-		Ztxt <- as.character(round(CP[1:(x$k-1)], dgt))
+		Ztxt <- as.character(round(CP[1:(x$k-1)], dgt[2]))
 		if (test.type > 1)
 		{	N <- c(N, N)
 			CP <- c(CP, y[,1])
 			Bound <- c(Bound, array("Lower", x$k-1))
-			Ztxt <- as.character(c(Ztxt ,round(y[,1],dgt)))
+			Ztxt <- as.character(c(Ztxt ,round(y[,1],dgt[1])))
 		}
 		y <- data.frame(N=N, CP=CP, Bound=Bound, Ztxt=Ztxt)
-		GeomText$guide_geom <- function(.) "blank"
-		p <- qplot(x=as.numeric(N), y=as.numeric(CP), data=y, main=main,
-			group=factor(Bound), colour=factor(Bound), geom=geom, label=Ztxt, 
-			xlab=xlab, ylab=ylab, ylim=c(ymin, ymax), xlim=xlim) + aes(lty=factor(Bound)) +
-			scale_colour_manual(name= "Bound", values=col, labels=c("Lower","Upper")) +
-			scale_linetype_manual(name= "Bound", values=lty, labels=c("Lower","Upper"))
-	}
+		if (test.type > 1)
+		{	GeomText$guide_geom <- function(.) "blank"
+			p <- qplot(x=as.numeric(N), y=as.numeric(CP), data=y, main=main,
+				group=factor(Bound), colour=factor(Bound), geom=geom, label=Ztxt, 
+				xlab=xlab, ylab=ylab, ylim=c(ymin, ymax), xlim=xlim) + aes(lty=factor(Bound)) +
+				scale_colour_manual(name= "Bound", values=col, labels=c("Lower","Upper")) +
+				scale_linetype_manual(name= "Bound", values=lty, labels=c("Lower","Upper"))
+		}else 
+		{ p <- qplot(x=as.numeric(N), y=as.numeric(CP), data=y, main=main,
+				label=Ztxt, geom="text",
+				xlab=xlab, ylab=ylab, ylim=c(ymin, ymax), xlim=xlim) + geom_line(colour=col[2])
+	}	}
 	if (nlabel==TRUE)
 	{	y2 <- data.frame(
 					N=x$n.I[1:(x$k-1)], 
 					CP=array(ymin/2, x$k-1), 
 					Bound=array("Lower", x$k-1),
 					Ztxt=as.character(round(x$n.I[1:(x$k-1)],nround)))
-		if (base)
-		{	#text(x=x$n.I[1:(x$k-1)], y=array(ymin/2, x$k-1), as.character(round(x$n.I[1:(x$k-1)],nround)), cex=textcex)
-		}
 		if (x$n.fix == 1)
 		{	if (base)
 			{	text(x=y2$N, y=y2$CP, paste(array("r=",x$k), y2$Ztxt, sep=""), cex=textcex)