version 1.0

DESCRIPTION

@@ -0,0 +1,10 @@
+Package: bifactorial
+Version: 1.0
+Date: 2007-04-26
+Author: Peter Frommolt
+Maintainer: Peter Frommolt <peter.frommolt@uni-koeln.de>
+Title: Inferences for bi- and trifactorial trial designs
+Depends: mvtnorm,multcomp,lattice,graphics,methods
+Description: This package makes global and multiple inferences for given bi- and trifactorial clinical trial designs using bootstrap methods and a classical approach.
+License: General Public License (GPL)
+Packaged: Thu Dec  6 11:56:17 2007; pf

NAMESPACE

@@ -0,0 +1,28 @@
+useDynLib(bifactorial)
+
+import(methods)
+importFrom(graphics,plot)
+importFrom(lattice,wireframe)
+importFrom(lattice,cloud)
+importFrom(multcomp,glht)
+
+exportClasses(
+              mintest,
+              margint,
+              avetest,
+              maxtest,
+              carpet,
+              cube
+             )
+
+exportMethods(
+              mintest,
+              margint,
+              avetest,
+              maxtest,
+              carpet,
+              cube,
+              show,
+              summary,
+              plot
+              )

R/1carpet.R

@@ -0,0 +1,98 @@
+setClass("carpet",representation(data="list",D="numeric",n="numeric",call="call"))
+setGeneric("carpet",function(data,D,...){
+  res<-standardGeneric("carpet")
+  res@call=match.call()
+  res
+})
+setMethod("carpet",signature(data="list",D="numeric"),function(data,D,...){
+  n<-numeric(0)
+  if(!is.numeric(D)) stop("Dimensions must be specified by integer values.")
+  if(length(D)!=2) stop("Two Dimensions must be specified for 'carpet' objects.")
+  for(i in 1:length(data)) n[i]<-length(data[[i]])
+  res<-new("carpet",data=data,D=D,n=n)
+  res
+})
+setMethod("carpet",signature(data="ANY",D="ANY"),function(data,D,...){
+  stop("Data must be a list of numeric data vectors.")
+})
+setMethod("show","carpet",function(object){
+  cb<-function(a,b) (a*(object@D[2]+1))+(b+1)
+  cat("\n")
+  cat("Carpet size:",object@D[1],"x",object@D[2],"\n\n")
+  cat("Sample size allocation matrix:\n\t")
+  for(b in 0:object@D[2]){cat(paste(b,"\t",sep=""))}
+  cat("\n")
+  for(a in 0:object@D[1]){
+    cat(a,"\t")
+    for(b in 0:object@D[2]){
+      cat(object@n[cb(a,b)],"\t")
+    }
+    cat("\n")
+  }
+  if(is.binary(object@data[[cb(1,1)]])) cat("\nDescriptive statistics: Event rates\n\t")
+  else cat("\nDescriptive statistics: Mean response values\n\t")
+  for(b in 0:object@D[2]){cat(paste(b,"\t",sep=""))}
+  cat("\n")
+  for(a in 0:object@D[1]){
+    cat(a,"\t")
+    for(b in 0:object@D[2]){
+      cat(round(mean(object@data[[cb(a,b)]]),3),"\t")
+    }
+    cat("\n")
+  }
+  cat("\nDescriptive statistics: Standard deviations\n\t")
+  for(b in 0:object@D[2]){cat(paste(b,"\t",sep=""))}
+  cat("\n")
+  for(a in 0:object@D[1]){
+    cat(a,"\t")
+    for(b in 0:object@D[2]){
+      if(is.binary(object@data[[cb(a,b)]])){
+        p<-mean(object@data[[cb(a,b)]])
+        cat(round(sqrt(object@n[cb(a,b)]*p*(1-p)),3),"\t")
+      }
+      else cat(round(sd(object@data[[cb(a,b)]]),2),"\t")
+    }
+    cat("\n")
+  }
+  cat("\n")
+})
+setMethod("summary",signature("carpet"),function(object){
+  cb<-function(a,b) (a*(object@D[2]+1))+(b+1)
+  cat("\nCarpet Densions:",object@D[1],"x",object@D[2],"\n")
+  cat("Total sample size:",sum(object@n),"\n\n")
+  if(is.binary(object@data[[cb(1,1)]])){
+    cat("Event rates and standard deviations (in parentheses)\nin the treatment groups:\n\n\t")
+  }
+  else cat("Mean response values and standard deviations (in parentheses)\nin the treatment groups:\n\n\t")
+  for(b in 0:object@D[2]){cat(paste(b,"\t\t",sep=""))}
+  cat("\n")
+  for(a in 0:object@D[1]){
+    cat(a,"\t")
+    for(b in 0:object@D[2]){
+      if(is.binary(object@data[[cb(a,b)]])){
+        p<-mean(object@data[[cb(a,b)]])
+        cat(paste(round(p,3)," (",round(sqrt(object@n[[cb(a,b)]]*p*(1-p)),3),")\t",sep=""))
+      }
+      else{
+        cat(paste(round(mean(object@data[[cb(a,b)]]),1)," (",round(sd(object@data[[cb(a,b)]]),2),")","\t",sep=""))
+      }
+    }
+    cat("\n")
+  }
+  cat("\n")
+})
+setMethod("plot",signature(x="carpet",y="missing"),function(x,y){
+  cb<-function(a,b) (a*(x@D[2]+1))+(b+1)
+  xwert<-ywert<-zwert<-numeric(0)
+  for(j in 0:x@D[2]){for(i in 0:x@D[1]){
+    xwert<-c(xwert,i)
+    ywert<-c(ywert,j)
+    zwert<-c(zwert,mean(x@data[[cb(i,j)]]))
+  }}
+  wireframe(zwert~xwert*ywert,
+            data=data.frame(zwert,xwert,ywert),
+            scales=list(arrows=FALSE),
+            xlab="Dose A",ylab="Dose B",zlab="Response",
+            zlim=c(min(zwert)-(.25*(max(zwert)-min(zwert))),max(zwert)+(.25*(max(zwert)-min(zwert)))),
+            drape=TRUE,colorkey=FALSE)#,bg="red")
+})

