---
title: "Survival Extrapolation"
output:
  html_document:
    toc: yes
    toc_float: yes
    self_contained: true
  pdf_document: default
  word_document: default
date: "`r format(Sys.time(), '%d %B %Y, %H:%M')`"
fontsize: 11pt
params:
  allfits: NA
  individual: NA
  survivalDF: NA
  targetTime: NA
  breakTime: NA
  truncationTime: NA
  timeUnit: NA
  reportDistributions: NA
  reportGroup1: NA
  reportGroup2: NA
  dist1: NA
  dist2: NA
  inputMethod: NA
  reportScenarioTest: NA
  expRange: NA
  reportExtrapolation: NA
  useWeights: NA
  alpha: NA
---

```{r global_options, include=FALSE}
knitr::opts_chunk$set(echo=FALSE, warning=FALSE, message=FALSE,
                      fig.pos = 'h',
                      fig.align = 'center')
```

```{r non-html outputs, eval = !knitr::is_html_output()}
knitr::opts_chunk$set(fig.height = 3,
                      fig.width = 4)
```


```{r helper function}

library(ggplot2)

makeSurvSummaryTable <- function(survDF, sf = 3, useWeights = FALSE){
  
  nTreatments <- length(levels(survDF$treatment))
  
  sTable <- array(NA, c(nTreatments, 5))
  rownames(sTable) <- levels(survDF$treatment)
  colnames(sTable) <- c("n", "events", "minimum", "median", "maximum")
  
  if(useWeights == FALSE){
  sv <- survival::survfit(survival::Surv(time, event) ~ treatment,
                          data = survDF)}else{
                            sv <- survival::survfit(survival::Surv(time, event) ~ treatment,
                                                    weights = weights,
                                                    data = survDF)
                            
                          }
  table_output <- summary(sv)$table
  
  # Need to keep array format with column names if only one treatment group:
  if(nTreatments == 1){
    dnames <- names(table_output)
    dim(table_output) <- c(1, 9)
    colnames(table_output) <- dnames
  }
  
  sTable[, c("n", "events", "median")] <- table_output[, c("records", "events", "median")]
  sTable[, c("minimum")] <- tapply(survDF$time, survDF$treatment, min)
  sTable[, c("maximum")] <- tapply(survDF$time, survDF$treatment, max)
  
  sTable[, c("minimum", "maximum", "median") ] <- 
    signif( sTable[, c("minimum", "maximum", "median")  ], sf)
  
  sTable

}

```



# Survival data

```{r make surivival summary data}
nTreatments <- length(levels(params$survivalDF$treatment))
sdf <- makeSurvSummaryTable(params$survivalDF, useWeights = params$useWeights)
knitr::kable(sdf, caption = "Summary statistics for the provided survival data")
```


```{r basic KM plot}

index <- params$survivalDF$time > params$truncationTime
truncatedDf <- params$survivalDF
truncatedDf$event[index] <- 0
truncatedDf$time[index] <- params$truncationTime


 if(params$useWeights == TRUE){
        fit <- survival::survfit(survival::Surv(time, event) ~ treatment,
                                 weights = weights,
                                 data = truncatedDf)}else{
        fit <- survival::survfit(survival::Surv(time, event) ~ treatment, data = truncatedDf)
                                 }
                                
                                 
      myplot<- survminer::ggsurvplot(fit, data = truncatedDf, censor = TRUE,
                                      legend = "right",
                                      legend.title = "",
                            conf.int = TRUE,
                            legend.labs = levels(truncatedDf$treatment),
                            xlim = c(0, params$targetTime),
                            xlab = paste0("Time (", params$timeUnit, ")"),
                            break.time.by = params$targetTime/8)
      if(length(levels(truncatedDf$treatment))==1){
        myplot$plot <- myplot$plot +  theme(legend.position = "none") 
      }
      myplot$plot +
        geom_vline(xintercept = params$targetTime, linetype="dotted") 
```

```{r make KM table}
knitr::kable(makeSurvivalTable(params$survivalDF,
                               params$breakTime,
                               params$truncationTime,
                               params$timeUnit,
                               dp = 2,
                               useWeights = params$useWeights),
             caption = "The survivor column is the proportion surviving after the end of the corresponding time interval. The hazard column is the proportion who do not survive to the end of the time interval, out of those who survived to the beginning of the time interval.")
```


<!-- Group 1 -->

`r  if(params$reportGroup1){paste0('# Results for treatment group: "', levels(params$survivalDF$treatment)[1], '"')}`

`r  if(params$reportGroup1){paste0('**Quantity of Interest definition**: the proportion surviving for at least ', params$targetTime, ' ', params$timeUnit, ' in the treatment group "',levels(params$survivalDF$treatment)[1], '".')}`


`r  if(params$reportGroup1){"## Individual judgements"}`


```{r group 1 individual judgements, eval = params$reportGroup1}
knitr::kable(params$individual[[1]])
```


