---
title: "Pmetrics - Report"
author: "Laboratory of Applied Pharmacokinetics and Bioinformatics (LAPKB)"
date: "`r Sys.Date()`"
output:
  html_document:
    toc: true
    toc_depth: 3
params:
  res: FALSE
---

```{r setup, include = FALSE}
knitr::opts_chunk$set(echo = FALSE, warning = FALSE, message = FALSE)
library(dplyr)
library(Pmetrics)

```



```{r setup-extra, include = FALSE}
res = params$res
```

```{r preflight, include = FALSE}
if (is.null(params$res$final$data) & is.null(params$res$op$data) & is.null(params$res$cycle$data)) {
  knitr::asis_output("**Report not generated. Run did not complete.**")
  knitr::knit_exit()
} else {
  nsub <- nobs <- numeqt <- icyctot <- NULL #declare for CRAN check
  nsub <- res$final$nsub
  icyctot <- max(res$cycle$objective$cycle)
  numeqt <- max(res$op$data$outeq, na.rm = TRUE)
  np <- TRUE
}
```

`r cli::cli_h2("Report Rendering") `

## Summary

`r cli::cli_bullets(c(">" = "Run summary"))`

The data had `r nsub` subjects.

After `r paste0(icyctot, " cycles, the model status was \"", res$cycle$data$status, "\".")`

## Predictions

### Observed-predicted plot {.tabset .tabset-pills}

`r cli::cli_bullets(c(">" = "Observed vs. predicted plots"))`

Points should appear close to, and randomly distributed around, the (dashed) identity line.

``` {r op-plot, message = TRUE}

template <- c(
  "#### Outeq {{outeq}} {.tabset .tabset-pills}\n",
  "##### Population {.tabset .tabset-pills}\n",
  "###### Median\n",
  "```{r op-pop-median-{{outeq}}, message = TRUE}\n",
  "p <- res$op$plot(icen = 'median', pred.type = 'pop', outeq = {{outeq}},\n
  stats = list(x = 1, y = 0.1, font = list(size = 9)), print = FALSE)\n",
  "if (isTRUE(getOption('knitr.in.progress'))) click_plot(p, '#FF8D1EFF')\n",
  "```\n",
  "###### Mean\n",
  "```{r op-pop-mean-{{outeq}}, message = TRUE}\n",
  "p <- res$op$plot(icen = 'mean', pred.type = 'pop', outeq = {{outeq}},\n
  stats = list(x = 1, y = 0.1, font = list(size = 9)), print = FALSE)\n",
  "if (isTRUE(getOption('knitr.in.progress'))) click_plot(p, '#FF8D1EFF')\n",
  "```\n",
  "##### Posterior {.tabset .tabset-pills}\n",
  "###### Median\n",
  "```{r op-post-median-{{outeq}}, message = TRUE}\n",
  "p <- res$op$plot(icen = 'median', pred.type = 'post', outeq = {{outeq}},\n
  stats = list(x = 1, y = 0.1, font = list(size = 9)), print = FALSE)\n",
  "if (isTRUE(getOption('knitr.in.progress'))) click_plot(p, '#FF8D1EFF')\n",
  "```\n",
  "###### Mean\n",
  "```{r op-post-mean-{{outeq}}, message = TRUE}\n",
  "p <- res$op$plot(icen = 'mean', pred.type = 'post', outeq = {{outeq}},\n
  stats = list(x = 1, y = 0.1, font = list(size = 9)), print = FALSE)\n",
  "if (isTRUE(getOption('knitr.in.progress'))) click_plot(p, '#FF8D1EFF')\n",
  "```\n",
  "\n"
)

if (!is.null(res$op$data) & nrow(res$op$data) > 0){
  p <- lapply(1:numeqt, function(i) {
    knitr::knit_expand(
      outeq = i,
      text = template)
  })
} else {
  p <- list("PM_op object not created.")
}