R/1cube.R

@@ -0,0 +1,65 @@
+setClass("cube",representation(data="list",D="numeric",n="numeric",call="call"))
+setGeneric("cube",function(data,D,...){
+  res<-standardGeneric("cube")
+  res@call=match.call()
+  res
+})
+setMethod("cube",signature(data="list",D="numeric"),function(data,D,...){
+  n<-numeric(0)
+  if(!is.numeric(D)) stop("Dimensions must be specified by integer values.")
+  if(length(D)!=3) stop("Three dimensions must be specified for 'cube' objects.")
+  for(i in 1:length(data)) n[i]<-length(data[[i]])
+  new("cube",data=data,D=D,n=n)
+})
+setMethod("cube",signature(data="ANY",D="ANY"),function(data,D,...){
+  stop("Need a list of numeric data and an integer Densions vector.")
+})
+setMethod("show",signature("cube"),function(object){
+  cb<-function(a,b,c){(a*(object@D[2]+1)*(object@D[3]+1))+(b*(object@D[3]+1))+c+1}
+  stdev<-numeric(0)
+  cat("\n")
+  cat("Cube size:",object@D[1],"x",object@D[2],"x",object@D[3],"\n\n")
+  if(is.binary(object@data)){
+    cat("Group\t\tn\t\trate\t\tstdev\n")
+    for(a in 0:object@D[1]){for(b in 0:object@D[2]){for(c in 0:object@D[3]){
+      p<-mean(object@data[[cb(a,b,c)]])
+      stdev<-c(stdev,round(sqrt(object@n[cb(a,b,c)]*p*(1-p)),3))
+    }}}
+  }
+  else{
+    cat("Group\t\tn\t\tmean\t\tstdev\n")
+    for(a in 0:object@D[1]){for(b in 0:object@D[2]){for(c in 0:object@D[3]){
+      stdev<-c(stdev,round(sd(object@data[[cb(a,b,c)]]),2))
+    }}}
+  }
+  for(a in 0:object@D[1]){for(b in 0:object@D[2]){for(c in 0:object@D[3]){
+    cat("(",a,",",b,",",c,")\t\t",n[cb(a,b,c)],"\t\t",round(mean(object@data[[cb(a,b,c)]]),3),"\t\t",stdev[cb(a,b,c)],"\n",sep="")
+  }}}
+  cat("\n")
+})
+setMethod("summary",signature("cube"),function(object){
+  cb<-function(a,b,c){(a*(object@D[2]+1)*(object@D[3]+1))+(b*(object@D[3]+1))+c+1}
+  cat("\nCube dimensions:",object@D[1],"x",object@D[2],"x",object@D[3],"\n",sep="")
+  cat("Total sample size:",sum(object@n),"\n\n")
+  stdev<-numeric(0)
+  if(is.binary(object@data)){
+    cat("Group\trate (stdev)\n")
+    for(a in 0:object@D[1]){for(b in 0:object@D[2]){for(c in 0:object@D[3]){
+      p<-mean(object@data[[cb(a,b,c)]])
+      stdev<-c(stdev,round(sqrt(object@n[cb(a,b,c)]*p*(1-p)),3))
+    }}}
+  }
+  else{
+    cat("Group\tmean (stdev)\n")
+    for(a in 0:object@D[1]){for(b in 0:object@D[2]){for(c in 0:object@D[3]){
+      stdev<-c(stdev,round(sd(object@data[[cb(a,b,c)]]),2))
+    }}}
+  }
+  for(a in 0:object@D[1]){for(b in 0:object@D[2]){for(c in 0:object@D[3]){
+    cat("(",a,",",b,",",c,")\t ",round(mean(object@data[[cb(a,b,c)]]),3)," (",stdev[cb(a,b,c)],")\n",sep="")
+  }}}
+  cat("\n")
+})
+setMethod("plot",signature(x="cube",y="missing"),function(x,y){
+  stop("Plotting of factorial designs is available for k=2 only.")
+})

