#####################################
#                                   #
#  Author: Bernhard Breil           #
#                                   #
#  Date:   2010-08-12               #  
#                                   #
#####################################


#Bibliotheken einbinden
library(cmprsk)
library(survival)
library(Design)

#initialize PDF-File
pdffile     <- "HIS based Kaplan-Meier.pdf"
pdf(pdffile)

#read data from csv file
myWorkingData <- read.csv2("kmdata.csv",as.is=T, row.names = NULL)

#use myWorkingData as current object
attach(myWorkingData)

#use DataFrame
myDataFrame <- data.frame(myWorkingData)

#sort data frame, relevant data in first row
myDataFrame <- myDataFrame[order(myDataFrame$PATID,partial=order(myDataFrame$FUDatum)),]  

#elimante duplicated PatID -> keep current patient status
myWorkFrame <- myDataFrame[!duplicated(myDataFrame[,"PATID"]),]

#Birthday
BirthdayR <- as.Date(myWorkFrame$Geburtsdatum, "%d.%m.%Y")

#Age & median Age
AgeR <- as.numeric(difftime(Sys.Date(), BirthdayR ,units=c("days"))/365)
medianAgeR <- format(median(AgeR, na.rm = TRUE), digits = 4)

#Diagnosis Dates
DiagnosisDateExactR <- as.Date(myWorkFrame$DiagDatum, "%d.%m.%Y")
DiagnosisDateMonthR <- as.Date(ISOdate(myWorkFrame$DiagJahr,myWorkFrame$DiagMonat,01,00,00),"%d.%m.%Y")
DiagnosisDateYearR  <- as.Date(ISOdate(myWorkFrame$DiagJahr,01,01,00,00), "%d.%m.%Y")

DiagnosisDateR <- DiagnosisDateExactR 
DiagnosisDateR[is.na(DiagnosisDateR)] <- DiagnosisDateMonthR[is.na(DiagnosisDateR)]
DiagnosisDateR[is.na(DiagnosisDateR)] <- DiagnosisDateYearR[is.na(DiagnosisDateR)]

#Therapy Dates
TherDateBeginR <- as.Date(myWorkFrame$TherVon, "%d.%m.%Y")
TherDateEndR   <- as.Date(myWorkFrame$TherVon, "%d.%m.%Y")

#Median TherDate
medianTherDateBegin <- median(TherDateBeginR, na.rm=TRUE)

#FollowUp Dates
FollowUpDateExactR <- as.Date(myWorkFrame$FUDatum, "%d.%m.%Y")
FollowUpDateMonthR <- as.Date(ISOdate(myWorkFrame$FUJahr,myWorkFrame$FUMonat,01,00,00), "%d.%m.%Y")
FollowUpDateYearR  <- as.Date(ISOdate(myWorkFrame$FUJahr,01,01,00,00), "%d.%m.%Y")

FollowUpDateR <- FollowUpDateExactR
FollowUpDateR[is.na(FollowUpDateR)] <- FollowUpDateMonthR[is.na(FollowUpDateR)]
FollowUpDateR[is.na(FollowUpDateR)] <- FollowUpDateYearR[is.na(FollowUpDateR)]
FollowUpDateR[is.na(FollowUpDateR)] <- FollowUpDatePSAR[is.na(FollowUpDateR)]

#Overall Survival
StatusOS <- myWorkFrame$FUStatus
StatusOS[myWorkFrame$FUStatus=="Rezidivfrei"] <- 0
StatusOS[myWorkFrame$FUStatus=="PSA-Rezidiv"] <- 0
StatusOS[myWorkFrame$FUStatus=="Bildgebend PCA"] <- 0
StatusOS[myWorkFrame$FUStatus=="Tod durch PCA"] <- 1
StatusOS[myWorkFrame$FUStatus=="Tod unabhängig vom PCA"] <- 1
StatusOS[myWorkFrame$FUStatus=="Tod unbekannte Ursache"] <- 1
StatusOS <- as.numeric(StatusOS)

#Event Free Survival
StatusEFS <- myWorkFrame$FUStatus
StatusEFS[myWorkFrame$FUStatus=="Rezidivfrei"] <- 0
StatusEFS[myWorkFrame$FUStatus=="PSA-Rezidiv"] <- 1
StatusEFS[myWorkFrame$FUStatus=="Bildgebend PCA"] <- 1
StatusEFS[myWorkFrame$FUStatus=="Tod durch PCA"] <- 1
StatusEFS[myWorkFrame$FUStatus=="Tod unabhängig vom PCA"] <- 1
StatusEFS[myWorkFrame$FUStatus=="Tod unbekannte Ursache"] <- 1
StatusEFS <- as.numeric(StatusEFS)

#Therapeutic KM
time  <- as.numeric(difftime(FollowUpDateR, TherDateBeginR, units=c("days")))