```{r plot group 1 individual judgements, eval = params$reportGroup1}
if(params$inputMethod == "quartiles"){
  p1 <- plotQuartiles(vals = params$individual[[1]][2:4, ],
                              lower = params$individual[[1]][1, ],
                              upper = params$individual[[1]][5, ],
                              expertnames = colnames(params$individual[[1]]),
                              xlabel = "Surivivor proportion")
}

if(params$inputMethod == "tertiles"){
  p1 <- plotTertiles(vals = params$individual[[1]][2:4, ],
                              lower = params$individual[[1]][1, ],
                              upper = params$individual[[1]][5, ],
                              expertnames = colnames(params$individual[[1]]),
                              xlabel = "Surivivor proportion")
}
print(p1 + theme_bw()+ coord_flip())
```


`r  if(params$reportGroup1 & params$reportScenarioTest){"## Scenario Testing"}`

```{r scenario testing group 1, eval = (params$reportGroup1 & params$reportScenarioTest) }

sce <- survivalScenario(tLower = 0,
                        tUpper = min(params$truncationTime,
                                     max(params$survivalDF$time)),
                        expLower= params$expRange[1],
                        expUpper = params$expRange[2],
                        expGroup = levels(params$survivalDF$treatment)[1],
                        tTarget = params$targetTime,
                        survDf = params$survivalDF,
                        groups = levels(params$survivalDF$treatment),
                        xl = paste0("Time t (", params$timeUnit, ")"),
                        showPlot = FALSE,
                        useWeights = params$useWeights)
print(sce$KMplot)
     
```



`r  if(params$reportGroup1){"## RIO distribution"}`

```{asis, echo = params$reportGroup1}
The elicited RIO probabilities were as follows
```



```{r , eval = params$reportGroup1}
captionTextGroup1 <- paste0("The probability density function and cumulative distribution function fitted to RIO's probabilities for the Quantity of Interest: 
                            the proportion surviving for at least ", params$targetTime, " ",
                            params$timeUnit, " in the treatment group ",
                            levels(params$survivalDF$treatment)[1], ".")
expert <- 1
sf <- 3
mydf <- data.frame( params$allfits[[1]]$vals[expert, ], params$allfits[[1]]$probs[expert, ])
colnames(mydf) <- c( "$x$", "$P(X\\le x)$")
knitr::kable(mydf)
```

```{r, eval = params$reportGroup1, fig.cap=captionTextGroup1,  fig.show='hold', out.width = '45%'}
plotfit(params$allfits[[1]], xlab = "survival proportion", ylab = "density", d = params$dist1)
makeCDFPlot(lower = 0, upper = 1, v = params$allfits[[1]]$vals[1, ],
            p = params$allfits[[1]]$probs[1, ], dist = params$dist1,
            showFittedCDF = TRUE,  fit = params$allfits[[1]],
            xlab = "survival proportion", ylab = "cumulative probability")
```


```{r,  eval = params$reportGroup1}
tableCaption1 <-  paste0("Percentiles from the distribution fitted to RIO's probabilities for the Quantity of Interest: the proportion suriving for at least time ", params$targetTime, " ",
                            params$timeUnit, ' in the treatment group "',
                            levels(params$survivalDF$treatment)[1], '".')
fb1 <- feedback(params$allfits[[1]],
                quantiles = c(0.01, 0.1, 0.5, 0.9, 0.99))$fitted.quantiles[, params$dist1]
fb1 <- matrix(fb1, nrow = 1)
colnames(fb1) <- paste0(c(1, 10, 50, 90, 99), "%")
knitr::kable(fb1, caption = tableCaption1)
```


<!-- Group 2 -->

`r  if(params$reportGroup2){paste0('# Results for treatment group: "', levels(params$survivalDF$treatment)[2], '"')}`

`r  if(params$reportGroup1){paste0('**Quantity of Interest definition**: the proportion surviving for at least ', params$targetTime, ' ', params$timeUnit, ' in the treatment group "',levels(params$survivalDF$treatment)[2], '".')}`


`r  if(params$reportGroup2){"## Individual judgements"}`


```{r, eval = params$reportGroup2}
knitr::kable(params$individual[[2]])
```

```{r, eval = params$reportGroup2}
if(params$inputMethod == "quartiles"){
  p2 <- plotQuartiles(vals = params$individual[[2]][2:4, ],
                              lower = params$individual[[2]][1, ],
                              upper = params$individual[[2]][5, ],
                              expertnames = colnames(params$individual[[2]]),
                              xlabel = "Surivivor proportion")
}

if(params$inputMethod == "tertiles"){
  p2 <- plotTertiles(vals = params$individual[[2]][2:4, ],
                              lower = params$individual[[2]][1, ],
                              upper = params$individual[[2]][5, ],
                              expertnames = colnames(params$individual[[2]]),
                              xlabel = "Surivivor proportion")
}
print(p2 + theme_bw()+ coord_flip())
```

