--- a
+++ b/R/study.R
@@ -0,0 +1,244 @@
+#The Study class definition (used in predict from parameters)
+#together with the exported methods. Also see study_constructors.R
+
+#' @include lag.R common.R ctrlSpec.R sfn.R eventPrediction_package.R
+NULL
+
+##' Class defining the Study 
+##' @slot HR Hazard ratio to be detected
+##' @slot alpha Significance level [0,1] (see also two-sided indicator)
+##' @slot power Power [0,1]
+##' @slot two.sided If TRUE, two sided test will be used (i.e. alpha/2).
+##' @slot r Control:Experimental subject balance (1:r), i.e. nE/nC=r. r=1 corresponds to equally 
+##' many subjects in both arms. 2 means we have twice the number of subjects in the experimental arm.
+##' Specifically \code{floor(r*N/(r+1))} subjects are 
+##' allocated to the experimental arm and all other subjects are allocated to the control arm.
+##' @slot N Number of subjects to be recruited (integer)
+##' @slot study.duration Number of months the study will be going.
+##' @slot ctrlSpec A CtrlSpec object which calculates the control group median. This object will be created automatically
+##' when calling a constructor for the Study class.
+##' @slot dropout A list of CtrlSpec object which calculates the median drop out rate for the control arm (index 1) and 
+##' active arm (index 2). 
+##' This object will be created automatically when calling a constructor for the study class
+##' @slot dropout.shape The Weibull shape parameter of the dropout hazard function
+##' @slot k non-uniformity of accrual (integer, 1=uniform). Non-uniform accrual is allowed for 
+##' using the following distribution for the probability of a patient entering the trial at time \eqn{b} 
+##' within the accrual period \eqn{[0,B]}: \eqn{F(b)=b_k/B_k}; \eqn{f(b)=k b_{k-1}/B_k} where \eqn{k} is the 
+##' measure of non-uniformity (\eqn{k>0}). \eqn{k=1} indicates uniform accrual. This implies that during 
+##' the first half of the accrual period, \eqn{1/2^k} of the patients will be recruited. Half of the patients 
+##' will be recruited by time \eqn{B/2^{1/k}}. 
+##' @slot acc.period Accrual time in months
+##' @slot shape The Weibull shape parameter
+##' @slot followup The time a subject is followed after randomization, if Inf then there is no fixed time period
+##' @slot type Character: The study type, either "Oncology" or "CRGI"
+##' @slot lag.settings The \code{LaggedEffect} object describing any lag effect for the study 
+##' @export 
+setClass( "Study", 
+          slots= list( HR = "numeric",  # Hazard ratio
+                       alpha = "numeric",
+                       power = "numeric",
+                       two.sided = "logical",
+                       r = "numeric",  
+                       N = "numeric",  # Patients to be recruited
+                       study.duration = "numeric",  # Length of study (In months)
+                       ctrlSpec = "CtrlSpec",  # Median of control arm
+                       dropout = "list",
+                       dropout.shape ="numeric",
+                       k = "numeric",  
+                       acc.period = "numeric",
+                       shape="numeric",
+                       followup="numeric",
+                       type="character",
+                       lag.settings = "LagEffect"),
+          
+          validity = function(object){
+            is.wholenumber <- function(x, tol = .Machine$double.eps^0.5)  abs(x - round(x)) < tol          
+            ans <- ""
+            if(object@shape <= 0) ans <- paste(ans,"Invalid shape.")
+            if(object@acc.period <= 0) ans <- paste(ans,"Invalid acc.period")
+            if(object@k <= 0) ans <- paste(ans,"Invalid k.")
+            if(object@N <= 0 || !is.wholenumber(object@N) || length(object@N)>1 ) ans <- paste(ans,"Invalid N.")
+            if(object@study.duration <= 0 ) ans <- paste(ans,"Invalid study.duration.")
+            if(object@r < 0 ) ans <- paste(ans,"Invalid r.")
+                        
+            if(object@study.duration <= object@acc.period) 
+              ans <- paste(ans,"acc.period must be < study.duration")
+            
+            if(object@r == 0){
+              if(!is.na(object@HR)) ans <- paste(ans,"HR must be NA if r = 0")
+              if(!is.na(object@power)) ans <- paste(ans,"power must be NA if r = 0")
+              if(!is.na(object@alpha)) ans <- paste(ans,"alpha must be NA if r = 0")
+            }
+            else{
+              if(is.na(object@HR) || object@HR >= 1 || object@HR <= 0)  ans <- paste(ans,"Invalid HR.") 
+              if(object@alpha >= 1 || object@alpha <= 0 ) ans <- paste(ans,"Invalid alpha.")
+              if(object@power >= 1 || object@power <= 0 ) ans <- paste(ans,"Invalid power.")
+            }
+            
+            if(!object@type %in% c("Oncology","CRGI")) ans <- paste(ans,"Invalid type.") 
+            
+            if(length(object@followup) > 1 || object@followup <= 0 ) ans <- paste(ans,"Invalid followup.")
+            
+            if(class(object@lag.settings)!="LagEffect")ans <- paste(ans,"Invalid lag.settings")
+            
+            if(!isNullLag(object@lag.settings)){
+              if(isSingleArm(object) && !is.na(object@lag.settings@L.HazardRatio)){
+                ans <- paste(ans,"lag.settings@L.HazardRatio must be as.numeric(NA) if study has one arm")
+              }
+              if(!isSingleArm(object) && is.na(object@lag.settings@L.HazardRatio)){
+                ans <- paste(ans,"lag.settings@L.HazardRatio cannot be NA if study has more than one arm")
+              }
+            }
+                        
+            if(!is.infinite(object@followup) && !isNullLag(object@lag.settings)){
+              ans <- paste(ans, "Cannot use lagged settings with a study which has a finite follow up time")
+            }
+            
+            if(ans=="") return(TRUE)
+            ans
+          }
+          
+)
+
+
+
+
+##' @name show
+##' @rdname show-methods
+##' @aliases show,Study-method
+##' @export
+setMethod("show", signature(object="Study"), 
+    function(object) {
+      cat("Study definition:\n")
+      cat(paste("Number of Patients (N):",object@N,"\n"))
+      cat(paste("Study duration:",object@study.duration,"months\n"))
+      cat(paste("Accrual period:",object@acc.period,"months\n"))
+      cat(paste("Accrual uniformity (k):",object@k,"\n"))
+      if(!isSingleArm(object)){
+        cat(paste("Control arm survival:"),object@ctrlSpec@text,"\n")
+        cat(paste("Hazard Ratio:",object@HR,"\n"))
+        cat(paste("Ratio of control to experimental 1:",object@r,"\n",sep=""))
+        cat(paste("alpha:",object@alpha))
+        if(object@two.sided){
+          cat("(two sided)\n")
+        }
+        else{
+          cat("(one sided)\n")
+        }
+        cat(paste("Power:",object@power,"\n"))
+      }
+    else{
+      cat(paste("Survival:"),object@ctrlSpec@text,"\n")
+      cat("Single Arm trial\n")
+    } 
+      
+    if(object@shape==1){
+      cat("Exponential survival\n")
+    }
+    else{
+      cat(paste("Weibull survival with shape parameter",object@shape,"\n"))    
+    }
+      
+    if(!is.infinite(object@followup)){
+      cat("Subject follow up period:",object@followup,"months\n")
+    } 
+      
+    if(isSingleArm(object)){
+      outputdropouttext("Subject",object@dropout[[1]],object@dropout.shape)
+    }  
+    else{
+      outputdropouttext("Control Arm",object@dropout[[1]])
+      outputdropouttext("Active Arm",object@dropout[[2]],object@dropout.shape)
+    }
+    show(object@lag.settings) 
+})
+
+
+
+##' Is the \code{Study} a single arm study
+##' @rdname isSingleArm-methods
+##' @name isSingleArm
+##' @param study A \code{Study} object
+##' @return TRUE if study is single arm, FALSE otherwise
+##' @export
+setGeneric("isSingleArm",
+           def=function(study)
+           standardGeneric("isSingleArm"))
+
+
+
+
+##' @rdname isSingleArm-methods
+##' @aliases isSingleArm,Study-method
+##' @name isSingleArm
+##' @export
+setMethod("isSingleArm",representation(study="Study"),
+          function(study){
+            study@r==0
+          })
+
+
+##' @name predict
+##' @rdname predict-methods
+##' @aliases predict,Study-method
+##' @param step.size The resolution of the grid to be used to calculate the time v 
+##' expected events curves 
+##' @export
+setMethod( "predict", representation( object="Study" ), 
+  function( object, time.pred=NULL,
+            event.pred=NULL,step.size=0.5 ) {
+    
+    study <- object
+    lagged <- study@lag.settings
+    validatePredictArguments(time.pred,event.pred,step.size,study@study.duration)
+        
+    #times for the plotting function
+    grid.times <- seq( 0, study@study.duration, step.size )
+    
+    #Next calculate the values of rate parameters
+    lambda    <- lambda.calc( study@ctrlSpec@median, study@HR, study@shape )
+    if(isNullLag(lagged)){
+      lambdaot <- as.numeric(NA)
+    }
+    else{
+      lambdaot  <- lambda.calc( lagged@ctrlSpec@median,  lagged@L.HazardRatio,study@shape )  
+    }
+    
+    dropout.lambda <- GetDropoutLambda(study)
+        
+    #Create the survival functions
+    sfns <- GetSurvivalFunctions(lambda,lambdaot,lagged@Lag.T,isSingleArm(study),study@shape,
+                                 study@followup,study@dropout.shape,dropout.lambda)
+       
+    #Calculate event details for plot 
+    grid <- CalculateEventsGivenTimes(grid.times,study,sfns,calc.at.risk=FALSE)  
+    
+    #Calculate average HR
+    av.HR <-if(isNullLag(lagged) || isSingleArm(study)) study@HR 
+            else calculateAverageHR(sfns,study,lagged@Lag.T,lagged@L.HazardRatio,
+                                    lambdaot,lambda,study@shape)
+   
+    #Calculate the critical value
+    critical.data <- CalculateCriticalValue(study,sfns,grid,av.HR)
+    
+    #Calculate events at given times
+    predict.data <- if(!is.null(time.pred)) CalculateEventsGivenTimes(time.pred,study,sfns) 
+                    else predict.data <- data.frame()
+    
+    
+    #Calculate times for given number of events
+    if(!is.null(event.pred)){
+      predict.data <- rbind(predict.data,CalculateTimesGivenEvents(event.pred,study,sfns,grid))
+    }
+    
+    return(AnalysisResults( 
+           critical.HR = critical.data[["chr"]], 
+           critical.data = critical.data[["critical.data"]], 
+           critical.events.req= critical.data[["critical.events.req"]],
+           av.hr=av.HR,
+           grid=grid,
+           predict.data=predict.data,
+           study=study,
+           sfns=sfns))
+})
+