######################################################################################
######################################################################################
#
# DeducerSurvival survival curves and tests for Deducer Ockendon & Cool
# Current Version 1.0
# 10.03.2011
######################################################################################
######################################################################################


KMDialog <- new(SimpleRDialog)
KMDialog$setTitle("KM Survival")
KMDialog$setSize(600L,500L)
#add variable selector
	variableSelector <- new(VariableSelectorWidget)
	variableSelector$setTitle("data")
	addComponent(KMDialog,variableSelector,10,200,850,10)
#add a list for the FollowUp variable
	FollowUpList<- new(VariableListWidget,variableSelector)
	FollowUpList$setTitle("FollowUp",TRUE)
	addComponent(KMDialog, FollowUpList,10,500,260, 200)
#add a list for the Event variable
	EventList<- new(VariableListWidget,variableSelector)
	EventList$setTitle("Event",TRUE)
	addComponent(KMDialog, EventList,290,500,540, 200)
#add a list for the Group variable
	GroupList<- new(VariableListWidget,variableSelector)
	GroupList$setTitle("Group",TRUE)
	addComponent(KMDialog, GroupList,570,500,820, 200)
#add three text boxes to set the colour of up to three survival curves
	colour1Area <- new(TextAreaWidget,"Colour1")	
	addComponent(KMDialog, colour1Area,10,990,120, 600)
	colour1Area$setDefaultModel(c("black"))
	colour2Area <- new(TextAreaWidget,"Colour2")	
	addComponent(KMDialog, colour2Area,150,990,260, 600)
	colour2Area$setDefaultModel(c("black"))
	colour3Area <- new(TextAreaWidget,"Colour3")
	addComponent(KMDialog, colour3Area,290,990,400, 600)
	colour3Area$setDefaultModel(c("black"))
#add a variable for the Confidence interval
	confBoxes <- new(ButtonGroupWidget,"Confidence",c("0","0.95","0.99"))
	addComponent(KMDialog, confBoxes,430,990,680, 600)
	confBoxes$setDefaultModel(c("0.95"))
#output options
	KMDialog$setCheckFunction(".KMCheckFunction")
	KMDialog$setRunFunction(".KMRunFunction")

######################################################################################

.KMCheckFunction <- function(state){
	#make sure at least one variables is selected for each of FollowUp and Event
	if(length(state$FollowUp)<1){
		return("Please select a 'Follow Up' variable")}

	if(length(state$FollowUp)>1){
		return("Please select only one 'Follow Up' variable")}

	if(length(state$Event)<1){
		return("Please select an 'Event' variable")}

	if(length(state$Event)>1){
		return("Please select only one 'Event' variable")}

	if(length(state$Group)>1){
		return("Please select only one 'Group' variable")}
	

	return("")

}

#######################################################################################

.KMRunFunction <- function(state){
#make formula for Survival Object
	cmd <- paste("attach(",state$data)
	cmd <- paste(cmd,")\n")
	cmd <- paste(cmd,"mySurvival = Surv(")
	cmd <- paste(cmd,state$FollowUp)
	cmd <- paste(cmd,",")
	cmd <- paste(cmd,state$Event)
	cmd <- paste(cmd,")\n")

#present summary of survival object
	cmd <- paste(cmd,"summary(mySurvival)\n")
	
#fit a and plot KM curve 
# enter here the colour selection from the dialogue for con interval and colour
	conf <- state$Confidence
	colour1 <- state$Colour1
	colour2 <- state$Colour2
	colour3 <- state$Colour3
	groupvar <- state$Group

if(length(state$Group)<1){
	cmd <- paste(cmd,"mycurve=survfit(mySurvival~1,conf.int=")
}else if (length(state$Group)>0){
	cmd <- paste(cmd,"mycurve=survfit(mySurvival~")
	cmd <- paste(cmd,groupvar)
	cmd <- paste(cmd,",conf.int=")
}
	cmd <- paste(cmd,conf)
	cmd <- paste(cmd,")\n")
	
	cmd <- paste(cmd,"summary(mycurve)\n")
	cmd <- paste(cmd,"plot(mycurve, col=c(")
	dblquote <- "\""
	cmd <- paste(cmd,dblquote)
	cmd <- paste(cmd,colour1)
	cmd <- paste(cmd,dblquote)
	cmd <- paste(cmd,",")
	cmd <- paste(cmd,dblquote)
	cmd <- paste(cmd,colour2)
	cmd <- paste(cmd,dblquote)
	cmd <- paste(cmd,",")
	cmd <- paste(cmd,dblquote)
	cmd <- paste(cmd,colour3)
	cmd <- paste(cmd,dblquote)
	cmd <- paste(cmd,"))\n")

	title <- "\"Kaplan Meier Curve\""
	xlab <- "\"Follow Up Duration\""
	ylab <- "\"Probability\""
	cmd <- paste(cmd,"title(main=")
	cmd <- paste(cmd,title)
	cmd <- paste(cmd,",xlab=")
	cmd <- paste(cmd,xlab)
	cmd <- paste(cmd,",ylab=")
	cmd <- paste(cmd,ylab,")\n")
execute(cmd)
}
	

