--- a
+++ b/R/eventDataDiagnostic.R
@@ -0,0 +1,179 @@
+#The Diagnostic functions (output site/censor information and the lagplot)
+#for the predict from data EventData object
+
+##' @include eventData.R
+NULL
+
+##' Output a data frame containing all subjects who been censored before
+##' a given date
+##' 
+##' Output a data frame containing all subjects who been censored before
+##' a given date not including subjects censored at end of follow up period
+##' 
+##' @param object An \code{EventData} object
+##' @param ... Additional parameters to be passed to the method
+##' @return A data frame with the required subject's data 
+##' @rdname censorInformation-methods
+##' @name censorInformation
+##' @export
+setGeneric("censorInformation",function(object,...) standardGeneric("censorInformation"))
+
+
+# Simple internal function for validating the analysis/censor date
+# arguments for the Diagnostic functions
+# @param date.arg The user's input date
+# @param default.date The default date to use if date.arg is null
+# @return date.arg or the default.date if date.arg is null
+# errors validating date.arg will throw an exception
+DiagDataArg <- function(date.arg,default.date){
+  if(is.null(date.arg)){
+    return(as.Date(default.date,origin="1970-01-01")) 
+  }
+  FixDates(date.arg)
+}
+
+
+##' @param censor.date All subjects who have a censor date before this
+##' date should be output, by default (i.e. when NULL) the latest date for which 
+##' any subject information (withdrawal/event/censor) is known
+##' @name censorInformation
+##' @aliases censorInformation,EventData-method
+##' @rdname censorInformation-methods
+##'@export
+setMethod("censorInformation", "EventData",
+  function(object, censor.date=NULL){
+    
+    censor.date <- DiagDataArg(censor.date,max(LastDate(object@subject.data)))
+      
+    data <-GetLaggedSubjects(object@subject.data,censor.date)
+          
+    if(nrow(data)==0){
+      return(data.frame(subject=character(0),
+                        timelag=numeric(0),
+                        rand.date=numeric(0),
+                        time=numeric(0)))
+    }
+            
+            
+    last.date <- LastDate(data)
+    data <- data.frame(subject=data$subject,
+                       timelag=as.numeric(censor.date-last.date),
+                       rand.date=data$rand.date,
+                       time=data$time)
+            
+    ans <- data[order(data$timelag,decreasing=TRUE),]
+    rownames(ans) <- 1:nrow(ans)
+    ans
+})
+
+
+##' Output a plot showing the lag between censoring and the date the analysis
+##' is being performed
+##' @param object An \code{EventData} object
+##' @param ... Additional arguments for the function 
+##' @rdname DiagnosticPlot-methods
+##' @name DiagnosticPlot
+##' @export
+setGeneric("DiagnosticPlot",function(object,...) standardGeneric("DiagnosticPlot"))
+
+
+
+##' @param window.size An optional integer. If used an additional 2 lines at y=x-window.size 
+##' and y = x-2*window.size are drawn on the graph. If \code{window.size} is chosen to be the
+##' visit schedule (in days) then these lines provide an easy way to determine the number of subjects
+##' who have missed one or two visits.
+##' @param analysis.date The date the analysis is being perfomed on, by default (i.e. when NULL) it is the
+##' the latest date at which any subject is censored/is known to have had an event
+##' @param separate.events Logical, if FALSE then all events are coloured the same with label "Had Event", if
+##' TRUE then the different event types (object@@subject.data$event.type) are coloured individually.
+##' @rdname DiagnosticPlot-methods
+##' @aliases DiagnosticPlot,EventData-method
+##' @name DiagnosticPlot
+##' @export
+setMethod("DiagnosticPlot","EventData",
+          function(object, window.size=NULL, analysis.date=NULL,separate.events=TRUE){
+            if(nrow(object@subject.data)==0)stop("Empty data frame!")    
+            
+            analysis.date <- DiagDataArg(analysis.date,max(LastDate(object@subject.data)))
+            
+            xlab <- paste("Days on study if subjects censored on",as.character(analysis.date)) 
+            ylab <- "Known days on study"
+            
+            time.on.study <- object@subject.data$time
+            
+            
+            status <- rep("Ongoing",nrow(object@subject.data))
+            status <- ifelse(object@subject.data$has.event==1,
+                              if(separate.events)as.character(object@subject.data$event.type) else "Had Event",status)
+            status <- ifelse(object@subject.data$censored.at.follow.up==1,"Censored after follow up period",status)
+            status <- ifelse(object@subject.data$withdrawn==1,"Withdrawn from Study",status)
+            
+       
+            my.data <- data.frame(subject=object@subject.data$subject,
+                                  rand.date=object@subject.data$rand.date,
+                                  time.on.study=time.on.study,
+                                  t.max=as.numeric(analysis.date - object@subject.data$rand.date + 1,origin="1970-01-01"),
+                                  status=status,
+                                  site=object@subject.data$site,
+                                  date.of.event.censor.or.withdrawal=LastDate(object@subject.data))
+            
+            
+            p <- ggplot(my.data, aes_string(x="t.max", y="time.on.study", color="status")) +
+              geom_point() + geom_abline(intercept=0, slope=1, col="black") +
+              xlab(xlab) + ylab(ylab)
+            
+            if(!is.null(window.size)){      
+              if(window.size<=0) stop("window.size should be positive")
+              p <- p + geom_abline(intercept=-window.size, slope=1, col="black",linetype = 2)+
+                geom_abline(intercept=-2*window.size, slope=1, col="black",linetype = 2)
+            }
+            p     
+          }
+)
+
+##' Output information about how up to date subject censor dates
+##' are for each site
+##'
+##' Output information about how up to date subject censor dates
+##' are for each site in the study subjects who are censored at the 
+##' end of their follow up period are
+##' not included in this analysis
+##' @param object An \code{EventData} object
+##' @param ... Additional arguments to be passed to the method
+##' @rdname siteInformation-methods
+##' @name siteInformation
+##' @export
+setGeneric("siteInformation",function(object,...) standardGeneric("siteInformation"))
+
+ 
+
+
+##'@param analysis.date The date the analysis is being perfomed on, by default (i.e. when NULL) it is the
+##' the latest date at which any subject is censored/is known to have had an event
+##'@param ndays The acceptable lag between \code{analysis.date} and censor date. If the lag is 
+##'greater than this then the subject will be included in the output data frame.
+##'@return A data frame with each row containing a site name and the number
+##'of subjects at this site with censor date before \code{analysis.date}-\code{ndays}
+##'@rdname siteInformation-methods
+##'@aliases siteInformation,EventData-method
+##'@name siteInformation
+##'@export
+setMethod("siteInformation", "EventData",
+          function(object, analysis.date=NULL, ndays){
+            if(ndays < 0 || class(ndays)!="numeric") stop("ndays must be numeric and non-negative")
+            if(all(is.na(object@subject.data$site))) stop("No site information")
+            
+            analysis.date <- DiagDataArg(analysis.date,max(LastDate(object@subject.data)))
+            
+            data <-GetLaggedSubjects(object@subject.data,analysis.date-ndays)$site
+            
+            if(length(data)==0){
+              return(data.frame(site=character(0),count=character(0)))
+            }
+            
+            sites <- as.data.frame(table(data))
+            colnames(sites) <- c("site","count")
+            sites <- sites[order(sites$count,decreasing=TRUE),]
+            rownames(sites) <- NULL
+            sites[sites$count > 0,]
+          })