PerTrialReportDev.Rmd

PerTrialReportDev.Rmd

---
title: 'Biolumic Plant Trial Performance Report: `r params$trial_description`'
author: "BioLumic R&D"
date: "`r format(Sys.time(), '%d %B, %Y')`"
output:
  html_document:
    keep_md: false
    toc: true
    toc_float: true
    toc_depth: 4
params:
    TRLID: Nothing
    input_data: tibble
    trial_description: Nothing
---

# Trial Design and Assessment

Need Trial Description information here


```{r setup, include=FALSE}
knitr::opts_chunk$set(echo = FALSE)
library(knitr)
#library(kableExtra)
#library(DT) #remotes::install_github('rstudio/DT')
#library(tidyverse)
`%nin%` <- Negate(`%in%`)

```


```{r inputs, message=FALSE, warning=FALSE, error=FALSE, fig.retina=TRUE, fig.height=7, fig.width=8, results = 'asis'}


print_plots <- function(title, plot) {
  cat(title)
  print(plot)
  cat("  \n\n")
}

print_pca_plots <- function(title, plot) {
  if (is.na(title)){
      cat(glue::glue("#### PCA  \n\n"))
      print(plot)
  } else {
      if (is.numeric(title)) {
        cat(glue::glue("#### PCA {title} DAS \n\n"))
      } else {
        cat(glue::glue("#### PCA Stage {title} \n\n"))
      }
      print(plot)
  }
  cat("  \n\n")
}

var_level_print_function <- function(MATNM, input_df, corrplots, pcaplots) {
 	cat(glue::glue("## {MATNM}  \n\n"))

  cat(glue::glue("### {MATNM} Correlogram  \n\n"))
  cat(glue::glue("The following plot is a correlation matrix of all variables for {MATNM}. Pearson's Correlation Coefficient (r) is represented by color. Dark red indicates a positive correlation and dark blue indicates a negative correlation (from -1 to 1). The significance of each correlation is computed in a pairwise manner and is represented by ***, **, *, and . (< 0.001, < 0.01, < 0.05, and < 0.1, respectively).  \n\n"))
  print(corrplots)
  cat("  \n\n")

  cat(glue::glue("### {MATNM} PCA  \n\n"))
  cat(glue::glue("The following plot(s) are principal component analysis (PCA)  of all variables for {MATNM}. If the plots are broken up by stage it is because the data is broken up that way. You'll see this in the above correlation matrix as gray boxes with ? where the data does not overlap.  \n\n"))
  cat("  \n\n")
  pwalk(list(pcaplots$DAS, pcaplots$PCA_plots), ~print_pca_plots(..1, ..2))
  cat("  \n\n")

  cat(glue::glue("### Trait Correlation Table  \n\n"))

#output
  sorted_df <-
  	input_df %>%
      select(Tissue, Stage = assessment_stage, var_organ, Trait_Description, p_val, plots_HSD) %>%
      arrange(Stage, Tissue, p_val)

  sorted_df %>%
    select(-plots_HSD) %>%
    mutate(
            p_value_spec = symnum(p_val, cutpoints=c(0,0.001,0.01,0.05,0.1,0.5,1), symbols=1:6, legend = FALSE),
            p_val_fac = as.character(factor(p_value_spec, 1:6, rainbow(6))),
            p_val = formatC(p_val, 3, format="f"),
            p_val = kableExtra::cell_spec(p_val,
                             format = "html",
                             color = "black",
                             align = "c",
                             background = if_else(is.na(p_val_fac), "#000000", p_val_fac)
                             )
    ) %>%
    select(-p_value_spec, -p_val_fac) %>%
	  knitr::kable(., format = 'html', escape = FALSE, digits = 4) %>%
	  kableExtra::kable_styling(full_width = FALSE, position = "left", bootstrap_options = c("striped", "hover", "condensed", "responsive")) %>%
    print(.)

    cat("  \n\n")
    
    cat("### Trait Level Plots    \n\n")
    
    prepped_df <-
      sorted_df %>%
        mutate(
              p_val = formatC(p_val, 3, format="f"),
              title = glue::glue("#### {Tissue} {Stage} {var_organ} p < {p_val} \n\n")
              )
  
    pwalk(list(prepped_df$title, prepped_df$plots_HSD), ~print_plots(..1, ..2))
}
```

```{r outputs, message=FALSE, warning=FALSE, error=FALSE, fig.retina=TRUE, fig.height=7, fig.width=8, results = 'asis'}

nested_var_data <- params$input_data
#nested_var_data <- moa %>% pull(trl_data) %>% .[[1]]

    
pwalk(list(nested_var_data$MATNM, nested_var_data$var_data, nested_var_data$corr_plot, nested_var_data$PCAs), ~var_level_print_function(..1, ..2, ..3, ..4))

```