```
`r knitr::knit_child(text = unlist(p))`

::: {.tabset .tabset-pills}
### Prediction metrics 

`r if (!is.null(res$op$data)) cli::cli_bullets(c(">" = "Prediction metrics"))`

```{r prediction-metrics-summary, include = FALSE}
#summary function
metrics <- function(icen, pred.type, outeq){
  pe <- res$op$summary(icen = icen,  pred.type = pred.type, outeq = outeq)$pe |>
    Pmetrics:::get_metric_info()
  if (stringr::str_detect(pe$metric_types[1], "%")){
    pe$metric_vals <- pe$metric_vals |> mutate(across(everything(), ~paste0(.x,"%"))) 
  }
  
  pe$metric_vals |> 
    DT::datatable(
      #colnames = c("Metric", "Value"),
      rownames = FALSE,
      options = list(
        searching = FALSE,
        pageLength = 10,
        lengthChange = FALSE,
        info = FALSE,
        dom = "t",
        autoHideNavigation = TRUE
      )
    )  
  #return(pe)
}

```

```{r prediction-metrics, include = FALSE}

template <- c(
  "#### Outeq {{outeq}} {.tabset .tabset-pills}\n",
  "##### Population {.tabset .tabset-pills}\n",
  "###### Median\n",
  "```{r op-pop-median-pred-metrics-{{outeq}}, message = F}\n",

  "metrics(icen = 'median', pred.type = 'pop', outeq = {{outeq}})\n",
  "```\n",
  "###### Mean\n",
  "```{r op-pop-mean-pred-metrics-{{outeq}}, message = F}\n",

  "metrics(icen = 'mean', pred.type = 'pop', outeq = {{outeq}})\n",
  "```\n",
  "##### Posterior {.tabset .tabset-pills}\n",
  "###### Median\n",
  "```{r op-post-median-pred-metrics-{{outeq}}, message = F}\n",

  "metrics(icen = 'median', pred.type = 'post', outeq = {{outeq}})\n",
  "```\n",
  "###### Mean\n",
  "```{r op-post-mean-pred-metrics-{{outeq}}, message = F}\n",

  "metrics(icen = 'mean', pred.type = 'post', outeq = {{outeq}})\n",
  "```\n",
  "\n"
)


if(!is.null(res$op$data)){
  p <- lapply(1:numeqt, function(i) {
    knitr::knit_expand(
      outeq = i,
      text = template)
  })
} else {
  p <- list("PM_op object not created.")
}


```
`r knitr::knit_child(text = unlist(p))`
:::

```{r bias-imp-type, echo = FALSE, results = "asis", error = TRUE, cache = FALSE}
if (!is.null(res$op$data)){
  pe <- res$op$summary()$pe |> Pmetrics:::get_metric_info()
  types <- pe$metric_types
  cat(glue::glue("Bias is (pred - obs)  {types$bias}. Imprecision is {types$imprecision}. Change these with `setPMoptions()`."))
}
```


### Prediction residuals {.tabset .tabset-pills}

`r if (!is.null(res$op$data)) cli::cli_bullets(c(">" = "Residual plots"))`


Residuals should be randomly distributed around zero, with no apparent trend.
For how to interpret these plots, please review our [website](https://lapkb.github.io/Pmetrics). Weighted prediction errors are weighted by the observation standard deviation, i.e. the error polynomial.

``` {r prediction-residuals, include = FALSE}

