R/reporting_functions.R

In rgriffier/statsBordeaux: Helpful tool to describe and analyse dataset

#' #' @title Add text element into the document
#' #' @title Add text element into the document
#' #' @param doc a rdocx element
#' #' @param title a character vector of length 1, the text elemen to display
#' #' @param style a character vector of length 1. Style coult be get executing the function styles_info(doc),
#' #' in the style_name column
#' #' @return an rdocx element with the text element at the end
#' #' @export
#' #' @examples
#' #' doc <- read_docx()
#' #' doc <- addTextElement(doc, "Titre 1 : description of the dataset", style = "heading 1")
#' #' print(doc, target = "output.docx")
#' addTextElement <- function(doc, title, style){
#'   doc %>%
#'     body_add_par(value = title, style = style) %>%
#'     body_add_par(value = '', style = 'Normal')
#'   return(doc)
#' }
#'
#'
#' #' @title Add table into a rdocx element
#' #' @description Add table generated by statsBordeaux package
#' #' @param doc a rdocx element
#' #' @param table a data.frame generated by statsBordeaux package
#' #' @param title a character vector of length one, the title of the table to display
#' #' @param displayTestName boolean, if TRUE, name of the statistic test will be displayed. Default to TRUE
#' #' @param modalitySize double, size in inch of the modality column
#' #' @param descriptionSize double, size in inch of the description column
#' #' @param valueSize double, size in inch of the value column
#' #' @param testSize double, size in inch of the test name column
#' #' @return a rdocx element with the table at the end of the document
#' #' @export
#' #' @examples
#' #' data(mtcars)
#' #' output <- createOutput()
#' #' output <- statsQT(output, mtcars, "mpg")
#' #' doc <- read_docx()
#' #' doc <- addTable(doc, output, "Description of mpg variable from the mtcars dataset")
#' #' print(doc, target = "output.docx")
#' addTable <- function(doc, table, title, displayTestName = TRUE,
#'                      modalitySize = 1, descriptionSize = 1.1, valueSize = 1, testSize = 2) {
#'   doc %>%
#'     body_add_par(value = title, style = 'table title') %>%
#'     slip_in_text(' : ', style = 'Default Paragraph Font', pos = 'before') %>%
#'     slip_in_seqfield(str = 'SEQ table \\* Arabic \\s 1 \\* MERGEFORMAT',
#'                      style = 'Default Paragraph Font', pos = 'before') %>%
#'     slip_in_text('.', style = 'Default Paragraph Font', pos = 'before') %>%
#'     slip_in_seqfield(str = sprintf("STYLEREF %.0f \\s", 1),
#'                      style = 'Default Paragraph Font', pos = "before") %>%
#'     slip_in_text('Tableau ', style = 'Default Paragraph Font', pos = 'before') %>%
#'     body_add_flextable(displayTable(table = table, displayTestName = displayTestName,
#'                                     modalitySize = modalitySize, descriptionSize = descriptionSize,
#'                                     valueSize = valueSize, testSize = testSize))  %>%
#'     body_add_par(value = '', style = 'Normal')
#'   return(doc)
#' }
#'
#'
#' #' @title Add table into a rdocx element
#' #' @description Add table generated by statsBordeaux package
#' #' @param doc a rdocx element
#' #' @param table a data.frame generated by statsBordeaux package
#' #' @param title a character vector of length one, the title of the table to display
#' #' @param modalitySize double, size in inch of the modality column
#' #' @return a rdocx element with the table at the end of the document
#' #' @export
#' #' @examples
#' #' data("mtcars")
#' #' mtcars$vs <- as.factor(mtcars$vs)
#' #' table <- statsBordeaux::setMultivariableRegression(data = mtcars,
#' #'                                                    dependentVariable = "mpg",
#' #'                                                    independentVariables = c("cyl", "disp", "vs"),
#' #'                                                    round = 2)
#' #' doc <- read_docx()
#' #' doc <- addTable(doc, table, "Description of mpg variable from the mtcars dataset")
#' #' print(doc, target = "output.docx")
#' addRegressionTable <- function(doc, table, title, modalitySize = 1, sampleSize = 1, parameterSize = 1, confintSize = 2) {
#'   doc %>%
#'     body_add_par(value = title, style = 'table title') %>%
#'     slip_in_text(' : ', style = 'Default Paragraph Font', pos = 'before') %>%
#'     slip_in_seqfield(str = 'SEQ table \\* Arabic \\s 1 \\* MERGEFORMAT',
#'                      style = 'Default Paragraph Font', pos = 'before') %>%
#'     slip_in_text('.', style = 'Default Paragraph Font', pos = 'before') %>%
#'     slip_in_seqfield(str = sprintf("STYLEREF %.0f \\s", 1),
#'                      style = 'Default Paragraph Font', pos = "before") %>%
#'     slip_in_text('Tableau ', style = 'Default Paragraph Font', pos = 'before') %>%
#'     body_add_flextable(displayRegressionTable(table = table,
#'                                               modalitySize = modalitySize,
#'                                               sampleSize = sampleSize,
#'                                               parameterSize = parameterSize,
#'                                               confintSize = confintSize))  %>%
#'     body_add_par(value = '', style = 'Normal')
#'   return(doc)
#' }
#'
#'
#' #' @title Add table of description of i2b2 data into a rdocx element
#' #' @description Add table of description of i2b2 data into a rdocx element
#' #' @param doc a rdocx element
#' #' @param table a data.frame, containing description of i2b2data
#' #' @param title a character vector of length one, the title of the table to display
#' #' @return a rdocx element with the table at the end of the document
#' #' @export
#' addDataDescriptionTable <- function(doc, table, title) {
#'   doc %>%
#'     body_add_par(value = title, style = 'table title') %>%
#'     slip_in_text(' : ', style = 'Default Paragraph Font', pos = 'before') %>%
#'     slip_in_seqfield(str = 'SEQ table \\* Arabic \\s 1 \\* MERGEFORMAT',
#'                      style = 'Default Paragraph Font', pos = 'before') %>%
#'     slip_in_text('.', style = 'Default Paragraph Font', pos = 'before') %>%
#'     slip_in_seqfield(str = sprintf("STYLEREF %.0f \\s", 1),
#'                      style = 'Default Paragraph Font', pos = "before") %>%
#'     slip_in_text('Tableau ', style = 'Default Paragraph Font', pos = 'before') %>%
#'     body_add_flextable(displayDataDescriptionTable(table = table))  %>%
#'     body_add_par(value = '', style = 'Normal')
#'   return(doc)
#' }
#'
#'
#' #' @title Add plot element into a rdocx element
#' #' @description Add plot element into a rdocx element
#' #' @param doc a rdocx element
#' #' @param plot a plot element
#' #' @param title a character vector of length one, containing the totre of the plot to display
#' #' @param width a double vector of length one, the width in inch of the plot
#' #' @param height a double vector of length one, the height in inch of the plot
#' #' @return a rdocx element with a plot at the end
#' #' @export
#' #' @examples
#' #' data(mtcars)
#' #' mtcars$vs <- as.factor(mtcars$vs)
#' #' plot <- ggplot2::ggplot(mtcars, ggplot2::aes(x = vs, y=mpg)) +
#' #'   ggplot2::geom_boxplot()
#' #' doc <- read_docx()
#' #' doc <- addPlot(doc, plot, "mpg function of vs")
#' #' print(doc, target = "output.docx")
#' addPlot <- function(doc, plot, title, width = 7, height = 7) {
#'
#'   # Saving plot into emf file
#'   filename <- tempfile(fileext = ".emf")
#'   emf(file = filename, width = width, height = height)
#'   print(plot)
#'   dev.off()
#'
#'   # Saving plot into word
#'   doc %>%
#'     body_add_par(value = title, style = 'graphic title') %>%
#'     slip_in_text(' : ', style = 'Default Paragraph Font', pos = 'before') %>%
#'     slip_in_seqfield(str = 'SEQ graph \\* Arabic \\s 1 \\* MERGEFORMAT',
#'                      style = 'Default Paragraph Font', pos = 'before') %>%
#'     slip_in_text('.', style = 'Default Paragraph Font', pos = 'before') %>%
#'     slip_in_seqfield(str = sprintf("STYLEREF %.0f \\s", 1),
#'                      style = 'Default Paragraph Font', pos = "before") %>%
#'     slip_in_text('Figure ', style = 'Default Paragraph Font', pos = 'before') %>%
#'     body_add_img(src = filename, width = width, height = height, style = 'graphic title') %>%
#'     body_add_par(value = '', style = 'Normal')
#'
#'   return(doc)
#' }
#'
#'
#' #' @title Add a break to a rdocx element
#' #' @description Add a bread to a rdocx element
#' #' @param doc a rdocx element
#' #' @param landscapecontinuous a boolean. Must be TRUE in case of landscape disposition to be continued after the break.
#' #' Default to FALSE
#' #' @return a rdocx element with a break at the end
#' #' @export
#' #' @examples
#' #' doc <- read_docx()
#' #' doc <- addTextElement(doc, "Titre 1 : description of the dataset", style = "heading 1")
#' #' doc <- addBreak(doc)
#' #' doc <- addTextElement(doc, "Titre 2 : comparaison of the dataset", style = "heading 1")
#' #' doc <- setLandscape(doc, add_break = TRUE)
#' #' doc <- addBreak(doc, landscapeContinuous = TRUE)
#' #' doc <- addTextElement(doc, "Titre 3 : plot", style = "heading 1")
#' #' doc <- setLandscape(doc, add_break = FALSE)
#' #' print(doc, target = "output.docx")
#' addBreak <- function(doc, landscapeContinuous = FALSE) {
#'   if (landscapeContinuous == FALSE) {
#'     doc %>%
#'       body_add_break() %>%
#'       body_end_section_continuous()
#'   } else {
#'     doc %>%
#'       body_add_break()
#'   }
#'   return(doc)
#' }
#'
#'
#' #' @title Add new line to rdocx element
#' #' @description Add a new line to rdocx element
#' #' @param doc a rdocx element
#' #' @return a rdocx element with a new line at the end
#' #' @export
#' #' @examples
#' #' data(mtcars)
#' #' mtcars$vs <- as.factor(mtcars$vs)
#' #' plot <- ggplot2::ggplot(mtcars, ggplot2::aes(x = vs, y=mpg)) +
#' #'   ggplot2::geom_boxplot()
#' #'
#' #' doc <- read_docx()
#' #' doc <- addTextElement(doc, "Titre 1 : description of the dataset", style = "heading 1")
#' #' doc <- addNewLine(doc)
#' #' doc <- addNewLine(doc)
#' #' doc <- addPlot(doc, plot, "mpg function of vs")
#' #' print(doc, target = "output.docx")
#' addNewLine <- function(doc){
#'   doc %>%
#'     body_add_par(value = '', style = 'Normal')
#'   return(doc)
#' }
#'
#'
#' #' @title Set to landscape the previsous section
#' #' @description Set to previsous the previsous section
#' #' @param doc a rdocx element
#' #' @param add_break a boolean, if TRUE, add break after the landscape section.
#' #' @return a rdocx element with the last section as landscape
#' #' @export
#' #' @examples
#' #' doc <- read_docx()
#' #' doc <- addTextElement(doc, "Titre 1 : description of the dataset", style = "heading 1")
#' #' doc <- addNewLine(doc)
#' #' doc <- addNewLine(doc)
#' #' doc <- addPlot(doc, plot, "mpg function of vs")
#' #' doc <- setLandscape(doc)
#' #' print(doc, target = "output.docx")
#' setLandscape <- function(doc, add_break = FALSE){
#'   if(add_break == TRUE){
#'     doc %>%
#'       body_end_section_landscape() %>%
#'       body_add_break()
#'
#'   } else {
#'     doc %>%
#'       body_end_section_landscape()
#'   }
#'   return(doc)
#' }
#'
#'
#' #' @title Add table of content to rdocx element
#' #' @description Add table of content to rdocx element
#' #' @param doc a rodcx element
#' #' @param title a character vector of length one, the title of the table of content
#' #' @param style a character vector of length one, the style of the title of the table of content. Styles could
#' #' be found with the styles_info(doc) function
#' #' @param level a numeric vector of length one, the deep of the tithe hierarchy to display
#' #' @return a rdocx element with the table of content
#' #' @export
#' #' @examples
#' #' doc <- read_docx()
#' #' doc <- addTableOfContent(doc, title = "Table of content", style = "Normal", level = 3)
#' #' doc <- addBreak(doc)
#' #' doc <- addTextElement(doc, "Titre 1 : description of the dataset", style = "heading 1")
#' #' doc <- addTextElement(doc, "Titre 2 : comparaison of the dataset", style = "heading 1")
#' #' doc <- addTextElement(doc, "Titre 2.1 : comparaison of the dataset depend on the sexe variable", style = "heading 2")
#' #' doc <- addTextElement(doc, "Titre 2.2 : description of the dataset depend on the group variable", style = "heading 2")
#' #' print(doc, target = "output.docx")
#' addTableOfContent <- function(doc, title, style, level){
#'   doc %>%
#'     body_add_par(value = title, style = style) %>%
#'     body_add_toc(level = level)
#'   return(doc)
#' }
#'
#'
#' #' @title Add a table of tables into a rdocx element
#' #' @description Add a table of tables into a rdocx element
#' #' @param doc a rdocx element
#' #' @param title a character vector of length one, the title of the table of tables
#' #' @param style a character vector of length one, the style of the title of the table of tables
#' #' @return a rdocx element with a table of table
#' #' @export
#' #' @examples
#' #' data(mtcars)
#' #' output <- createOutput()
#' #' output <- statsQT(output, mtcars, "mpg")
#' #' doc <- read_docx()
#' #' doc <- addTable(doc, output, "Description of mpg variable from the mtcars dataset")
#' #' doc <- addBreak(doc)
#' #' doc <- addTableOfTables(doc, title = "Table of tables", style = "Normal")
#' #' print(doc, target = "output.docx")
#' addTableOfTables <- function(doc, title, style){
#'   doc %>%
#'     body_add_par(value = title, style = style) %>%
#'     body_add_toc(style = 'table title')
#'   return(doc)
#' }
#'
#'
#' #' @title Add a table of graphics into a rdocx element
#' #' @description Add a table of graphics into a rdocx element
#' #' @param doc a rdocx element
#' #' @param title a character vector of length one, the title of the table of graphics
#' #' @param style a character vector of length one, the style of the title of the table of graphics
#' #' @return a rdocx element with a table of graphics
#' #' @export
#' #' @examples
#' #' doc <- read_docx()
#' #' doc <- addTextElement(doc, "Titre 1 : description of the dataset", style = "heading 1")
#' #' doc <- addNewLine(doc)
#' #' doc <- addNewLine(doc)
#' #' doc <- addPlot(doc, plot, "mpg function of vs")
#' #' doc <- setLandscape(doc)
#' #' doc <- addTableOfGraphics(doc, title = "Table of graphics", style = "Normal")
#' #' print(doc, target = "output.docx")
#' addTableOfGraphics <- function(doc, title, style){
#'   doc %>%
#'     body_add_par(value = title, style = style) %>%
#'     body_add_toc(style = 'graphic title')
#'   return(doc)
#' }