######################################################################################
######################################################################################
######################################################################################
######################################################################################

Compare <- new(SimpleRDialog)
Compare$setTitle("Compare Survival Curves")
Compare$setSize(600L,500L)
#add variable selector
	variableSelector <- new(VariableSelectorWidget)
	variableSelector$setTitle("data")
	addComponent(Compare,variableSelector,10,200,850,10)
#add a list for the FollowUp variables
	FollowUpList<- new(VariableListWidget,variableSelector)
	FollowUpList$setTitle("FollowUp",TRUE)
	addComponent(Compare, FollowUpList,10,500,260, 200)
#add a list for the Event variables
	EventList<- new(VariableListWidget,variableSelector)
	EventList$setTitle("Event",TRUE)
	addComponent(Compare, EventList,290,500,540, 200)
#add a list for the Group variable
	GroupList<- new(VariableListWidget,variableSelector)
	GroupList$setTitle("Group",TRUE)
	addComponent(Compare, GroupList,570,500,820, 200)
#add a selection parameter for the parametric regression analysis
	paraBoxes <- new(ButtonGroupWidget,"Parametric",c("extreme","logistic","gaussian","weibull","exponential","rayleigh","loggaussian","lognormal","loglogistic","t"))
	addComponent(Compare, paraBoxes,10,990,680, 600)
	paraBoxes$setDefaultModel(c("weibull"))
#output options
	Compare$setCheckFunction(".CompareCheckFunction")
	Compare$setRunFunction(".CompareRunFunction")

######################################################################################

.CompareCheckFunction <- function(state){
	#make sure at least one variables is selected for each: FollowUp, Event and Group
	if(length(state$FollowUp)<1){
		return("Please select a 'Follow Up' variable")}
	if(length(state$FollowUp)>1){
		return("Please select only one 'Follow Up' variable")}
	if(length(state$Event)<1){
		return("Please select an 'Event' variable")}
	
	if(length(state$Event)>1){
		return("Please select only one 'Event' variable")}
	
	if(length(state$Group)<1){
		return("Please select a 'Group' variable")}
	if(length(state$Group)>1){
		return("Please select only one 'Group' variable")}

	return("")
}

#######################################################################################


.CompareRunFunction <- function(state){
#make formula for Survival Object
	cmd <- paste("attach(",state$data)
	cmd <- paste(cmd,")\n")
	cmd <- paste(cmd,"mySurvival = Surv(")
	cmd <- paste(cmd,state$FollowUp)
	cmd <- paste(cmd,",")
	cmd <- paste(cmd,state$Event)
	cmd <- paste(cmd,")\n")
	
# set parameters for formula below:
	paratest <- state$Parametric
	groupvar <- state$Group
	dblquote <- "\""

# Perform the logrank test on the mySurvival object:
	cmd <- paste(cmd,"mylogrank=survdiff(mySurvival~")
	cmd <- paste(cmd,groupvar)
	cmd <- paste(cmd,")\n")
	cmd <- paste(cmd,"mylogrank\n")

# Perform the cox proportional hazards on the mySurvival object:
	cmd <- paste(cmd,"mycoxph=coxph(mySurvival~")
	cmd <- paste(cmd,groupvar)
	cmd <- paste(cmd,")\n")
	cmd <- paste(cmd,"mycoxph\n")
	
# Perform parametric regression analysis on the mySurvival object:
	cmd <- paste(cmd,"myparametric=survreg(mySurvival~")
	cmd <- paste(cmd,groupvar)
	cmd <- paste(cmd,",")
	cmd <- paste(cmd,"dist =")
	cmd <- paste(cmd,dblquote)
	cmd <- paste(cmd,paratest,sep='')
	cmd <- paste(cmd,dblquote,sep='')
	cmd <- paste(cmd,")\n")
	cmd <- paste(cmd,"myparametric\n")
execute(cmd)
}


#######################################################################################
#######################################################################################
#
# Add custom menu to deducer interface
# Ockendon V0.1
#

#######################################################################################
#######################################################################################

deducer.addMenu("Survival")
deducer.addMenuItem("Kaplan Meier",,"KMDialog$run()","Survival")
if(.windowsGUI){
	winMenuAdd("Survival")
	winMenuAddItem("Survival", "Kaplan Meier", "deducer('Kaplan Meier')")
}else if(.jgr){
	jgr.addMenu("Survival")
	jgr.addMenuItem("Survival", "Kaplan Meier", "deducer('Kaplan Meier')")
}
deducer.addMenuItem("Compare",,"Compare$run()","Survival")
	if(.windowsGUI){
		winMenuAdd("Survival")
		winMenuAddItem("Survival", "Compare", "deducer('Compare')")
	}else if(.jgr){
		jgr.addMenu("Survival")
		jgr.addMenuItem("Survival", "Compare", "deducer('Compare')")
}


#######################################################################################
#######################################################################################