template <- c(
  "#### Outeq {{outeq}} {.tabset .tabset-pills}\n",
  "##### Population {.tabset .tabset-pills}\n",
  "###### Median\n",
  "```{r op-pop-median-pred-resid-{{outeq}}, message = F}\n",

  "p <- res$op$plot(resid = T, icen = 'median', pred.type = 'pop', outeq = {{outeq}}, print = FALSE)\n",
  "if (isTRUE(getOption('knitr.in.progress'))) click_plot(p, '#FF8D1EFF')\n",
  "```\n",
  "###### Mean\n",
  "```{r op-pop-mean-pred-resid-{{outeq}}, message = F}\n",

  "p <- res$op$plot(resid = T, icen = 'mean', pred.type = 'pop', outeq = {{outeq}}, print = FALSE)\n",
  "if (isTRUE(getOption('knitr.in.progress'))) click_plot(p, '#FF8D1EFF')\n",
  "```\n",
  "##### Posterior {.tabset .tabset-pills}\n",
  "###### Median\n",
  "```{r op-post-median-pred-resid-{{outeq}}, message = F}\n",

  "p <- res$op$plot(resid = T, icen = 'median', pred.type = 'post', outeq = {{outeq}}, print = FALSE)\n",
  "if (isTRUE(getOption('knitr.in.progress'))) click_plot(p, '#FF8D1EFF')\n",
  "```\n",
  "###### Mean\n",
  "```{r op-post-mean-pred-resid-{{outeq}}, message = F}\n",

  "p <- res$op$plot(resid = T, icen = 'mean', pred.type = 'post', outeq = {{outeq}}, print = FALSE)\n",
  "if (isTRUE(getOption('knitr.in.progress'))) click_plot(p, '#FF8D1EFF')\n",
  "```\n",
  "\n"
)


if (!is.null(res$op$data)){
p <- lapply(1:numeqt, function(i) {
    knitr::knit_expand(
      outeq = i,
      text = template)
  })
} else {
  p <- list("PM_op object not created.")
}

```
`r knitr::knit_child(text = unlist(p), options = list(fig.width = 10))`

## Parameter values and distributions

`r if (!is.null(res$final$popPoints)) cli::cli_bullets(c(">" = "Parameter summaries"))`


### Parameter summaries
The model included the following primary parameters
```{r par_summaries}
if(!is.null(res$final$data)){
  par_lims <- data.frame(
    par = res$final$ab$par,
    min = res$final$ab$min,
    max = res$final$ab$max,
    ave = t(res$final$popMean),
    med = t(res$final$popMed),
    sd = t(res$final$popSD),
    cv = 100*t(res$final$popCV),
    shrink = 100*t(res$final$shrinkage)
    
  ) |>
    dplyr::mutate(across(4:8,\(x) round(x, 3)))

  par_lims |> 
    dplyr::rename(`Parameter` = par,
                  `Lower limit` = min,
                  `Upper limit` = max,
                  `Mean` = ave,
                  `Median` = med,
                  `SD` = sd,
                  `CV%` = cv,
                  `%shrink` = shrink) |> 
    DT::datatable(
      options = list(
        searching = FALSE,
        pageLength = 10,
        info = FALSE,
        dom = "t"
        #autoHideNavigation = TRUE
      ),
      rownames = FALSE
    )
} else {
  knitr::asis_output("PM_final object not created.")
}
```

### Marginal plots

`r if (!is.null(res$final$data)) cli::cli_bullets(c(">" = "Marginal plots"))`

Probability distributions, dashed lines are limits.

``` {r marginal-plots, results = "asis"}
if (!is.null(res$final$data)){
  p <- res$final$plot(print = FALSE)
  p
} else {
  knitr::asis_output("PM_final object not created.")
}
```

<!-- ### Posterior parameter distributions -->
<!-- Posterior parameter density estimates based on the mean and median icen. -->

<!-- ```{r} -->
<!-- pmean = res$final$postMean |> -->
<!--   mutate(type = "Mean") -->

<!-- pmedian = res$final$postMed |> -->
<!--   mutate(type = "Median") -->