`r  if(params$reportGroup2 & params$reportScenarioTest){"## Scenario Testing"}`

```{r scenario testing group 2, eval = (params$reportGroup2 & params$reportScenarioTest) }
sce <- survivalScenario(tLower = 0,
                        tUpper = min(params$truncationTime,
                                     max(params$survivalDF$time)),
                        expLower= params$expRange[1],
                        expUpper = params$expRange[2],
                        expGroup = levels(params$survivalDF$treatment)[2],
                        tTarget = params$targetTime,
                        survDf = params$survivalDF,
                        groups = levels(params$survivalDF$treatment),
                        xl = paste0("Time t (", params$timeUnit, ")"),
                        showPlot = FALSE,
                        useWeights = params$useWeights)
print(sce$KMplot)
```



`r  if(params$reportGroup2){"## RIO distribution"}`

```{asis, echo = params$reportGroup2}
The elicited RIO probabilities were  as follows
```



```{r, eval = params$reportGroup2}
captionTextGroup2 <- paste0("The probability density function and cumulative distribution function fitted to RIO's probabilities for the Quantity of Interest: 
                            the proportion surviving for at least ", params$targetTime, " ",
                            params$timeUnit, " in the treatment group ",
                            levels(params$survivalDF$treatment)[2], ".")
expert <- 1
sf <- 3
mydf <- data.frame( params$allfits[[2]]$vals[expert, ], params$allfits[[1]]$probs[expert, ])
colnames(mydf) <- c( "$x$", "$P(X\\le x)$")
knitr::kable(mydf)
```

```{r RIO group 2, eval = params$reportGroup2, fig.cap = captionTextGroup2, fig.show = 'hold', out.width = '45%'}
plotfit(params$allfits[[2]], xlab = "survival proportion", ylab = "density", d = params$dist2)
makeCDFPlot(lower = 0, upper = 1, v = params$allfits[[2]]$vals[1, ],
            p = params$allfits[[2]]$probs[1, ], dist = params$dist2,
            showFittedCDF = TRUE, fit = params$allfits[[2]],
            xlab = "survival proportion", ylab = "cumulative probability")
```

```{r,  eval = params$reportGroup2}
tableCaption2 <-  paste0("Percentiles from the distribution fitted to RIO's probabilities for the Quantity of Interest: the proportion suriving for at least time ", params$targetTime, " ",
                            params$timeUnit, ' in the treatment group "',
                            levels(params$survivalDF$treatment)[2], '".')
fb2 <- feedback(params$allfits[[2]],
                quantiles = c(0.01, 0.1, 0.5, 0.9, 0.99))$fitted.quantiles[, params$dist2]
fb2 <- matrix(fb2, nrow = 1)
colnames(fb2) <- paste0(c(1, 10, 50, 90, 99), "%")
knitr::kable(fb2, caption = tableCaption2)
```

`r  if(params$reportExtrapolation){"# Extrapolation results"}`

```{r extrapolation results, eval = params$reportExtrapolation}

if(length(params$allfits) > 1){
  group2RIO <- params$allfits[[2]]
  fqRIO2 <- params$dist2}else{
    group2RIO <- NULL
    fqRIO2 <- NULL
}

survivalExtrapolatePlot(params$survivalDF,
                        myfit1 = params$allfits[[1]],
                                          myfit2 = group2RIO,
                                          fqDist1 = params$dist1,
                                          fqDist2 = fqRIO2,
                                          tTruncate = params$truncationTime,
                                          tTarget = params$targetTime,
                                          alpha = params$alpha,
                                          useWeights = params$useWeights,
                                          groups = levels(params$survivalDF$treatment),
                                          xl = paste0("Time t (", params$timeUnit, ")"),
                                          breakTime = params$targetTime/8,
                                          showPlot = TRUE,
                                          returnPlot = FALSE) 

```


`r  if(params$reportDistributions){"# Appendix: all fitted distributions"}`
`r  if(params$reportDistributions){paste0('## Treatment group: "', levels(params$survivalDF$treatment)[1], '"')}`

```{r, echo = FALSE}
fit <- params$allfits[[1]]
bin.left <- NA
bin.right <- NA
chips <- NA
roulette <- FALSE
filename <- system.file("shinyAppFiles", "distributionsChild.Rmd", package="SHELF")
```

```{r child=filename, eval = params$reportDistributions }
```

`r  if(params$reportDistributions & params$reportGroup2 ){paste0('## Treatment group: "', levels(params$survivalDF$treatment)[2], '"')}`

```{r, echo = FALSE, eval =  params$reportGroup2}
fit <- params$allfits[[2]]
bin.left <- NA
bin.right <- NA
chips <- NA
roulette <- FALSE
filename <- system.file("shinyAppFiles", "distributionsChild.Rmd", package="SHELF")
```

```{r child=filename, eval =  (params$reportGroup2 & params$reportDistributions)}
```