#Groups
group <- as.numeric(TherDateBeginR)
group[TherDateBeginR <= medianTherDateBegin] <-0
group[TherDateBeginR > medianTherDateBegin] <-1

#DataFrame Creation
dataFrameOS = data.frame(time=time, status=StatusOS)
dataFrameEFS = data.frame(time=time, status=StatusEFS)
dataFramePCSS = data.frame(time=time, status=StatusPCSS)

#Groups
dataFrameOSG = data.frame(time=time, status=StatusOS, x=group)
dataFrameEFSG = data.frame(time=time, status=StatusEFS, x=group)

#Overall Survival
fitOS <- survfit(Surv((time/365), status) ~ 1, data = dataFrameOS, type="kaplan-meier") 
plot(fitOS, lty = 2:3, xlim=c(0,15), xlab="years", ylab ="survival probability", main="Overall survival") 
legend(0, .2, c("survival function", "95% confidence interval"), lty = 2:3) 
text(fitOS$time[!duplicated(trunc(fitOS$time))]+0.2, 0, format(fitOS$n.risk[!duplicated(trunc(fitOS$time))]), cex = 0.5 ) 

#Event Free Survival
fitEFS <- survfit(Surv((time/365), status) ~ 1, data = dataFrameEFS, type="kaplan-meier") 
plot(fitEFS, lty = 2:3,  xlim=c(0,15), xlab="years", ylab ="survival probability", main="Event-free survival") 
legend(0, .2, c("survival function", "95% confidence interval"), lty = 2:3) 
text(fitEFS$time[!duplicated(trunc(fitEFS$time))]+0.2, 0, format(fitEFS$n.risk[!duplicated(trunc(fitEFS$time))]), cex = 0.5 ) 

#Overall Survival (groups)
fitOSG <- survfit(Surv((time/365), status) ~ x, data = dataFrameOSG, type="kaplan-meier") 
plot(fitOSG, lty = 2:3, xlim=c(0,15), xlab="years", ylab ="survival probability", main="Overall survival") 
legend(0, .2, c("Group 0: therapy date <= median therapy date", "Group 1: therapy date > median therapy date"), lty = 2:3) 
text(fitOSG$time[!duplicated(trunc(fitOSG$time))]+0.2, 0, format(fitOSG$n.risk[!duplicated(trunc(fitOSG$time))]), cex = 0.5 ) 


#Event Free Survival (groups)
fitEFSG <- survfit(Surv((time/365), status) ~ x, data = dataFrameEFSG, type="kaplan-meier") 
plot(fitEFSG, lty = 2:3, xlim=c(0,15), xlab="years", ylab ="survival probability", main="Event-free survival") 
legend(0, .2, c("Group 0: therapy date <= median therapy date", "Group 1: therapy date > median therapy date"), lty = 2:3) 
text(fitEFSG$time[!duplicated(trunc(fitEFSG$time))]+0.2, 0, format(fitEFSG$n.risk[!duplicated(trunc(fitEFSG$time))]), cex = 0.5 ) 


#GroupTests
survdiff(Surv(time, status)~x, data = dataFrameOSG)
survdiff(Surv(time, status)~x, data = dataFrameEFSG)

overallSurvival5years <- round(fitOS$surv[round(fitOS$time)==5][1], 3)
eventFreeSurvival5years <- round(fitEFS$surv[round(fitEFS$time)==5][1], 3)
prostateCancerSpecificSurvival5years <- round(fitPCSS$surv[round(fitPCSS$time)==5][1], 3)
fitOSG$surv[round(fitOSG$time)==5][1]
fitEFSG$surv[round(fitEFSG$time)==5][1]


overallSurvival10years <- round(fitOS$surv[round(fitOS$time)==10][1],3)
eventFreeSurvival10years <- round(fitEFS$surv[round(fitEFS$time)==10][1],3)
prostateCancerSpecificSurvival10years <- round(fitPCSS$surv[round(fitPCSS$time)==10][1], 3)
fitOSG$surv[round(fitOSG$time)==10][1]
fitEFSG$surv[round(fitEFSG$time)==10][1]

# main info sheet
plot(0:10,type="n",axes=F,xlab="",ylab="",main="HIS based Kaplan-Meier",cex = .8)
text(6,10,paste("period:",format(min(TherDateBeginR, na.rm=TRUE),"%d.%m.%Y"),"(min therapy date) - ",max(myWorkFrame$FUDatum), "(max follow-up date)"),cex = .8)
text(5,7, paste("5-year-survival probability (OS)=",overallSurvival5years),cex = .8)
text(5,6, paste("5-year-survival probability (EFS)=",eventFreeSurvival5years),cex = .8)
text(5,4, paste("10-year-survival probability (OS)=",overallSurvival10years ),cex = .8)
text(5,3, paste("10-year-survival probability (EFS)=",eventFreeSurvival10years),cex = .8)

dev.off()