<!-- pmean |>  -->
<!--   bind_rows(pmedian) |> -->
<!--   pivot_longer(cols = -c(id, type)) |> -->
<!--   left_join(par_lims, by = "name") |> -->
<!--   ggplot(aes(x = value)) + -->
<!--   geom_density(aes(col = type, fill = type), alpha = 0.5) + -->
<!--   geom_vline(aes(xintercept = lower),  -->
<!--              lty = "dashed", alpha = 0.5) + -->
<!--   geom_vline(aes(xintercept = upper),  -->
<!--              lty = "dashed", alpha = 0.5) + -->
<!--   facet_wrap( ~ name, scales = "free") + -->
<!--   labs(x = "Parameter value", -->
<!--        y = "Density", -->
<!--        fill = NULL, -->
<!--        col = NULL) + -->
<!--   theme(legend.position = "bottom") -->
<!-- ``` -->

```{r support-points, conditional-text, eval = np, echo = FALSE}
if (!is.null(res$final$popPoints)){
knitr::asis_output("### Table of support points\n\n
The following table lists the final support points, in order of decreasing probability.\n")
}
```

`r if (!is.null(res$final$popPoints)) {cli::cli_bullets(c(">" = "Support points"))}`

```{r support-points-table}
if (!is.null(res$final$popPoints) & np){
  res$final$popPoints |> 
    dplyr::arrange(desc(prob)) |> 
    dplyr::mutate(across(everything(), \(x) round2(x)
    )) |> 
    dplyr::mutate(`Cumulative Probability` = round2(cumsum(prob))) |> 
    dplyr::rename(Probability = prob) |> 
    DT::datatable(options = list(pageLength = 10, searching = FALSE))
}
```

### Covariance/Correlation matrices {.tabset .tabset-pills}

`r if (!is.null(res$final$data)) cli::cli_bullets(c(">" = "Covariance/correlation matrices"))`


#### Correlation

```{r correlation, message = F}
if (!is.null(res$final$data)){
  res$final$popCor |> tibble::as_tibble() |>
  dplyr::mutate(across(everything(), \(x) round2(x))) |> 
  (\(x) DT::datatable(x, rownames = colnames(x), options = list(pageLength = 10, searching = FALSE)))() |>
  DT::formatStyle(0, fontWeight = "bold")
} else {
  knitr::asis_output("PM_final object not created.")
}
```

#### Covariance

```{r covariance, message = F}
if (!is.null(res$final$data)){
  res$final$popCov |> tibble::as_tibble() |>
  dplyr::mutate(across(everything(), \(x) round2(x))) |> 
  (\(x) DT::datatable(x, rownames = colnames(x), options = list(pageLength = 10, searching = FALSE)))() |>
  DT::formatStyle(0, fontWeight = "bold")
} else {
  knitr::asis_output("PM_final object not created.")
}
```


## Cycle information

`r if (!is.null(res$cycle$data)) cli::cli_bullets(c(">" = "Cycle plots"))`

```{r cycle_info, fig.dim = c(10, 6), results = "asis"}
if (!is.null(res$cycle$data)){
  if (res$cycle$status == "Posterior") {
    knitr::asis_output("Posterior run, so no cycles.")
  } else {
    p <- res$cycle$plot(print = FALSE)
    p
  }
} else {
  knitr::asis_output("PM_cycle object not created.")
}
```

`r cli::cli_text("Done! Opening in browser...")`


<!-- THE FOLLOWING SECTION CONTAINS JAVASCRPT SUPPORT FUNCTIONS -->
```{js}
// This code ensures that click "Mean" tab changes all tabs to "Mean"
// Original code from https://community.rstudio.com/t/rmarkdown-html-change-all-tabs-on-click/160943


<!-- // make sure html is fully loaded -->
<!-- document.addEventListener("DOMContentLoaded", function() { -->
<!-- document.addEventListener('click', function(event) { -->
<!-- if (event.target.getAttribute('data-toggle') === 'tab') { -->
<!-- var clickedTabId = event.target.getAttribute('href').replace(/-[0-9]*/g, ''); -->

<!-- var tabs = document.querySelectorAll('[href^="' +                            clickedTabId + '"][data-toggle="tab"]') -->

<!-- for (var i = 0; i < tabs.length; i++) { -->
<!-- $(tabs[i]).tab('show'); -->
<!-- } -->
<!-- } -->
<!-- }) -->
<!-- }); -->
<!-- ``` -->



```{js}
$("input.hideshow").each(function(index, button) {
button.value = 'Hide Output';
$(button).click(function() {
var target = this.nextSibling ? this : this.parentNode;
target = target.nextSibling.nextSibling.nextSibling.nextSibling;
if (target.style.display == 'block' || target.style.display == '') {
target.style.display = 'none';
this.value = 'Show Output';
} else {
target.style.display = 'block';
this.value = 'Hide Output';
}
});
});
$("input.hideshow").click()
```

