R/AnalyseCTP.R

In CTP: Closed Testing Procedure (CTP)

#' Analysing a Closed Testing Procedure
#'
#' Calculation of p-values of a closed testing procedure (CTP).
#'	The function returns an object of \code{oldClass "ctp"; summary()} and \code{Display()} can be applied.
#'
#'	@param ctp.struc
#'		Object generated by the function \code{\link{IntersectHypotheses}} (structure of CTP)
#'
#'	@param model
#'		model of the form response~treatment. If \code{testname="F"}, the model can be extended by covariates and other factors.
#'		In the case
#'		of a Logrank test the response must be imputed as \code{Surv(time,status)}.
#'
#'	@param data
#'		Dataframe, missing values in the response or treatment variable are not allowed!
#'
#'	@param factor.name
#'		Character string naming the factor whose levels are compared (treatment factor).
#'		By default the first variable of the right-hand side of the model formula is used.
#'
#'	@param test.name
#'		One of the following strings \itemize{
#'			\item \code{"F"} - F-Test (ANOVA from linear model, default)
#'			\item \code{"glm"} - generalised linear model
#'			\item \code{"kruskal"} -Kruskal-Wallis-Test
#'			\item \code{"chisq"} - Chi square test
#'			\item \code{"prob"} - Fisher's exact test for total number of observations <200 else Chi square test
#'			\item \code{"lgrank"} - Logrank-test
#'			\item \code{"jonckheere"} - Jonckheere-Terpstra test of ordered alternatives
#'			\item \code{"glm"} - generalised linear model, using function \code{glm} from \code{stats}.
#'		}
#'	@param ... Additional arguments for the chosen test.
#'
#'	@details
#'		The hypothesis tree of the closed testing procedure must be created using \code{\link{IntersectHypotheses}}. For more details on the theory and the implementation as well
#'		for many examples, see the vignettes.

#' @return
#'  An object of old class(\code{ctp}), consisting of a list with:
#'   \itemize{
#'    \item{\code{CTPparms}}: List with objects describing the CTP setup.
#'    \item{\code{pvalues}}: Dataframe with all tested hypotheses, raw and adjusted p-values.
#'	  }
#'
#'	@note
#'		This procedure is constructed for testing differences and two-sided hypotheses,
#'		but not for equivalence tests. It is further based on independent samples from the population involved
#'		(i.e. on parallel group designs, but not on cross-over designs).
#'
#'
#'	@seealso
#'		\code{\link{IntersectHypotheses}}, \code{\link{Display}}, \code{\link{summary.ctp.str}},  \code{\link{summary.ctp}},
#'		\code{\link{Adjust_raw}}
#'
#'	@examples
#'		data(pasi)
#'		three.to.first <- IntersectHypotheses(list(1:2,c(1,3),c(1,4)))
#'		Display(three.to.first)
#'		pasi.ctp.F1 <- AnalyseCTP(three.to.first,pasi.ch~dose,pasi)
#'		summary(pasi.ctp.F1)
#'		Display(pasi.ctp.F1)
#'
#' @export

AnalyseCTP <- function(ctp.struc, model, data, factor.name = NULL, test.name = "F",...)
	{

		if(!(oldClass(ctp.struc) == "ctp.str")) stop("First argument must be an object of class ctp.str")
		if(!(oldClass(model) == "formula")) stop("Second argument must be a formula")
		if(!(oldClass(data) == "data.frame")) 	stop("Third argument must be a data frame")

  
		tests <- c("F", "kruskal", "chisq", "prob", "lgrank", "jonckheere","glm")
		if(!(test.name %in% tests)) stop("test.name wrongly specified")
     
		 CTPparms <- getCTPparms(ctp.struc=ctp.struc, model=model, dataset=data,
		                         factor.name = factor.name, test.name = test.name,...)
		 if(test.name == "F")   pvalues  <- ctp.linHyp(CTPparms=CTPparms)
		 if(test.name == "glm") pvalues  <- ctp.linHyp(CTPparms=CTPparms,...)
		 if(!(test.name %in% c("F","glm")))  pvalues <- CTPcompare(CTPparms=CTPparms,...)
     pvadj    <- Adjust_p(ctp.struc = ctp.struc, ctp.pval = pvalues)
		 ctp.res  <- list(CTPparms=CTPparms, pvalues = pvadj)

	   oldClass(ctp.res) <- "ctp"
		 invisible(ctp.res)

	}