R/output.R

In jasenfinch/metaboWorkflows: Workflow Project Templates for Metabolomics Analyses

reportHeader <- function(x){
  glue('
---
title: "{projectName(x)}"
output: html_document
---
')
}

reportOptions <- function(){
  report_options <- 'knitr::opts_chunk$set(echo = FALSE,fig.align = "center")' %>% 
    parse_expr()
  
  chunk(!!report_options,
        label = 'setup',
        chunk_options = list(include = FALSE)) %>% 
    rmd()
}

#' @importFrom chunky chunk rmd label<-
#' @importFrom purrr compact
#' @importFrom stringr str_replace_all str_to_title str_detect str_to_sentence
#' @importFrom rlang parse_expr

reportBody <- function(x){
  output_targets <- targets(x) %>% 
    map(~{
      .x %>% 
        map_chr(name) %>% 
        .[str_detect(.,'parameters') |
            str_detect(.,'results') |
            str_detect(.,'plot') | 
            str_detect(.,'summary')
            ]
    }) %>% 
    compact()
  
  output_chunks <- output_targets %>%
    names() %>% 
    map(~{
      
      if (.x == 'pre_treatment'){
        title <- 'pre-treatment' 
      } else {
        title <- .x
      }
      title <- title %>% 
        str_replace_all('_',' ') %>% 
        str_to_title() %>% 
        {glue('## {.}')}
      
      chunks <- map(output_targets[[.x]],~{
        
        target_name <- .x %>% 
          parse_expr()
        
        if (str_detect(.x,'parameters') |
            str_detect(.x,'results') |
            str_detect(.x,'plot')){
          target_chunk <- chunk(tar_read(!!target_name)) 
        }
        
        if (str_detect(.x,'summary')){
          sig_fig <- glue('{.x} <- metaboMisc::sanitiseTable({.x})') %>% 
          as.character() %>% 
            parse_expr()
          
          table_caption <- target_name %>% 
            deparse() %>% 
            str_replace_all('_',' ') %>%
            str_replace_all('summary','summary of') %>%
            str_to_sentence()
          
          summary_table <- glue('DT::datatable({.x},rownames = FALSE,filter = "top",caption = "{table_caption}")') %>% 
            as.character() %>% 
            parse_expr()
          target_chunk <- chunk(tar_load(!!target_name),
                                !!sig_fig,
                                !!summary_table)
        }
        
        label(target_chunk) <- str_replace_all(.x,'_','-')
        target_chunk <- rmd(target_chunk) 
        
        return(target_chunk)
      })
      
      c(list(title),chunks)
    }) %>% 
    flatten() %>% 
    glue_collapse(sep = '\n\n')
  
}

reportFooter <- function(x){
  glue('
-----------
Generated by [metaboWorkflows](https://jasenfinch.github.io/metaboWorkflows/) v{packageVersion("metaboWorkflows") %>% as.character()}
')
}

setMethod('rmd',signature = 'Workflow',
          function(x){
            report_header <- reportHeader(x)
            report_options <- reportOptions()
            report_body <- reportBody(x)
            report_footer <- reportFooter(x)
            
            glue_collapse(c(report_header,
                            report_options,
                            report_body,
                            report_footer),
                          sep = '\n\n')
          })