R/avemax.R

@@ -0,0 +1,181 @@
+#Objects of class 'avetest' and 'maxtest'
+#representing results of AVE- and MAX-tests (Hung, 2000)
+setClass("avetest",representation(p="numeric",
+                                  stat="numeric",
+                                  test="character",
+                                  method="character",
+                                  nboot="numeric",
+                                  simerror="numeric",
+                                  duration="numeric",
+                                  call="call"))
+setClass("maxtest",representation(p="numeric",
+                                  stat="numeric",
+                                  test="character",
+                                  name="character",
+                                  method="character",
+                                  nboot="numeric",
+                                  simerror="numeric",
+                                  duration="numeric",
+                                  call="call"))
+#
+#
+#Calling the right method for the AVE-test and the respective type of
+#data, selected test statistic and computation method
+setGeneric("avetest",function(C,test=NULL,method="bootstrap",nboot=NULL,simerror=NULL,...){
+  if(all(C@D==c(1,1,1,1,1,1))) warning("The global tests are just single min-tests for a 1x1 design.\n")
+  if(method=="bootstrap"&&is.null(nboot)&&is.null(simerror)) stop("Either nboot or simerror must be specified.")
+  if(method=="hung"&&(!is.null(nboot)||!is.null(simerror))) warning("Arguments nboot or simerror ignored.")
+  if(method!="hung"&&method!="bootstrap") stop(paste("Computation method '",method,"' unknown.",sep=""))
+  if(is.null(test)) stop("Test statistic must be specified.")
+  if(test!="ttest"&&test!="ztest") stop(paste("Test statistic '",test,"' unknown.",sep=""))
+  if(is.null(simerror)) simerror<-9
+  if(is.null(nboot)) nboot<-900
+  if(!is.numeric(nboot) || !is.numeric(simerror)) stop("nboot and simerror must be numeric.")
+  res<-standardGeneric("avetest")
+  res@call=match.call()
+  res
+})
+#
+#
+#'carpet' objects
+setMethod("avetest","carpet",function(C,test=NULL,method="bootstrap",nboot=NULL,simerror=NULL,...){
+  if(method=="bootstrap"){
+    if(test=="ttest") result<-avestudent2Boot(C=C,nboot=nboot,simerror=simerror,...)
+    if(test=="ztest") result<-avebinomial2Boot(C=C,nboot=nboot,simerror=simerror,...)
+  }
+  if(method=="hung"){
+    if(is.binary(C@data)) stop("No analytical approach implemented for binary data.")
+    if(test=="ttest") result<-avestudent2(C=C,...)
+    if(test=="ztest") stop("No analytical approach implemented for the Z-statistic.")
+  }
+  return(result)
+})
+#
+#
+#'cube' objects
+setMethod("avetest","cube",function(C,test=NULL,method="bootstrap",nboot=NULL,simerror=NULL,...){
+  if(all(C@D==c(1,1,1))) warning("The global tests are just single min-tests for a 1x1x1 design.\n")
+  if(method=="hung") stop("No analytical approach implemented for k=3.")
+  if(method=="bootstrap"){
+    if(is.null(nboot)&&is.null(simerror)) stop("Either nboot or simerror must be specified.")
+    if(is.null(simerror)) simerror<-9
+    if(is.null(nboot)) nboot<-900
+    if(test=="ttest") result<-avestudent3Boot(C=C,nboot=nboot,simerror=simerror,...)
+    if(test=="ztest") result<-avebinomial3Boot(C=C,nboot=nboot,simerror=simerror,...)
+  }
+  return(result)
+})
+setMethod("avetest","ANY",function(C,test=NULL,method="bootstrap",nboot=NULL,simerror=NULL,...){
+  stop("Argument must be an object of class 'carpet' or 'cube'.")
+})
+#                                        
+#
+#Calling the right method for the MAX-test and the respective type of
+#data, selected test statistic and computation method
+setGeneric("maxtest",function(C,test=NULL,method="bootstrap",nboot=NULL,simerror=NULL,...){
+  if(all(C@D==c(1,1,1,1,1,1))) warning("The global tests are just single min-tests for a 1x1 design.\n")
+  if(method=="bootstrap"&&is.null(nboot)&&is.null(simerror)) stop("Either nboot or simerror must be specified.")
+  if(method=="hung"&&(!is.null(nboot)||!is.null(simerror))) warning("Arguments nboot or simerror ignored.")
+  if(method!="hung"&&method!="bootstrap") stop(paste("Computation method '",method,"' unknown.",sep=""))
+  if(is.null(test)) stop("Test statistic must be specified.")
+  if(test!="ttest"&&test!="ztest") stop(paste("Test statistic '",test,"' unknown.",sep=""))
+  if(is.null(simerror)) simerror<-9
+  if(is.null(nboot)) nboot<-900
+  if(!is.numeric(nboot) || !is.numeric(simerror)) stop("nboot and simerror must be numeric.")
+  res<-standardGeneric("maxtest")
+  res@call=match.call()
+  res
+})
+#
+#
+#'carpet' objects
+setMethod("maxtest","carpet",function(C,test=NULL,method="bootstrap",nboot=NULL,simerror=NULL,...){
+  if(method=="bootstrap"){
+    if(test=="ttest") result<-maxstudent2Boot(C=C,nboot=nboot,simerror=simerror,...)
+    if(test=="ztest") result<-maxbinomial2Boot(C=C,nboot=nboot,simerror=simerror,...)
+  }
+  if(method=="hung"){
+    if(is.binary(C@data)) stop("No analytical approach implemented for binary data.")
+    if(test=="ttest") result<-maxstudent2(C=C,...)
+    if(test=="ztest") stop("No analytical approach implemented for the Z-statistic.")
+  }
+  return(result)
+})
+#
+#
+#'cube' objects
+setMethod("maxtest","cube",function(C,test=NULL,method="bootstrap",nboot=NULL,simerror=NULL,...){
+  if(all(C@D==c(1,1,1))) warning("The global tests are just single 'min'-tests for a 1x1 design.\n")
+  if(method=="hung") stop("No analytical approach implemented for k=3.")
+  if(method=="bootstrap"){
+    if(is.null(nboot)&&is.null(simerror)) stop("Either nboot or simerror must be specified.")
+    if(is.null(simerror)) simerror<-9
+    if(is.null(nboot)) nboot<-900
+    if(test=="ttest") result<-maxstudent3Boot(C=C,nboot=nboot,simerror=simerror,...)
+    if(test=="ztest") result<-maxbinomial3Boot(C=C,nboot=nboot,simerror=simerror,...)
+  }
+  return(result)
+})
+setMethod("maxtest","ANY",function(C,test=NULL,method="bootstrap",nboot=NULL,simerror=NULL,...){
+  stop("Argument must be an object of class 'carpet' or 'cube'.")  
+})
+#
+#
+#S4 methods for the 'show' and 'summary' generic functions
+#and objects of classes 'avetest' and 'maxtest'
+setMethod("show","maxtest",function(object){
+  cat("\nMAX-test for the existence of an efficacious combination\n")
+  if(object@p<0.0001){
+    cat("tmax=",round(object@stat,4),"; pmax<0.0001\n",sep="")
+  }
+  if(object@p>0.9999){
+    cat("tmax=",round(object@stat,4),"; pmax>0.9999\n",sep="")
+  }
+  if(object@p>=0.0001 && object@p<=0.9999){
+    cat("tmax=",round(object@stat,4),"; pmax=",object@p,"\n",sep="")
+  }
+  cat("Combination where maximum test statistic occurs:",object@name,"\n\n")
+})
+setMethod("show","avetest",function(object){
+  cat("\nAVE-test for the existence of an efficacious combination\n")
+  if(object@p<0.0001){
+    cat("tave=",round(object@stat,4),"; pave<0.0001\n\n",sep="")
+  }
+  if(object@p>0.9999){
+    cat("tave=",round(object@stat,4),"; pave>0.9999\n\n",sep="")
+  }
+  if(object@p>=0.0001 && object@p<=0.9999){
+    cat("tave=",round(object@stat,4),"; pave=",object@p,"\n\n",sep="")
+  }
+})
+setMethod("summary","maxtest",function(object){
+  cat("\nMAX-test for the existence of an efficacious combination\n")
+  cat("tmax=",round(object@stat,4),"\n",sep="")
+  if(object@p<0.0001) cat("pmax<0.0001\n\n",sep="")
+  if(object@p>0.9999) cat("pmax>0.9999\n\n",sep="")
+  if(object@p>=0.0001 && object@p<=0.9999) cat("pmax=",object@p,"\n\n",sep="")
+   cat("Method:",object@method,"\n")
+  if(object@method=="Bootstrap"){
+    cat("Combination where maximum test statistic occurs:",object@name,"\n")
+    cat("Total number of simulations:",object@nboot,"\n")
+  }
+  cat("Simulation standard error:",round(max(object@simerror),6),"\n")
+  cat("Total computation time:",(object@duration-object@duration%%3600)/3600,"hours,",
+      ((object@duration-object@duration%%60)/60)-(object@duration-object@duration%%3600)/60,
+      "minutes,",round(object@duration%%60,digits=0), "seconds\n\n")
+})
+setMethod("summary","avetest",function(object){
+  cat("\nAVE-test for the existence of an efficacious combination\n")
+  cat("tave=",round(object@stat,4),"\n",sep="")
+  if(object@p<0.0001) cat("pave<0.0001\n\n",sep="")
+  if(object@p>0.9999) cat("pave>0.9999\n\n",sep="")
+  if(object@p>=0.0001 && object@p<=0.9999) cat("pave=",object@p,"\n\n",sep="")
+  cat("Method:",object@method,"\n")
+  if(object@method=="Bootstrap"){
+    cat("Total number of simulations:",object@nboot,"\n")
+    cat("Simulation standard error:",round(max(object@simerror),6),"\n")
+  }
+  cat("Total computation time:",(object@duration-object@duration%%3600)/3600,"hours,",
+      ((object@duration-object@duration%%60)/60)-(object@duration-object@duration%%3600)/60,
+      "minutes,",round(object@duration%%60,digits=0), "seconds\n\n")
+})