From 0ac5c8dce9efe5e7c5320afe19ac42bb44109eb1 Mon Sep 17 00:00:00 2001 From: yilong zhang Date: Wed, 25 Mar 2020 15:11:01 -0400 Subject: [PATCH 1/4] version v0.1.1 internal commit: 69b3caebd32 --- .DS_Store | Bin 6148 -> 0 bytes .Rbuildignore | 14 +- .gitignore | 2 + DESCRIPTION | 6 +- NEWS.md | 9 + R/add_attributes.R | 661 +++++++++---------- R/add_features.R | 951 +++++++++++++--------------- R/add_figure.R | 32 +- R/add_paragraph.R | 110 ++-- R/data.R | 1 - R/dictionary.R | 63 +- R/write_rtf.R | 243 ++++--- README.Rmd | 2 +- data/t1_gt.rda | Bin 1547 -> 7446 bytes data/t2_gt.rda | Bin 1230 -> 5943 bytes data/t3_gt.rda | Bin 1160 -> 5673 bytes data/unicode_latex.rda | Bin 5869 -> 6718 bytes man/rtf_body.Rd | 50 +- man/rtf_colheader.Rd | 41 +- man/rtf_encode.Rd | 6 +- man/rtf_figure.Rd | 18 +- man/rtf_footnote.Rd | 25 +- man/rtf_source.Rd | 25 +- man/rtf_title.Rd | 26 +- man/t1_gt.Rd | 2 +- man/t2_gt.Rd | 2 +- man/t3_gt.Rd | 2 +- man/unicode_latex.Rd | 2 +- man/write_rtf.Rd | 2 +- tests/testthat/test-convert_latex.R | 29 +- vignettes/example-figure.Rmd | 46 +- vignettes/example-pipeline.Rmd | 576 +++++++++++++++++ vignettes/example_pipeline.Rmd | 505 --------------- vignettes/rtf-row.Rmd | 152 +++-- vignettes/rtf-text.Rmd | 69 +- 35 files changed, 1858 insertions(+), 1814 deletions(-) delete mode 100644 .DS_Store create mode 100644 NEWS.md create mode 100644 vignettes/example-pipeline.Rmd delete mode 100644 vignettes/example_pipeline.Rmd diff --git a/.DS_Store b/.DS_Store deleted file mode 100644 index 7b9d33741ed04ce8ac5299ff580d34195ae35713..0000000000000000000000000000000000000000 GIT binary patch literal 0 HcmV?d00001 literal 6148 zcmeH~F^XlKsY>SV?}7 zi2>N|ciI9YfHmETFAp;_<^v|2amRW3`MzFmx2qRvA06ne-@9Kng5F0slS}y0a!*XM8#sVgw)umczJ?S%NHHAZxO9vO=?*9xPie z#t^SZJ6ZC&nrxlD9hSp~<(h|QedXQs^_Dh{|EYi^Z%?xsT7a` zZ>E3^`{RDcm&&vC>GiyR%Brs$os7#F9)1Ft_))x}hjG97f~?8b$qG$B0wIHf6nLou Ee?2S`p8x;= diff --git a/.Rbuildignore b/.Rbuildignore index 80374220..a2a050d7 100644 --- a/.Rbuildignore +++ b/.Rbuildignore @@ -1,10 +1,20 @@ +..Rcheck ^docs$ ^_pkgdown\.yml$ ^r2rtf\.Rproj$ ^\.Rproj\.user$ ^pkgdown$ ^pipelines-definition.groovy$ -^\vignettes\figure$ -^README.Rmd$ +^README\.Rmd$ ^LICENSES_THIRD_PARTY$ ^LICENSE$ +^inst\Rbadges$ +^\.gitignore$ +^\.DS_Store$ +^\.git\$ +^\vignettes\rtf$ +^\vignettes\fig$ +^\vignettes\example-figure.Rmd$ +^\vignettes\example-pipeline.Rmd$ +^\vignettes\rtf-row.Rmd$ +^\vignettes\rtf-text.Rmd$ diff --git a/.gitignore b/.gitignore index 0036c2f1..5941e122 100644 --- a/.gitignore +++ b/.gitignore @@ -3,3 +3,5 @@ docs .Rproj.user .Rhistory .RData +doc +Meta diff --git a/DESCRIPTION b/DESCRIPTION index 4dbb9993..85253711 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,17 +1,17 @@ Package: r2rtf Title: Easily Create Presentation-Ready RTF Table and Figure -Version: 0.1.0 +Version: 0.1.1 Authors@R: c( person("Yilong", "Zhang", email = "yilong.zhang@merck.com", role = c("aut", "cre")), person("Siruo", "Wang", email = "swang171@jhu.edu", role = c("aut")), person("Simiao", "Ye", email = "simiao.ye1@merck.com", role = c("aut")) ) Description: Create RTF table and figure with flexible format. -Depends: R (>= 3.4.0) +Depends: R (>= 3.5.0) License: GPL-3 Encoding: UTF-8 LazyData: true -RoxygenNote: 6.1.1 +RoxygenNote: 7.0.2 VignetteBuilder: knitr Roxygen: list(markdown = TRUE) Suggests: diff --git a/NEWS.md b/NEWS.md new file mode 100644 index 00000000..e6db40cd --- /dev/null +++ b/NEWS.md @@ -0,0 +1,9 @@ +# r2rtf 0.1.1 + +* standardize input from `gt_tbl` to `tbl` +* resolving UTF-8 encoding + +# r2rtf 0.1.0 + +* Added a `NEWS.md` file to track changes to the package. +* Initial Version diff --git a/R/add_attributes.R b/R/add_attributes.R index b541ff87..2e74134a 100644 --- a/R/add_attributes.R +++ b/R/add_attributes.R @@ -21,7 +21,7 @@ #' #' @description #' add title, subtitle, and other attributes to the object -#' @param gt_tbl a data frame +#' @param tbl a data frame #' @param title title string #' @param subtitle subtitle string #' @param font text font type @@ -40,7 +40,7 @@ #' @param hyphenation boolean value to indicate whether to use hyphenation #' #' @export -rtf_title <- function(gt_tbl, +rtf_title <- function(tbl, title = NULL, subtitle = NULL, @@ -53,7 +53,7 @@ rtf_title <- function(gt_tbl, justification = "c", indent_first = 0, - indent_left = 0, + indent_left = 0, indent_right = 0, space = 1, @@ -61,41 +61,33 @@ rtf_title <- function(gt_tbl, space_after = 180, new_page = FALSE, - hyphenation = TRUE){ - - - if ("rtf_heading" %in% names(attributes(gt_tbl))) { - - attr(gt_tbl, "rtf_heading")$title <- c(attr(gt_tbl, "rtf_heading")$title, title) - attr(gt_tbl, "rtf_heading")$subtitle <- c(attr(gt_tbl, "rtf_heading")$subtitle, subtitle) - - + hyphenation = TRUE) { + if ("rtf_heading" %in% names(attributes(tbl))) { + attr(tbl, "rtf_heading")$title <- c(attr(tbl, "rtf_heading")$title, title) + attr(tbl, "rtf_heading")$subtitle <- c(attr(tbl, "rtf_heading")$subtitle, subtitle) } else { - - attr(gt_tbl, "rtf_heading") <- list(title = title, subtitle = subtitle) - + attr(tbl, "rtf_heading") <- list(title = title, subtitle = subtitle) } - attr(gt_tbl, "rtf_heading")$font <- font - attr(gt_tbl, "rtf_heading")$format <- format - attr(gt_tbl, "rtf_heading")$font_size <- font_size - attr(gt_tbl, "rtf_heading")$color <- color - attr(gt_tbl, "rtf_heading")$background_color <- background_color - attr(gt_tbl, "rtf_heading")$justification <- justification - attr(gt_tbl, "rtf_heading")$indent_first <- indent_first - attr(gt_tbl, "rtf_heading")$indent_left <- indent_left - attr(gt_tbl, "rtf_heading")$indent_right <- indent_right - attr(gt_tbl, "rtf_heading")$space <- space - attr(gt_tbl, "rtf_heading")$space_before <- space_before - attr(gt_tbl, "rtf_heading")$space_after <- space_after - attr(gt_tbl, "rtf_heading")$new_page <- new_page - attr(gt_tbl, "rtf_heading")$hyphenation <- hyphenation - + attr(tbl, "rtf_heading")$font <- font + attr(tbl, "rtf_heading")$format <- format + attr(tbl, "rtf_heading")$font_size <- font_size + attr(tbl, "rtf_heading")$color <- color + attr(tbl, "rtf_heading")$background_color <- background_color + attr(tbl, "rtf_heading")$justification <- justification + attr(tbl, "rtf_heading")$indent_first <- indent_first + attr(tbl, "rtf_heading")$indent_left <- indent_left + attr(tbl, "rtf_heading")$indent_right <- indent_right + attr(tbl, "rtf_heading")$space <- space + attr(tbl, "rtf_heading")$space_before <- space_before + attr(tbl, "rtf_heading")$space_after <- space_after + attr(tbl, "rtf_heading")$new_page <- new_page + attr(tbl, "rtf_heading")$hyphenation <- hyphenation - gt_tbl + tbl } @@ -103,7 +95,7 @@ rtf_title <- function(gt_tbl, #' @title Add footnote attributes to the table #' -#' @param gt_tbl a data frame +#' @param tbl a data frame #' @param footnote footnote text #' @param font text font type #' @param font_size text font size @@ -121,7 +113,7 @@ rtf_title <- function(gt_tbl, #' @param hyphenation boolean value to indicate whether to use hyphenation #' #' @export -rtf_footnote <- function(gt_tbl, +rtf_footnote <- function(tbl, footnote = NULL, @@ -133,7 +125,7 @@ rtf_footnote <- function(gt_tbl, justification = "c", indent_first = 0, - indent_left = 0, + indent_left = 0, indent_right = 0, space = 1, @@ -141,44 +133,39 @@ rtf_footnote <- function(gt_tbl, space_after = 0, new_page = FALSE, - hyphenation = TRUE){ - - - if ("rtf_footnote" %in% names(attributes(gt_tbl))) { - - attr(gt_tbl, "rtf_footnote")$footnote <- c(attr(gt_tbl, "rtf_footnote")$footnote, footnote) - + hyphenation = TRUE) { + if ("rtf_footnote" %in% names(attributes(tbl))) { + attr(tbl, "rtf_footnote")$footnote <- c(attr(tbl, "rtf_footnote")$footnote, footnote) } else { - - attr(gt_tbl, "rtf_footnote") <- list(footnote = footnote) + attr(tbl, "rtf_footnote") <- list(footnote = footnote) } if (justification == "l") { - indent_left <- .footnote_source_space(gt_tbl) + indent_left <- .footnote_source_space(tbl) } else if (justification == "r") { - indent_right <- .footnote_source_space(gt_tbl) + indent_right <- .footnote_source_space(tbl) } - attr(gt_tbl, "rtf_footnote")$font <- font - attr(gt_tbl, "rtf_footnote")$format <- format - attr(gt_tbl, "rtf_footnote")$font_size <- font_size - attr(gt_tbl, "rtf_footnote")$color <- color - attr(gt_tbl, "rtf_footnote")$background_color <- background_color - attr(gt_tbl, "rtf_footnote")$justification <- justification - attr(gt_tbl, "rtf_footnote")$indent_first <- indent_first - attr(gt_tbl, "rtf_footnote")$indent_left <- indent_left - attr(gt_tbl, "rtf_footnote")$indent_right <- indent_right - attr(gt_tbl, "rtf_footnote")$space <- space - attr(gt_tbl, "rtf_footnote")$space_before <- space_before - attr(gt_tbl, "rtf_footnote")$space_after <- space_after - attr(gt_tbl, "rtf_footnote")$new_page <- new_page - attr(gt_tbl, "rtf_footnote")$hyphenation <- hyphenation + attr(tbl, "rtf_footnote")$font <- font + attr(tbl, "rtf_footnote")$format <- format + attr(tbl, "rtf_footnote")$font_size <- font_size + attr(tbl, "rtf_footnote")$color <- color + attr(tbl, "rtf_footnote")$background_color <- background_color + attr(tbl, "rtf_footnote")$justification <- justification + attr(tbl, "rtf_footnote")$indent_first <- indent_first + attr(tbl, "rtf_footnote")$indent_left <- indent_left + attr(tbl, "rtf_footnote")$indent_right <- indent_right + attr(tbl, "rtf_footnote")$space <- space + attr(tbl, "rtf_footnote")$space_before <- space_before + attr(tbl, "rtf_footnote")$space_after <- space_after + attr(tbl, "rtf_footnote")$new_page <- new_page + attr(tbl, "rtf_footnote")$hyphenation <- hyphenation - gt_tbl + tbl } @@ -187,7 +174,7 @@ rtf_footnote <- function(gt_tbl, #' @title Add data source attributes to the table #' -#' @param gt_tbl A data frame +#' @param tbl A data frame #' @param source data source text #' @param font text font type #' @param font_size text font size @@ -205,7 +192,7 @@ rtf_footnote <- function(gt_tbl, #' @param hyphenation boolean value to indicate whether to use hyphenation #' #' @export -rtf_source <- function(gt_tbl, +rtf_source <- function(tbl, source = NULL, @@ -217,7 +204,7 @@ rtf_source <- function(gt_tbl, justification = "c", indent_first = 0, - indent_left = 0, + indent_left = 0, indent_right = 0, space = 1, @@ -225,58 +212,51 @@ rtf_source <- function(gt_tbl, space_after = 0, new_page = FALSE, - hyphenation = TRUE){ - - - if ("rtf_source" %in% names(attributes(gt_tbl))) { - - attr(gt_tbl, "rtf_source")$source <- c(attr(gt_tbl, "rtf_source")$source, source) - + hyphenation = TRUE) { + if ("rtf_source" %in% names(attributes(tbl))) { + attr(tbl, "rtf_source")$source <- c(attr(tbl, "rtf_source")$source, source) } else { - - attr(gt_tbl, "rtf_source") <- list(source = source) + attr(tbl, "rtf_source") <- list(source = source) } if (justification == "l") { - indent_left <- .footnote_source_space(gt_tbl) + indent_left <- .footnote_source_space(tbl) } else if (justification == "r") { - indent_right <- .footnote_source_space(gt_tbl) + indent_right <- .footnote_source_space(tbl) } - attr(gt_tbl, "rtf_source")$font <- font - attr(gt_tbl, "rtf_source")$format <- format - attr(gt_tbl, "rtf_source")$font_size <- font_size - attr(gt_tbl, "rtf_source")$color <- color - attr(gt_tbl, "rtf_source")$background_color <- background_color - attr(gt_tbl, "rtf_source")$justification <- justification - attr(gt_tbl, "rtf_source")$indent_first <- indent_first - attr(gt_tbl, "rtf_source")$indent_left <- indent_left - attr(gt_tbl, "rtf_source")$indent_right <- indent_right - attr(gt_tbl, "rtf_source")$space <- space - attr(gt_tbl, "rtf_source")$space_before <- space_before - attr(gt_tbl, "rtf_source")$space_after <- space_after - attr(gt_tbl, "rtf_source")$new_page <- new_page - attr(gt_tbl, "rtf_source")$hyphenation <- hyphenation - - - gt_tbl - + attr(tbl, "rtf_source")$font <- font + attr(tbl, "rtf_source")$format <- format + attr(tbl, "rtf_source")$font_size <- font_size + attr(tbl, "rtf_source")$color <- color + attr(tbl, "rtf_source")$background_color <- background_color + attr(tbl, "rtf_source")$justification <- justification + attr(tbl, "rtf_source")$indent_first <- indent_first + attr(tbl, "rtf_source")$indent_left <- indent_left + attr(tbl, "rtf_source")$indent_right <- indent_right + attr(tbl, "rtf_source")$space <- space + attr(tbl, "rtf_source")$space_before <- space_before + attr(tbl, "rtf_source")$space_after <- space_after + attr(tbl, "rtf_source")$new_page <- new_page + attr(tbl, "rtf_source")$hyphenation <- hyphenation + + + tbl } #' Add page attributes to the table #' -#' @param gt_tbl A data frame +#' @param tbl A data frame #' @param page_width A numeric number to indicate page width. #' @param page_height A numeric number to indicate page height. #' @param orientation Orientation in 'portrait' or 'landscape'. #' #' @noRd -.rtf_page_size <- function(gt_tbl, +.rtf_page_size <- function(tbl, page_width, page_height, orientation) { - if (!is.numeric(page_width)) { stop("input page_width must be a numeric number") } @@ -286,43 +266,42 @@ rtf_source <- function(gt_tbl, } - if (!orientation %in% c("portrait","landscape")){ + if (!orientation %in% c("portrait", "landscape")) { stop("input orientation must be 'portrait' or 'landscape' ") } - attr(gt_tbl, "page_width") <- page_width - attr(gt_tbl, "page_height") <- page_height - attr(gt_tbl, "orientation") <- orientation + attr(tbl, "page_width") <- page_width + attr(tbl, "page_height") <- page_height + attr(tbl, "orientation") <- orientation - gt_tbl + tbl } #' Add margin attributes to the table #' -#' @param gt_tbl A data frame +#' @param tbl A data frame #' @param doctype doctype in 'csr', 'wma', 'wmm' or 'narrow' #' @param orientation Orientation in 'portrait' or 'landscape'. #' #' @noRd -.rtf_page_margin <- function(gt_tbl, +.rtf_page_margin <- function(tbl, doctype, orientation) { - - if (!doctype %in% c("csr", "wma", "wmm", "narrow")){ + if (!doctype %in% c("csr", "wma", "wmm", "narrow")) { stop("input doctype must be 'csr', 'wma', 'wmm' or 'narrow' ") } - if (!orientation %in% c("portrait","landscape")){ + if (!orientation %in% c("portrait", "landscape")) { stop("input orientation must be 'portrait' or 'landscape' ") } - attr(gt_tbl, "doctype") <- doctype + attr(tbl, "doctype") <- doctype - gt_tbl + tbl } @@ -331,7 +310,7 @@ rtf_source <- function(gt_tbl, #' @title Add column header to the table #' -#' @param gt_tbl A data frame +#' @param tbl A data frame #' @param colheader A string that uses " | " to separate column names. #' @param border_left left border type #' @param border_right right border type @@ -341,7 +320,7 @@ rtf_source <- function(gt_tbl, #' @param border_color_right right border color #' @param border_color_top top border color #' @param border_color_bottom bottom border color -#' @param border_width worder width in twips +#' @param border_width border width in twips #' @param cell_justification justification for cell #' @param col_rel_width column relative width in a vector eg. c(2,1,1) refers to 2:1;1 #' @param page_width page width in inches @@ -358,147 +337,135 @@ rtf_source <- function(gt_tbl, #' @param first_row boolean value to indicate whether column header is the first row of the table #' #' @export -rtf_colheader <- function(gt_tbl, +rtf_colheader <- function(tbl, - colheader = NULL, + colheader = NULL, - border_left = "single", - border_right = "single", - border_top = NULL, - border_bottom = "", + border_left = "single", + border_right = "single", + border_top = NULL, + border_bottom = "", - border_color_left = NULL, - border_color_right = NULL, - border_color_top = NULL, - border_color_bottom = NULL, + border_color_left = NULL, + border_color_right = NULL, + border_color_top = NULL, + border_color_bottom = NULL, - border_width = 15, - cell_justification = "c", + border_width = 15, + cell_justification = "c", - col_rel_width = NULL, - page_width = 8.5, - col_total_width = page_width/1.4, - cell_height = 0.15, + col_rel_width = NULL, + page_width = 8.5, + col_total_width = page_width / 1.4, + cell_height = 0.15, - text_justification = "c", - text_font = 1, - text_format = NULL, - text_color = NULL, + text_justification = "c", + text_font = 1, + text_format = NULL, + text_color = NULL, text_background_color = NULL, - text_font_size = 9, - text_space_before = 15, - text_space_after = 15, - - first_row = FALSE - - -) { + text_font_size = 9, + text_space_before = 15, + text_space_after = 15, + first_row = FALSE) { if (colheader == "") { + attr(tbl, "rtf_colheader")$colheader <- NULL + attr(tbl, "rtf_colheader")$first_row <- first_row + } else if (!is.null(colheader)) { + colheader <- data.frame(t(trimws(unlist(strsplit(colheader, "|", fixed = TRUE))))) - attr(gt_tbl, "rtf_colheader")$colheader <- NULL - attr(gt_tbl, "rtf_colheader")$first_row <- first_row - - } else if (!is.null(colheader)){ - - colheader <- data.frame( t(trimws(unlist(strsplit(colheader, "|", fixed = TRUE))))) - - n_row = nrow(colheader) - n_col = ncol(colheader) + n_row <- nrow(colheader) + n_col <- ncol(colheader) # Set default value for column width - if (is.null(col_rel_width)){ + if (is.null(col_rel_width)) { col_rel_width <- NA } ## Border top post processing for new page - if(is.null(border_top)){ - border_top = "" - border_post = TRUE - }else{ - border_post = FALSE + if (is.null(border_top)) { + border_top <- "" + border_post <- TRUE + } else { + border_post <- FALSE } # Set default value for text color if background color presented - if(is.null(text_color) & ! is.null(text_background_color)){ + if (is.null(text_color) & !is.null(text_background_color)) { text_color <- "black" } # Transer vector to matrix by row - foo <- function(x){ - if( (is.null(dim(x))) & (! is.null(x) ) ){ + foo <- function(x) { + if ((is.null(dim(x))) & (!is.null(x))) { x <- matrix(x, nrow = n_row, ncol = n_col, byrow = TRUE) } x } - border_top <- foo(border_top) - border_left <- foo(border_left) - border_right <- foo(border_right) - border_bottom <- foo(border_bottom) + border_top <- foo(border_top) + border_left <- foo(border_left) + border_right <- foo(border_right) + border_bottom <- foo(border_bottom) - border_color_left <- foo(border_color_left) - border_color_right <- foo(border_color_right) - border_color_top <- foo(border_color_top) - border_color_bottom <- foo(border_color_bottom) + border_color_left <- foo(border_color_left) + border_color_right <- foo(border_color_right) + border_color_top <- foo(border_color_top) + border_color_bottom <- foo(border_color_bottom) - text_font <- foo(text_font) - text_format <- foo(text_format) - text_color <- foo(text_color) + text_font <- foo(text_font) + text_format <- foo(text_format) + text_color <- foo(text_color) text_background_color <- foo(text_background_color) - text_justification <- foo(text_justification) - text_font_size <- foo(text_font_size) + text_justification <- foo(text_justification) + text_font_size <- foo(text_font_size) # Update to matrix format if (border_post) { - - if (length(.get_colheader(gt_tbl)) == 0 && first_row == TRUE) { - border_top[1,] <- rep("double", n_col) + if (length(.get_colheader(tbl)) == 0 && first_row == TRUE) { + border_top[1, ] <- rep("double", n_col) } else { - border_top[1,] <- rep("single", n_col) + border_top[1, ] <- rep("single", n_col) } - } - attr(gt_tbl, "rtf_colheader")$col_rel_width <- c(attr(gt_tbl, "rtf_colheader")$col_rel_width, list(col_rel_width)) - attr(gt_tbl, "rtf_colheader")$colheader <- c(attr(gt_tbl, "rtf_colheader")$colheader, list(colheader)) - attr(gt_tbl, "rtf_colheader")$border_left <- c(attr(gt_tbl, "rtf_colheader")$border_left, list(border_left)) - attr(gt_tbl, "rtf_colheader")$border_right <- c(attr(gt_tbl, "rtf_colheader")$border_right, list(border_right)) - attr(gt_tbl, "rtf_colheader")$border_top <- c(attr(gt_tbl, "rtf_colheader")$border_top, list(border_top)) - attr(gt_tbl, "rtf_colheader")$border_bottom <- c(attr(gt_tbl, "rtf_colheader")$border_bottom, list(border_bottom)) - attr(gt_tbl, "rtf_colheader")$border_color_left <- c(attr(gt_tbl, "rtf_colheader")$border_color_left, list(border_color_left)) - attr(gt_tbl, "rtf_colheader")$border_color_right <- c(attr(gt_tbl, "rtf_colheader")$border_color_right, list(border_color_right)) - attr(gt_tbl, "rtf_colheader")$border_color_bottom <- c(attr(gt_tbl, "rtf_colheader")$border_color_bottom, list(border_color_bottom)) - attr(gt_tbl, "rtf_colheader")$border_width <- c(attr(gt_tbl, "rtf_colheader")$border_width, list(border_width)) - attr(gt_tbl, "rtf_colheader")$cell_justification <- c(attr(gt_tbl, "rtf_colheader")$cell_justification, list(cell_justification)) - attr(gt_tbl, "rtf_colheader")$page_width <- c(attr(gt_tbl, "rtf_colheader")$page_width, list(page_width)) - attr(gt_tbl, "rtf_colheader")$col_total_width <- c(attr(gt_tbl, "rtf_colheader")$col_total_width, list(col_total_width)) - attr(gt_tbl, "rtf_colheader")$cell_height <- c(attr(gt_tbl, "rtf_colheader")$cell_height, list(cell_height)) - attr(gt_tbl, "rtf_colheader")$text_justification <- c(attr(gt_tbl, "rtf_colheader")$text_justification, list(text_justification)) - attr(gt_tbl, "rtf_colheader")$text_font <- c(attr(gt_tbl, "rtf_colheader")$text_font, list(text_font)) - attr(gt_tbl, "rtf_colheader")$text_format <- c(attr(gt_tbl, "rtf_colheader")$text_format, list(text_format)) - attr(gt_tbl, "rtf_colheader")$text_color <- c(attr(gt_tbl, "rtf_colheader")$text_color, list(text_color)) - attr(gt_tbl, "rtf_colheader")$text_background_color <- c(attr(gt_tbl, "rtf_colheader")$text_background_color, list(text_background_color)) - attr(gt_tbl, "rtf_colheader")$text_font_size <- c(attr(gt_tbl, "rtf_colheader")$text_font_size, list(text_font_size)) - attr(gt_tbl, "rtf_colheader")$text_space_before <- c(attr(gt_tbl, "rtf_colheader")$text_space_before, list(text_space_before)) - attr(gt_tbl, "rtf_colheader")$text_space_after <- c(attr(gt_tbl, "rtf_colheader")$text_space_after, list(text_space_after)) - attr(gt_tbl, "rtf_colheader")$first_row <- c(attr(gt_tbl, "rtf_colheader")$first_row, list(first_row)) - - - - }else{ - attr(gt_tbl, "rtf_colheader")$colheader <- NULL + attr(tbl, "rtf_colheader")$col_rel_width <- c(attr(tbl, "rtf_colheader")$col_rel_width, list(col_rel_width)) + attr(tbl, "rtf_colheader")$colheader <- c(attr(tbl, "rtf_colheader")$colheader, list(colheader)) + attr(tbl, "rtf_colheader")$border_left <- c(attr(tbl, "rtf_colheader")$border_left, list(border_left)) + attr(tbl, "rtf_colheader")$border_right <- c(attr(tbl, "rtf_colheader")$border_right, list(border_right)) + attr(tbl, "rtf_colheader")$border_top <- c(attr(tbl, "rtf_colheader")$border_top, list(border_top)) + attr(tbl, "rtf_colheader")$border_bottom <- c(attr(tbl, "rtf_colheader")$border_bottom, list(border_bottom)) + attr(tbl, "rtf_colheader")$border_color_left <- c(attr(tbl, "rtf_colheader")$border_color_left, list(border_color_left)) + attr(tbl, "rtf_colheader")$border_color_right <- c(attr(tbl, "rtf_colheader")$border_color_right, list(border_color_right)) + attr(tbl, "rtf_colheader")$border_color_bottom <- c(attr(tbl, "rtf_colheader")$border_color_bottom, list(border_color_bottom)) + attr(tbl, "rtf_colheader")$border_width <- c(attr(tbl, "rtf_colheader")$border_width, list(border_width)) + attr(tbl, "rtf_colheader")$cell_justification <- c(attr(tbl, "rtf_colheader")$cell_justification, list(cell_justification)) + attr(tbl, "rtf_colheader")$page_width <- c(attr(tbl, "rtf_colheader")$page_width, list(page_width)) + attr(tbl, "rtf_colheader")$col_total_width <- c(attr(tbl, "rtf_colheader")$col_total_width, list(col_total_width)) + attr(tbl, "rtf_colheader")$cell_height <- c(attr(tbl, "rtf_colheader")$cell_height, list(cell_height)) + attr(tbl, "rtf_colheader")$text_justification <- c(attr(tbl, "rtf_colheader")$text_justification, list(text_justification)) + attr(tbl, "rtf_colheader")$text_font <- c(attr(tbl, "rtf_colheader")$text_font, list(text_font)) + attr(tbl, "rtf_colheader")$text_format <- c(attr(tbl, "rtf_colheader")$text_format, list(text_format)) + attr(tbl, "rtf_colheader")$text_color <- c(attr(tbl, "rtf_colheader")$text_color, list(text_color)) + attr(tbl, "rtf_colheader")$text_background_color <- c(attr(tbl, "rtf_colheader")$text_background_color, list(text_background_color)) + attr(tbl, "rtf_colheader")$text_font_size <- c(attr(tbl, "rtf_colheader")$text_font_size, list(text_font_size)) + attr(tbl, "rtf_colheader")$text_space_before <- c(attr(tbl, "rtf_colheader")$text_space_before, list(text_space_before)) + attr(tbl, "rtf_colheader")$text_space_after <- c(attr(tbl, "rtf_colheader")$text_space_after, list(text_space_after)) + attr(tbl, "rtf_colheader")$first_row <- c(attr(tbl, "rtf_colheader")$first_row, list(first_row)) + } else { + attr(tbl, "rtf_colheader")$colheader <- NULL } - gt_tbl + tbl } #' @title add table body attributes to the table #' -#' @param gt_tbl A data frame +#' @param tbl A data frame #' @param colheader A boolean value to indicate whether to add default column header to the table #' @param page_width page width in inches #' @param page_height page height in inches @@ -512,7 +479,7 @@ rtf_colheader <- function(gt_tbl, #' @param border_color_right right border color #' @param border_color_top top border color #' @param border_color_bottom bottom border color -#' @param border_width worder width in twips +#' @param border_width border width in twips #' @param cell_justification justification for cell #' @param col_rel_width column relative width in a vector eg. c(2,1,1) refers to 2:1;1 #' @param col_total_width column total width for the table @@ -531,182 +498,166 @@ rtf_colheader <- function(gt_tbl, #' @param last_row a boolean value to indicate whether the table contains the last row of the final table #' #' @export -rtf_body <- function(gt_tbl, - - colheader = TRUE, - - page_width = 8.5, - page_height = 11, - orientation = "portrait", - doctype = "wma", - - border_left = "single", - border_right = "single", - border_top = NULL, - border_bottom = "double", - - border_color_left = NULL, - border_color_right = NULL, - border_color_top = NULL, - border_color_bottom = NULL, - - border_width = 15, - col_rel_width = NULL, - col_total_width = page_width/1.4, - cell_height = 0.15, - cell_justification = "c", - - text_font = 1, - text_format = NULL, - text_color = NULL, +rtf_body <- function(tbl, + + colheader = TRUE, + + page_width = 8.5, + page_height = 11, + orientation = "portrait", + doctype = "wma", + + border_left = "single", + border_right = "single", + border_top = NULL, + border_bottom = "double", + + border_color_left = NULL, + border_color_right = NULL, + border_color_top = NULL, + border_color_bottom = NULL, + + border_width = 15, + col_rel_width = NULL, + col_total_width = page_width / 1.4, + cell_height = 0.15, + cell_justification = "c", + + text_font = 1, + text_format = NULL, + text_color = NULL, text_background_color = NULL, - text_justification = "c", - text_font_size = 9, - text_space_before = 15, - text_space_after = 15, - - page_num = NULL, + text_justification = "c", + text_font_size = 9, + text_space_before = 15, + text_space_after = 15, - page_by = NULL, - new_page = FALSE, + page_num = NULL, - last_row = TRUE){ + page_by = NULL, + new_page = FALSE, - - gt_tbl <- .rtf_page_size(gt_tbl, - page_width = page_width, - page_height = page_height, - orientation = orientation + last_row = TRUE) { + tbl <- .rtf_page_size(tbl, + page_width = page_width, + page_height = page_height, + orientation = orientation ) - gt_tbl <- .rtf_page_margin(gt_tbl, - doctype = doctype, - orientation = orientation + tbl <- .rtf_page_margin(tbl, + doctype = doctype, + orientation = orientation ) ## check whether to add column header or not - if (colheader == TRUE){ - - if ( is.null(.get_colheader(gt_tbl)$colheader)){ - gt_tbl <- rtf_colheader(gt_tbl, - colheader = paste(attr(gt_tbl, "names"), collapse = " | " )) - + if (colheader == TRUE) { + if (is.null(.get_colheader(tbl)$colheader)) { + tbl <- rtf_colheader(tbl, + colheader = paste(attr(tbl, "names"), collapse = " | ") + ) } - - }else{ - - attr(gt_tbl, "rtf_colheader")$colheader <- NULL - attr(gt_tbl, "rtf_colheader")$first_row <- FALSE + } else { + attr(tbl, "rtf_colheader")$colheader <- NULL + attr(tbl, "rtf_colheader")$first_row <- FALSE } ## Border top post processing for new page - if(is.null(border_top)){ - border_top = "" - border_post = TRUE - }else{ - border_post = FALSE + if (is.null(border_top)) { + border_top <- "" + border_post <- TRUE + } else { + border_post <- FALSE } - if ( !is.null(page_by)) { - - if (all(page_by %in% attr(gt_tbl, "names"))) { - - id <- which(attr(gt_tbl, "names") %in% page_by) - - page_by_vars <- gt_tbl[,id] - - if (is.null(ncol(page_by_vars))){ + if (!is.null(page_by)) { + if (all(page_by %in% attr(tbl, "names"))) { + id <- which(attr(tbl, "names") %in% page_by) - pageby_condition = page_by_vars - - }else{ + page_by_vars <- tbl[, id] + if (is.null(ncol(page_by_vars))) { + pageby_condition <- page_by_vars + } else { pageby_condition <- do.call(paste, c(page_by_vars, sep = "-")) } - temp <- lapply(unique(pageby_condition), function(x){ - - gt_tbl[which(pageby_condition %in% x), -id] - - }) + temp <- lapply(unique(pageby_condition), function(x) { + tbl[which(pageby_condition %in% x), -id] + }) pageby_db <- do.call(rbind, temp) pageby_colheader <- unique(pageby_condition) - - } else { - - stop(paste0("page_by must be one of the following: ", paste(attr(gt_tbl, "names"), collapse = ", "))) + stop(paste0("page_by must be one of the following: ", paste(attr(tbl, "names"), collapse = ", "))) } - } else { - pageby_db <- data.frame(gt_tbl) + pageby_db <- data.frame(tbl) pageby_condition <- NULL pageby_colheader <- NULL } - n_row = nrow(pageby_db) - n_col = ncol(pageby_db) + n_row <- nrow(pageby_db) + n_col <- ncol(pageby_db) # Set default value for column width - if(is.null(col_rel_width)){ + if (is.null(col_rel_width)) { col_rel_width <- rep(1, n_col) } # Set default value for text color if background color presented - if(is.null(text_color) & ! is.null(text_background_color)){ + if (is.null(text_color) & !is.null(text_background_color)) { text_color <- "black" } # Transer vector to matrix by row - foo <- function(x){ - if( (is.null(dim(x))) & (! is.null(x) ) ){ + foo <- function(x) { + if ((is.null(dim(x))) & (!is.null(x))) { x <- matrix(x, nrow = n_row, ncol = n_col, byrow = TRUE) } x } - border_top <- foo(border_top) - border_left <- foo(border_left) - border_right <- foo(border_right) - border_bottom <- foo(border_bottom) + border_top <- foo(border_top) + border_left <- foo(border_left) + border_right <- foo(border_right) + border_bottom <- foo(border_bottom) - border_color_left <- foo(border_color_left) - border_color_right <- foo(border_color_right) - border_color_top <- foo(border_color_top) - border_color_bottom <- foo(border_color_bottom) + border_color_left <- foo(border_color_left) + border_color_right <- foo(border_color_right) + border_color_top <- foo(border_color_top) + border_color_bottom <- foo(border_color_bottom) - text_font <- foo(text_font) - text_format <- foo(text_format) - text_color <- foo(text_color) + text_font <- foo(text_font) + text_format <- foo(text_format) + text_color <- foo(text_color) text_background_color <- foo(text_background_color) - text_justification <- foo(text_justification) - text_font_size <- foo(text_font_size) - - page_num <- .set_page_num(page_num, orientation) - - index_list <- .pageby_db_index(pageby_db, - pageby_colheader, - pageby_condition, - page_num, - page_by, - new_page) + text_justification <- foo(text_justification) + text_font_size <- foo(text_font_size) + + page_num <- .set_page_num(page_num, orientation) + + index_list <- .pageby_db_index( + pageby_db, + pageby_colheader, + pageby_condition, + page_num, + page_by, + new_page + ) index_newpage <- index_list$index_newpage index_endpage <- index_list$index_endpage - for (x in index_newpage){ - + for (x in index_newpage) { if (border_post) { - - if (is.null(.get_colheader(gt_tbl)$colheader) && .get_colheader(gt_tbl)$first_row == TRUE) { - border_top[x,] <- rep("double", n_col) + if (is.null(.get_colheader(tbl)$colheader) && .get_colheader(tbl)$first_row == TRUE) { + border_top[x, ] <- rep("double", n_col) } else { - border_top[x,] <- rep("single", n_col) + border_top[x, ] <- rep("single", n_col) } } } @@ -714,48 +665,46 @@ rtf_body <- function(gt_tbl, - attr(gt_tbl, "border_top") <- border_top - attr(gt_tbl, "border_left") <- border_left - attr(gt_tbl, "border_right") <- border_right - attr(gt_tbl, "border_bottom") <- border_bottom + attr(tbl, "border_top") <- border_top + attr(tbl, "border_left") <- border_left + attr(tbl, "border_right") <- border_right + attr(tbl, "border_bottom") <- border_bottom - attr(gt_tbl, "border_color_left") <- border_color_left - attr(gt_tbl, "border_color_right") <- border_color_right - attr(gt_tbl, "border_color_top") <- border_color_top - attr(gt_tbl, "border_color_bottom") <- border_color_bottom + attr(tbl, "border_color_left") <- border_color_left + attr(tbl, "border_color_right") <- border_color_right + attr(tbl, "border_color_top") <- border_color_top + attr(tbl, "border_color_bottom") <- border_color_bottom - attr(gt_tbl, "border_width") <- border_width - attr(gt_tbl, "page_width") <- page_width - attr(gt_tbl, "col_total_width") <- col_total_width - attr(gt_tbl, "cell_height") <- cell_height - attr(gt_tbl, "cell_justification") <- cell_justification - attr(gt_tbl, "col_rel_width") <- col_rel_width + attr(tbl, "border_width") <- border_width + attr(tbl, "page_width") <- page_width + attr(tbl, "col_total_width") <- col_total_width + attr(tbl, "cell_height") <- cell_height + attr(tbl, "cell_justification") <- cell_justification + attr(tbl, "col_rel_width") <- col_rel_width - attr(gt_tbl, "text_font") <- text_font - attr(gt_tbl, "text_format") <- text_format - attr(gt_tbl, "text_font_size") <- text_font_size - attr(gt_tbl, "text_color") <- text_color - attr(gt_tbl, "text_background_color") <- text_background_color - attr(gt_tbl, "text_justification") <- text_justification + attr(tbl, "text_font") <- text_font + attr(tbl, "text_format") <- text_format + attr(tbl, "text_font_size") <- text_font_size + attr(tbl, "text_color") <- text_color + attr(tbl, "text_background_color") <- text_background_color + attr(tbl, "text_justification") <- text_justification - attr(gt_tbl, "text_space_before") <- text_space_before - attr(gt_tbl, "text_space_after") <- text_space_after + attr(tbl, "text_space_before") <- text_space_before + attr(tbl, "text_space_after") <- text_space_after - attr(gt_tbl, "page_num") <- page_num - attr(gt_tbl, "page_by") <- page_by - attr(gt_tbl, "new_page") <- new_page - attr(gt_tbl, "pageby_db") <- pageby_db - attr(gt_tbl, "pageby_condition") <- pageby_condition - attr(gt_tbl, "pageby_colheader") <- pageby_colheader - attr(gt_tbl, "pageby_newpage_index") <- index_newpage - attr(gt_tbl, "pageby_endpage_index") <- index_endpage + attr(tbl, "page_num") <- page_num + attr(tbl, "page_by") <- page_by + attr(tbl, "new_page") <- new_page + attr(tbl, "pageby_db") <- pageby_db + attr(tbl, "pageby_condition") <- pageby_condition + attr(tbl, "pageby_colheader") <- pageby_colheader + attr(tbl, "pageby_newpage_index") <- index_newpage + attr(tbl, "pageby_endpage_index") <- index_endpage - attr(gt_tbl, "last_row") <- last_row + attr(tbl, "last_row") <- last_row - gt_tbl + tbl } - - diff --git a/R/add_features.R b/R/add_features.R index 2e5f0c8c..d3090630 100644 --- a/R/add_features.R +++ b/R/add_features.R @@ -22,25 +22,24 @@ .as_rtf_init <- function() { # The number 1033 is U.S. English - paste("{", "\\rtf1\\ansi\n\\deff0\\deflang1033", sep="") - - } + paste("{", "\\rtf1\\ansi\n\\deff0\\deflang1033", sep = "") +} #' rtf code to initiate an rtf table #' #' @noRd -.as_rtf_font<-function() { - - font_type <- .font_type() - font_rtf <- factor(c(1,2,3), levels = font_type$type, labels = font_type$rtf_code) - font_style <- factor(c(1,2,3), levels = font_type$type, labels = font_type$style) - font_name <- factor(c(1,2,3), levels = font_type$type, labels = font_type$name) - - - font_table <- paste0("{\\fonttbl", - paste(paste0("{", font_rtf, font_style, "\\fcharset161\\fprq2 ", font_name, ";}\n"), collapse = ""), - "}\n") +.as_rtf_font <- function() { + font_type <- .font_type() + font_rtf <- factor(c(1, 2, 3), levels = font_type$type, labels = font_type$rtf_code) + font_style <- factor(c(1, 2, 3), levels = font_type$type, labels = font_type$style) + font_name <- factor(c(1, 2, 3), levels = font_type$type, labels = font_type$name) + + font_table <- paste0( + "{\\fonttbl", + paste(paste0("{", font_rtf, font_style, "\\fcharset161\\fprq2 ", font_name, ";}\n"), collapse = ""), + "}\n" + ) font_table } @@ -51,52 +50,48 @@ #' #' @noRd .inch_to_twip <- function(inch) { - round(inch*1440, 0) + round(inch * 1440, 0) } #' create rtf color table -#' @param gt_tbl a data frame +#' @param tbl a data frame #' #' @noRd -.as_rtf_color <- function(gt_tbl) { - +.as_rtf_color <- function(tbl) { rtf_color <- NULL - color_used <- .color_used(gt_tbl) + color_used <- .color_used(tbl) if (color_used == TRUE) { - col_tb <- .color_table() - rtf_color <- paste(c( "{\\colortbl; ", col_tb$rtf_code, "}"), collapse = "\n") + col_tb <- .color_table() + rtf_color <- paste(c("{\\colortbl; ", col_tb$rtf_code, "}"), collapse = "\n") } rtf_color - } #' create rtf page size -#' @param gt_tbl a data frame +#' @param tbl a data frame #' @noRd -.as_rtf_page <- function(gt_tbl){ - - page_width <- attr(gt_tbl, "page_width") - page_height <- attr(gt_tbl, "page_height") - orientation <- attr(gt_tbl, "orientation") +.as_rtf_page <- function(tbl) { + page_width <- attr(tbl, "page_width") + page_height <- attr(tbl, "page_height") + orientation <- attr(tbl, "orientation") .page.size <- c("\\paperw", "\\paperh") - .page.size <- paste( paste0(.page.size, .inch_to_twip(c(page_width, page_height))), collapse = "") + .page.size <- paste(paste0(.page.size, .inch_to_twip(c(page_width, page_height))), collapse = "") - if(orientation == "landscape"){ - + if (orientation == "landscape") { .page.size <- paste0(.page.size, "\\landscape\n") } - if(orientation == "portrait"){ + if (orientation == "portrait") { .page.size <- paste0(.page.size, "\n") } @@ -114,32 +109,29 @@ #' #' @noRd .set_omi <- function(doctype, orientation) { - - - if (!doctype %in% c("csr", "wma", "wmm","narrow")){ + if (!doctype %in% c("csr", "wma", "wmm", "narrow")) { stop("input doctype must be 'csr', 'wma', 'wmm' or 'narrow' ") } - if (!orientation %in% c("portrait","landscape")){ + if (!orientation %in% c("portrait", "landscape")) { stop("input orientation must be 'portrait' or 'landscape' ") } .omi <- list( - csr = list( - portrait = c(1.25, 1, 1.5, 1, 0.5, 0.5), + portrait = c(1.25, 1, 1.5, 1, 0.5, 0.5), landscape = c(0.5, 0.5, 1.27986111111111, 1.25, 1.25, 1) ), wma = list( - portrait = c(1.25, 1, 1.75, 1.25, 1.75, 1.00625), + portrait = c(1.25, 1, 1.75, 1.25, 1.75, 1.00625), landscape = c(0.5, 0.5, 2, 1.25, 1.25, 1.25) ), wmm = list( - portrait = c(1.25, 1, 1, 1, 1.75, 1.00625), + portrait = c(1.25, 1, 1, 1, 1.75, 1.00625), landscape = c(0.5, 0.5, 1.25, 1, 1.25, 1.25) ), @@ -147,36 +139,31 @@ portrait = rep(0.5, 6), landscape = rep(0.5, 6) ) - ) - .omi[[doctype]][[orientation ]] - + .omi[[doctype]][[orientation]] } #' rtf code to set up margins in twips -#' @param gt_tbl a data frame +#' @param tbl a data frame #' @noRd -.as_rtf_margin <- function(gt_tbl){ - - doctype <- attr(gt_tbl, "doctype") - orientation <- attr(gt_tbl, "orientation") +.as_rtf_margin <- function(tbl) { + doctype <- attr(tbl, "doctype") + orientation <- attr(tbl, "orientation") - .omi <- .set_omi(doctype, orientation) - .margin <- c("\\margl", "\\margr", "\\margt", "\\margb", "\\headery","\\footery") - .margin <- paste( paste0(.margin, .inch_to_twip(.omi)), collapse = "") + .omi <- .set_omi(doctype, orientation) + .margin <- c("\\margl", "\\margr", "\\margt", "\\margb", "\\headery", "\\footery") + .margin <- paste(paste0(.margin, .inch_to_twip(.omi)), collapse = "") .margin <- paste0(.margin, "\n") .margin - } #' rtf code to set up margins in twips #' #' @noRd -.as_rtf_newpage <- function(){ - +.as_rtf_newpage <- function() { paste("\\intbl\\row\\pard\\page\\par\\pard") } @@ -187,9 +174,7 @@ #' @param orientation Orientation in 'portrait' or 'landscape'. #' @noRd .set_page_num <- function(page_num, orientation) { - - if (is.null(page_num)){ - + if (is.null(page_num)) { if (orientation == "portrait") page_num <- 42 if (orientation == "landscape") page_num <- 26 } @@ -199,12 +184,11 @@ #' extract the heading attribute from a \pkg{gt} object #' -#' @param gt_tbl A data frame +#' @param tbl A data frame #' #' @noRd -.get_heading <- function(gt_tbl) { - - gt_attr <- attributes(gt_tbl) +.get_heading <- function(tbl) { + gt_attr <- attributes(tbl) rtf_heading <- gt_attr$rtf_heading rtf_heading @@ -212,26 +196,24 @@ #' extract the heading attribute from a \pkg{gt} object #' -#' @param gt_tbl A data frame +#' @param tbl A data frame #' #' @noRd -.footnote_source_space <- function(gt_tbl) { - +.footnote_source_space <- function(tbl) { + table_width <- attr(tbl, "col_total_width") + page_width <- attr(tbl, "page_width") + text_space_before <- attr(tbl, "text_space_before") + border_width <- attr(tbl, "border_width") + doctype <- attr(tbl, "doctype") + orientation <- attr(tbl, "orientation") - table_width <- attr(gt_tbl, "col_total_width") - page_width <- attr(gt_tbl, "page_width") - text_space_before <- attr(gt_tbl, "text_space_before") - border_width <- attr(gt_tbl, "border_width") - doctype <- attr(gt_tbl, "doctype") - orientation <- attr(gt_tbl, "orientation") - - page_width <- .inch_to_twip(page_width ) - left_margin <- .inch_to_twip(.set_omi(doctype, orientation)[1]) + page_width <- .inch_to_twip(page_width) + left_margin <- .inch_to_twip(.set_omi(doctype, orientation)[1]) right_margin <- .inch_to_twip(.set_omi(doctype, orientation)[2]) - table_width <- .inch_to_twip(table_width) + table_width <- .inch_to_twip(table_width) - space_adjust <- round((page_width - left_margin - right_margin - table_width) / 2 ) + space_adjust <- round((page_width - left_margin - right_margin - table_width) / 2) space_adjust @@ -241,29 +223,28 @@ #' check whether color is used in a data frame #' -#' @param gt_tbl A data frame +#' @param tbl A data frame #' #' @noRd -.color_used <- function(gt_tbl){ - +.color_used <- function(tbl) { color_used <- FALSE - heading_color <- attr(gt_tbl,"rtf_heading")$color - heading_background_color <- attr(gt_tbl,"rtf_heading")$background_color + heading_color <- attr(tbl, "rtf_heading")$color + heading_background_color <- attr(tbl, "rtf_heading")$background_color - border_color_left <- attr(gt_tbl,"border_color_left") - border_color_right <- attr(gt_tbl,"border_color_right") - border_color_top <- attr(gt_tbl,"border_color_top") - border_color_bottom <- attr(gt_tbl,"border_color_bottom") + border_color_left <- attr(tbl, "border_color_left") + border_color_right <- attr(tbl, "border_color_right") + border_color_top <- attr(tbl, "border_color_top") + border_color_bottom <- attr(tbl, "border_color_bottom") - text_color <- attr(gt_tbl,"text_color") - text_background_color <- attr(gt_tbl,"text_background_color") + text_color <- attr(tbl, "text_color") + text_background_color <- attr(tbl, "text_background_color") - footnote_color <- attr(gt_tbl,"rtf_footnote")$color - footnote_background_color <- attr(gt_tbl,"rtf_footnote")$background_color + footnote_color <- attr(tbl, "rtf_footnote")$color + footnote_background_color <- attr(tbl, "rtf_footnote")$background_color - source_color <- attr(gt_tbl,"rtf_source")$color - source_background_color <- attr(gt_tbl,"rtf_source")$background_color + source_color <- attr(tbl, "rtf_source")$color + source_background_color <- attr(tbl, "rtf_source")$background_color no_color <- is.null(heading_color) && is.null(heading_background_color) && @@ -296,18 +277,17 @@ pageby_colheader, pageby_condition, table_rtftext, - new_page){ - + new_page) { category_index <- NULL if (!is.null(page_by)) { - rtf_pageby_colheader <- lapply(pageby_colheader, function(x) { .as_rtf_table(rtf_body(data.frame(x), - colheader = FALSE, - border_bottom = "single", - text_justification = "l")) + colheader = FALSE, + border_bottom = "single", + text_justification = "l" + )) }) rtf_pageby_index <- sapply(pageby_colheader, function(x) { @@ -316,15 +296,16 @@ new_table_rtftext <- matrix("", - nrow = nrow(table_rtftext), - ncol = ncol(table_rtftext) + length(pageby_colheader)) + nrow = nrow(table_rtftext), + ncol = ncol(table_rtftext) + length(pageby_colheader) + ) - split_index <- c(0, cumsum(rtf_pageby_index)[-length(rtf_pageby_index)]) + 1 + split_index <- c(0, cumsum(rtf_pageby_index)[-length(rtf_pageby_index)]) + 1 pageby_index <- c(0, cumsum(rtf_pageby_index)[-length(rtf_pageby_index)]) + c(1:length(rtf_pageby_index)) - for ( i in c(1:length(pageby_index)) ) { + for (i in c(1:length(pageby_index))) { ## add pageby column header row_idx <- c(1:length(rtf_pageby_colheader[[1]])) @@ -335,26 +316,25 @@ ## split table_rtftext based on pageby feature new_start <- pageby_index[i] + 1 - new_end <- new_start + rtf_pageby_index[i] - 1 + new_end <- new_start + rtf_pageby_index[i] - 1 old_start <- split_index[i] - old_end <- old_start + rtf_pageby_index[i] - 1 - - new_table_rtftext[, new_start:new_end] <- table_rtftext[,old_start:old_end] + old_end <- old_start + rtf_pageby_index[i] - 1 + new_table_rtftext[, new_start:new_end] <- table_rtftext[, old_start:old_end] } - table_rtftext <- new_table_rtftext + table_rtftext <- new_table_rtftext - if (new_page == TRUE){ + if (new_page == TRUE) { category_index <- pageby_index[-1] - 1 } - } - newtable_list <- list(table_rtftext = table_rtftext, - category_index = category_index) - + newtable_list <- list( + table_rtftext = table_rtftext, + category_index = category_index + ) } #' calculate index to insert new page rtf code @@ -367,31 +347,21 @@ .table_rtftext_index <- function(new_page, category_index, page_num, - n_row){ - - - if (page_num <= n_row){ - + n_row) { + if (page_num <= n_row) { if (new_page == TRUE) { - pages <- c(0, category_index, n_row) - pages_cut <- lapply( 2:length(pages), function (x){ - - ( 0 : floor ((pages[x] - pages[x-1]) / page_num) ) * page_num + pages[x-1] - + pages_cut <- lapply(2:length(pages), function(x) { + (0:floor((pages[x] - pages[x - 1]) / page_num)) * page_num + pages[x - 1] }) pages <- unique(sort(c(pages, unlist(pages_cut)))) - - } else { ## if new_page == FALSE - pages <- c(0, c(1 : floor(n_row / page_num)) * page_num) + pages <- c(0, c(1:floor(n_row / page_num)) * page_num) } - - } else { ## if (page_num > n_row) @@ -421,18 +391,15 @@ pageby_condition, page_num, page_by, - new_page){ - - index_newpage = 1 - index_endpage = NULL - - n_row <- nrow(pageby_db) + length(pageby_colheader) + new_page) { + index_newpage <- 1 + index_endpage <- NULL - if ((!is.null(page_num)) && (n_row !=1)) { + n_row <- nrow(pageby_db) + length(pageby_colheader) - if (page_num < n_row){ - - index_newpage <- c(1 : floor(n_row / page_num)) * page_num + if ((!is.null(page_num)) && (n_row != 1)) { + if (page_num < n_row) { + index_newpage <- c(1:floor(n_row / page_num)) * page_num if (index_newpage[length(index_newpage)] > n_row) index_newpage <- index_newpage[-length(index_newpage)] index_newpage <- c(0, index_newpage) + 1 @@ -440,14 +407,13 @@ ## if page_by feature is turned on - if ((!is.null(page_by))){ - + if ((!is.null(page_by))) { rtf_pageby_index <- sapply(pageby_colheader, function(x) { length(which(pageby_condition %in% x)) }) - if (new_page == TRUE){ + if (new_page == TRUE) { ## if new_page == TRUE, break by new_page @@ -455,17 +421,15 @@ first_interval <- page_num - 1 - index_newpage_cut <- lapply( 2:length(index_newpage), function (x){ - - item_1 <- index_newpage[x-1] + first_interval + index_newpage_cut <- lapply(2:length(index_newpage), function(x) { + item_1 <- index_newpage[x - 1] + first_interval - if (index_newpage[x] > item_1){ + if (index_newpage[x] > item_1) { + item_2 <- (0:floor((index_newpage[x] - item_1) / page_num)) * page_num + item_1 - item_2 <- ( 0 : floor ((index_newpage[x] - item_1) / page_num) ) * page_num + item_1 - - cut = c(item_1, item_2) - }else{ - cut = NULL + cut <- c(item_1, item_2) + } else { + cut <- NULL } cut @@ -473,28 +437,27 @@ index_newpage <- unique(sort(c(index_newpage, unlist(index_newpage_cut)))) - } else { ## if new_page == FALSE, only break by page_num - split_index <- c(0, cumsum(rtf_pageby_index)[-length(rtf_pageby_index)]) + 1 - pageby_index <- c(0, cumsum(rtf_pageby_index)[-length(rtf_pageby_index)]) + c(1:length(rtf_pageby_index)) + split_index <- c(0, cumsum(rtf_pageby_index)[-length(rtf_pageby_index)]) + 1 + pageby_index <- c(0, cumsum(rtf_pageby_index)[-length(rtf_pageby_index)]) + c(1:length(rtf_pageby_index)) - temp_idx <- sapply(index_newpage, function(x) { min(which(pageby_index >= x)) - 1 }) + temp_idx <- sapply(index_newpage, function(x) { + min(which(pageby_index >= x)) - 1 + }) index_newpage <- c(1, split_index[temp_idx] + (index_newpage - pageby_index[temp_idx])) } - - } - - } if (length(index_newpage) > 1) index_endpage <- index_newpage[-1] - 1 - index_list <- list(index_newpage = index_newpage, - index_endpage = index_endpage) + index_list <- list( + index_newpage = index_newpage, + index_endpage = index_endpage + ) index_list @@ -508,10 +471,8 @@ #' @param heading Heading attribute from a data frame #' #' @noRd -.is_title <- function(heading){ - +.is_title <- function(heading) { length(heading) > 0 && !is.null(heading$title) - } @@ -521,19 +482,17 @@ #' #' @noRd .is_subtitle <- function(heading) { - length(heading) > 0 && !is.null(heading$subtitle) && heading$subtitle != "" } #' extract the footnote_df attribute from a data frame #' -#' @param gt_tbl A data frame +#' @param tbl A data frame #' #' @noRd -.get_footnote <- function(gt_tbl) { - - gt_attr <- attributes(gt_tbl) +.get_footnote <- function(tbl) { + gt_attr <- attributes(tbl) footnote <- gt_attr$rtf_footnote footnote @@ -545,20 +504,18 @@ #' @param footnote footnote attribute from a data frame #' #' @noRd -.is_footnote <- function(footnote){ - +.is_footnote <- function(footnote) { length(footnote) > 0 && !is.null(footnote$footnote) && footnote$footnote != "" } #' extract the data source attribute from a \pkg{gt} object #' -#' @param gt_tbl A data frame +#' @param tbl A data frame #' #' @noRd -.get_source <- function(gt_tbl) { - - gt_attr <- attributes(gt_tbl) +.get_source <- function(tbl) { + gt_attr <- attributes(tbl) source <- gt_attr$rtf_source source @@ -566,13 +523,11 @@ #' extract the column header attribute from a data frame #' -#' @param gt_tbl A data frame +#' @param tbl A data frame #' #' @noRd -.get_colheader <- function(gt_tbl) { - - attr(gt_tbl, "rtf_colheader") - +.get_colheader <- function(tbl) { + attr(tbl, "rtf_colheader") } @@ -582,8 +537,7 @@ #' @param source source attribute from a data frame #' #' @noRd -.is_source <- function(source){ - +.is_source <- function(source) { length(source) > 0 && !is.null(source$source) && source$source != "" } @@ -595,23 +549,24 @@ #' #' @noRd .convert <- function(x) { - - - char_rtf <- c( "^" = "\\super ", - "_" = "\\sub ", - ">=" = "\\geq ", - "<=" = "\\leq ", - "\n" = "\\line ") + char_rtf <- c( + "^" = "\\super ", + "_" = "\\sub ", + ">=" = "\\geq ", + "<=" = "\\leq ", + "\n" = "\\line " + ) # Define Pattern for latex code - # char_latex <- unicode_latex$chr - # names(char_latex) <- unicode_latex$latex - unicode_latex$int <- as.integer(as.hexmode(unicode_latex$unicode)) + unicode_latex$int <- as.integer(as.hexmode(unicode_latex$unicode)) char_latex <- ifelse(unicode_latex$int <= 255, unicode_latex$chr, - ifelse(unicode_latex$int > 255 & unicode_latex$int < 32768, - paste0("\\uc1\\u", unicode_latex$int, "*"), - paste0("\\uc1\\u-", unicode_latex$int, "*") )) + ifelse(unicode_latex$int > 255 & unicode_latex$int < 32768, + paste0("\\uc1\\u", unicode_latex$int, "*"), + paste0("\\uc1\\u-", unicode_latex$int, "*") + ) + ) + names(char_latex) <- unicode_latex$latex # Declare fixed string in the pattern (no regular expression) @@ -622,9 +577,6 @@ x <- stringr::str_replace_all(x, char_latex) x - - - } @@ -640,110 +592,105 @@ #' @references Burke, S. M. (2003). RTF Pocket Guide. " O'Reilly Media, Inc.". #' @noRd utf8Tortf <- function(x) { - - stopifnot(length(x) == 1 & "character" %in% class(x) ) + stopifnot(length(x) == 1 & "character" %in% class(x)) x_char <- unlist(strsplit(x, "")) - x_int <- utf8ToInt(x) - x_rtf <- ifelse(x_int <= 255, x_char, - ifelse(x_int <= 32768, paste0("\\uc1\\u", x_int,"?"), - paste0("\\uc1\\u-", x_int - 65536, "?") ) - ) + x_int <- utf8ToInt(x) + x_rtf <- ifelse(x_int <= 255, x_char, + ifelse(x_int <= 32768, paste0("\\uc1\\u", x_int, "?"), + paste0("\\uc1\\u-", x_int - 65536, "?") + ) + ) paste0(x_rtf, collapse = "") - } #' rtf code to set up column header for the rtf table #' -#' @param gt_tbl A data frame +#' @param tbl A data frame #' #' @noRd -.as_rtf_colheader <- function(gt_tbl){ - - rtf_colheader <- .get_colheader(gt_tbl) +.as_rtf_colheader <- function(tbl) { + rtf_colheader <- .get_colheader(tbl) colheader_tbl_list <- NULL if (!is.null(rtf_colheader$colheader)) { + colheader_tbl_list <- lapply(c(1:length(rtf_colheader$colheader)), function(i) { + colheader_db <- rtf_colheader$colheader[[i]] + + border_left <- rtf_colheader$border_left[[i]] + border_right <- rtf_colheader$border_right[[i]] + border_top <- rtf_colheader$border_top[[i]] + border_bottom <- rtf_colheader$border_bottom[[i]] + + border_color_left <- rtf_colheader$border_color_left[[i]] + border_color_right <- rtf_colheader$border_color_right[[i]] + border_color_top <- rtf_colheader$border_color_top[[i]] + border_color_bottom <- rtf_colheader$border_color_bottom[[i]] + + border_width <- rtf_colheader$border_width[[i]] + page_width <- rtf_colheader$page_width[[i]] + col_rel_width <- rtf_colheader$col_rel_width[[i]] + + ## if column header relative width under "rtf_colheader" attribute is NA, + ## use the global column relative width + if (all(is.na(col_rel_width))) { + col_rel_width <- attr(tbl, "col_rel_width") + } - colheader_tbl_list <- lapply (c(1:length(rtf_colheader$colheader)), function(i){ - - - colheader_db <- rtf_colheader$colheader[[i]] - - border_left <- rtf_colheader$border_left[[i]] - border_right <- rtf_colheader$border_right[[i]] - border_top <- rtf_colheader$border_top[[i]] - border_bottom <- rtf_colheader$border_bottom[[i]] - - border_color_left <- rtf_colheader$border_color_left[[i]] - border_color_right <- rtf_colheader$border_color_right[[i]] - border_color_top <- rtf_colheader$border_color_top[[i]] - border_color_bottom <- rtf_colheader$border_color_bottom[[i]] - - border_width <- rtf_colheader$border_width[[i]] - page_width <- rtf_colheader$page_width[[i]] - col_rel_width <- rtf_colheader$col_rel_width[[i]] - - ## if column header relative width under "rtf_colheader" attribute is NA, - ## use the global column relative width - if(all(is.na(col_rel_width))){ - col_rel_width <- attr(gt_tbl, "col_rel_width")} - - col_total_width <- rtf_colheader$col_total_width[[i]] - cell_height <- rtf_colheader$cell_height[[i]] - cell_justification <- rtf_colheader$cell_justification[[i]] - - text_font <- rtf_colheader$text_font[[i]] - text_format <- rtf_colheader$text_format[[i]] - text_color <- rtf_colheader$text_color[[i]] - text_background_color <- rtf_colheader$text_background_color[[i]] - text_justification <- rtf_colheader$text_justification[[i]] - text_font_size <- rtf_colheader$text_font_size[[i]] - text_space_before <- rtf_colheader$text_space_before[[i]] - text_space_after <- rtf_colheader$text_space_after[[i]] - + col_total_width <- rtf_colheader$col_total_width[[i]] + cell_height <- rtf_colheader$cell_height[[i]] + cell_justification <- rtf_colheader$cell_justification[[i]] + text_font <- rtf_colheader$text_font[[i]] + text_format <- rtf_colheader$text_format[[i]] + text_color <- rtf_colheader$text_color[[i]] + text_background_color <- rtf_colheader$text_background_color[[i]] + text_justification <- rtf_colheader$text_justification[[i]] + text_font_size <- rtf_colheader$text_font_size[[i]] + text_space_before <- rtf_colheader$text_space_before[[i]] + text_space_after <- rtf_colheader$text_space_after[[i]] - colheader_table <- .rtf_table_content( - colheader_db, - border_left = border_left, - border_right = border_right, - border_top = border_top, - border_bottom = border_bottom, - border_color_left = border_color_left, - border_color_right = border_color_right, - border_color_top = border_color_top, - border_color_bottom = border_color_bottom, + colheader_table <- .rtf_table_content( + colheader_db, + border_left = border_left, + border_right = border_right, + border_top = border_top, + border_bottom = border_bottom, - border_width = border_width, - page_width = page_width, - col_rel_width = col_rel_width, - col_total_width = col_total_width, - cell_height = cell_height, - cell_justification = cell_justification, + border_color_left = border_color_left, + border_color_right = border_color_right, + border_color_top = border_color_top, + border_color_bottom = border_color_bottom, - text_font = text_font, - text_format = text_format, - text_color = text_color, - text_background_color = text_background_color, - text_justification = text_justification, - text_font_size = text_font_size, - text_space_before = text_space_before, - text_space_after = text_space_after, + border_width = border_width, + page_width = page_width, + col_rel_width = col_rel_width, + col_total_width = col_total_width, + cell_height = cell_height, + cell_justification = cell_justification, - page_num = NULL, + text_font = text_font, + text_format = text_format, + text_color = text_color, + text_background_color = text_background_color, + text_justification = text_justification, + text_font_size = text_font_size, + text_space_before = text_space_before, + text_space_after = text_space_after, - last_row = FALSE ) + page_num = NULL, - colheader_table + last_row = FALSE + ) - }) + colheader_table + }) } colheader_tbl_list @@ -752,66 +699,62 @@ utf8Tortf <- function(x) { #' rtf code to set up header for the rtf table #' -#' @param gt_tbl A data frame +#' @param tbl A data frame #' #' @noRd -.as_rtf_header <- function(gt_tbl) { - +.as_rtf_header <- function(tbl) { header <- list() - heading <- .get_heading(gt_tbl) - - if(.is_title(heading)){ + heading <- .get_heading(tbl) + if (.is_title(heading)) { text_title <- paste(heading$title, collapse = " \n ") header[[1]] <- .rtf_text(.convert(text_title), - font = heading$font, - font_size = heading$font_size, - format = heading$format, - color = heading$color, - background_color = heading$background_color) - - if(.is_subtitle(heading)) { + font = heading$font, + font_size = heading$font_size, + format = heading$format, + color = heading$color, + background_color = heading$background_color + ) + if (.is_subtitle(heading)) { text_subtitle <- paste0("\n ", paste(heading$subtitle, collapse = " \n ")) header[[2]] <- .rtf_text(.convert(text_subtitle), - font = heading$font, - font_size = heading$font_size, - format = heading$format, - color = heading$color, - background_color = heading$background_color) - - + font = heading$font, + font_size = heading$font_size, + format = heading$format, + color = heading$color, + background_color = heading$background_color + ) } } ## if there is no title and subtitle, set header to NULL, no need to print anything - if (length(header) == 0){ + if (length(header) == 0) { header <- NULL - }else{ - header <- paste(unlist(header),collapse = "\n") + } else { + header <- paste(unlist(header), collapse = "\n") } - if (!is.null(header)){ - + if (!is.null(header)) { paragraph <- .rtf_paragraph(header, + justification = heading$justification, - justification = heading$justification, + indent_first = heading$indent_first, + indent_left = heading$indent_left, + indent_right = heading$indent_right, - indent_first = heading$indent_first, - indent_left = heading$indent_left, - indent_right = heading$indent_right, + space = heading$space, + space_before = heading$space_before, + space_after = heading$space_after, - space = heading$space, - space_before = heading$space_before, - space_after = heading$space_after, - - new_page = heading$new_page, - hyphenation = heading$hyphenation) - }else{ + new_page = heading$new_page, + hyphenation = heading$hyphenation + ) + } else { paragraph <- NULL } @@ -819,105 +762,92 @@ utf8Tortf <- function(x) { } #' rtf code to set up footnote for the rtf table -#' @param gt_tbl a data frame +#' @param tbl a data frame #' @noRd -.as_rtf_footnote <- function(gt_tbl){ - - - - footnote_df <- .get_footnote(gt_tbl) - - if(.is_footnote(footnote_df)){ +.as_rtf_footnote <- function(tbl) { + footnote_df <- .get_footnote(tbl) + if (.is_footnote(footnote_df)) { text_footnote <- paste(footnote_df$footnote, collapse = " \n ") text_footnote <- .rtf_text(.convert(text_footnote), - font = footnote_df$font, - font_size = footnote_df$font_size, - format = footnote_df$format, - color = footnote_df$color, - background_color = footnote_df$background_color) - - }else{ + font = footnote_df$font, + font_size = footnote_df$font_size, + format = footnote_df$format, + color = footnote_df$color, + background_color = footnote_df$background_color + ) + } else { text_footnote <- NULL } - if (!is.null(text_footnote)){ - + if (!is.null(text_footnote)) { paragraph <- .rtf_paragraph(text_footnote, + justification = footnote_df$justification, - justification = footnote_df$justification, - - indent_first = footnote_df$indent_first, - indent_left = footnote_df$indent_left, - indent_right = footnote_df$indent_right, + indent_first = footnote_df$indent_first, + indent_left = footnote_df$indent_left, + indent_right = footnote_df$indent_right, - space = footnote_df$space, - space_before = footnote_df$space_before, - space_after = footnote_df$space_after, + space = footnote_df$space, + space_before = footnote_df$space_before, + space_after = footnote_df$space_after, - new_page = footnote_df$new_page, - hyphenation = footnote_df$hyphenation) - }else{ + new_page = footnote_df$new_page, + hyphenation = footnote_df$hyphenation + ) + } else { paragraph <- NULL } paragraph - - } #' rtf code to set up footnote for the rtf table -#' @param gt_tbl a data frame +#' @param tbl a data frame #' #' @noRd -.as_rtf_source <- function(gt_tbl){ - - - - source <- .get_source(gt_tbl) - - if(.is_source(source)){ +.as_rtf_source <- function(tbl) { + source <- .get_source(tbl) + if (.is_source(source)) { text_source <- paste(source$source, collapse = " \n ") text_source <- .rtf_text(.convert(text_source), - font = source$font, - font_size = source$font_size, - format = source$format, - color = source$color, - background_color = source$background_color) - - }else{ + font = source$font, + font_size = source$font_size, + format = source$format, + color = source$color, + background_color = source$background_color + ) + } else { text_source <- NULL } - if (!is.null(text_source)){ - + if (!is.null(text_source)) { paragraph <- .rtf_paragraph(text_source, + justification = source$justification, - justification = source$justification, + indent_first = source$indent_first, + indent_left = source$indent_left, + indent_right = source$indent_right, - indent_first = source$indent_first, - indent_left = source$indent_left, - indent_right = source$indent_right, + space = source$space, + space_before = source$space_before, + space_after = source$space_after, - space = source$space, - space_before = source$space_before, - space_after = source$space_after, - - new_page = source$new_page, - hyphenation = source$hyphenation) - }else{ + new_page = source$new_page, + hyphenation = source$hyphenation + ) + } else { paragraph <- NULL } paragraph - } @@ -929,95 +859,92 @@ utf8Tortf <- function(x) { #' #' @noRd .cell_size <- function(col_rel_width, col_total_width) { - total.width.twip <- .inch_to_twip(col_total_width) - round(total.width.twip/sum(col_rel_width) * col_rel_width,0) - + round(total.width.twip / sum(col_rel_width) * col_rel_width, 0) } #' get attributes and write rtf table row by row -#' @param gt_tbl a data frame +#' @param tbl a data frame #' #' #' @noRd -.as_rtf_table <- function(gt_tbl) { - - - ## get attributes from gt_tbl - border_left <- attributes(gt_tbl)$border_left - border_right <- attributes(gt_tbl)$border_right - border_top <- attributes(gt_tbl)$border_top - border_bottom <- attributes(gt_tbl)$border_bottom - - border_color_left <- attributes(gt_tbl)$border_color_left - border_color_right <- attributes(gt_tbl)$border_color_right - border_color_top <- attributes(gt_tbl)$border_color_top - border_color_bottom <- attributes(gt_tbl)$border_color_bottom - - border_width <- attributes(gt_tbl)$border_width - page_width <- attributes(gt_tbl)$page_width - col_rel_width <- attributes(gt_tbl)$col_rel_width - col_total_width <- attributes(gt_tbl)$col_total_width - cell_height <- attributes(gt_tbl)$cell_height - cell_justification <- attributes(gt_tbl)$cell_justification - - text_font <- attributes(gt_tbl)$text_font - text_format <- attributes(gt_tbl)$text_format - text_color <- attributes(gt_tbl)$text_color - text_background_color <- attributes(gt_tbl)$text_background_color - text_justification <- attributes(gt_tbl)$text_justification - text_font_size <- attributes(gt_tbl)$text_font_size - text_space_before <- attributes(gt_tbl)$text_space_before - text_space_after <- attributes(gt_tbl)$text_space_after - - page_num <- attributes(gt_tbl)$page_num - new_page <- attributes(gt_tbl)$new_page - pageby_db <- attributes(gt_tbl)$pageby_db - pageby_endpage_index <- attributes(gt_tbl)$pageby_endpage_index - - - last_row <- attributes(gt_tbl)$last_row - - - table <- .rtf_table_content(pageby_db, - - border_left = border_left, - border_right = border_right, - border_top = border_top, - border_bottom = border_bottom, - - border_color_left = border_color_left, - border_color_right = border_color_right, - border_color_top = border_color_top, - border_color_bottom = border_color_bottom, - - border_width = border_width, - page_width = page_width, - col_rel_width = col_rel_width, - col_total_width = col_total_width, - cell_height = cell_height, - cell_justification = cell_justification, - - text_font = text_font, - text_format = text_format, - text_color = text_color, - text_background_color= text_background_color, - text_justification = text_justification, - text_font_size = text_font_size, - text_space_before = text_space_before, - text_space_after = text_space_after, - - page_num = page_num, - pageby_endpage_index = pageby_endpage_index, - new_page = new_page, - - last_row = last_row) - - table +.as_rtf_table <- function(tbl) { + + + ## get attributes from tbl + border_left <- attributes(tbl)$border_left + border_right <- attributes(tbl)$border_right + border_top <- attributes(tbl)$border_top + border_bottom <- attributes(tbl)$border_bottom + + border_color_left <- attributes(tbl)$border_color_left + border_color_right <- attributes(tbl)$border_color_right + border_color_top <- attributes(tbl)$border_color_top + border_color_bottom <- attributes(tbl)$border_color_bottom + + border_width <- attributes(tbl)$border_width + page_width <- attributes(tbl)$page_width + col_rel_width <- attributes(tbl)$col_rel_width + col_total_width <- attributes(tbl)$col_total_width + cell_height <- attributes(tbl)$cell_height + cell_justification <- attributes(tbl)$cell_justification + + text_font <- attributes(tbl)$text_font + text_format <- attributes(tbl)$text_format + text_color <- attributes(tbl)$text_color + text_background_color <- attributes(tbl)$text_background_color + text_justification <- attributes(tbl)$text_justification + text_font_size <- attributes(tbl)$text_font_size + text_space_before <- attributes(tbl)$text_space_before + text_space_after <- attributes(tbl)$text_space_after + + page_num <- attributes(tbl)$page_num + new_page <- attributes(tbl)$new_page + pageby_db <- attributes(tbl)$pageby_db + pageby_endpage_index <- attributes(tbl)$pageby_endpage_index + + + last_row <- attributes(tbl)$last_row + + + table <- .rtf_table_content(pageby_db, + border_left = border_left, + border_right = border_right, + border_top = border_top, + border_bottom = border_bottom, + + border_color_left = border_color_left, + border_color_right = border_color_right, + border_color_top = border_color_top, + border_color_bottom = border_color_bottom, + + border_width = border_width, + page_width = page_width, + col_rel_width = col_rel_width, + col_total_width = col_total_width, + cell_height = cell_height, + cell_justification = cell_justification, + + text_font = text_font, + text_format = text_format, + text_color = text_color, + text_background_color = text_background_color, + text_justification = text_justification, + text_font_size = text_font_size, + text_space_before = text_space_before, + text_space_after = text_space_after, + + page_num = page_num, + pageby_endpage_index = pageby_endpage_index, + new_page = new_page, + + last_row = last_row + ) + table } @@ -1085,18 +1012,18 @@ utf8Tortf <- function(x) { pageby_endpage_index, new_page, - last_row){ + last_row) { ## get dimension of db - n_row = nrow(db) - n_col = ncol(db) + n_row <- nrow(db) + n_col <- ncol(db) ## Transer vector to matrix by row - foo <- function(x){ - if( (is.null(dim(x))) & (! is.null(x) ) ){ + foo <- function(x) { + if ((is.null(dim(x))) & (!is.null(x))) { x <- matrix(x, nrow = n_row, ncol = n_col, byrow = TRUE) } x @@ -1104,63 +1031,65 @@ utf8Tortf <- function(x) { ## cell justification - justification <- .justification() - cell_justification_rtf <- factor(cell_justification, levels = justification$type, labels = justification$rtf_code_row) - cell_height <- round(.inch_to_twip(cell_height)/2,0) + justification <- .justification() + cell_justification_rtf <- factor(cell_justification, levels = justification$type, labels = justification$rtf_code_row) + cell_height <- round(.inch_to_twip(cell_height) / 2, 0) ## rtf code for table begin and end - row_begin <- paste0("\\trowd\\trgaph", cell_height, "\\trleft0", cell_justification_rtf) - row_end <- "\\intbl\\row\\pard" + row_begin <- paste0("\\trowd\\trgaph", cell_height, "\\trleft0", cell_justification_rtf) + row_end <- "\\intbl\\row\\pard" # Encoding RTF Cell Border - border_lrtb <- c("\\clbrdrl", "\\clbrdrr", "\\clbrdrt", "\\clbrdrb") + border_lrtb <- c("\\clbrdrl", "\\clbrdrr", "\\clbrdrt", "\\clbrdrb") names(border_lrtb) <- c("left", "right", "top", "bottom") - border_wid <- paste0("\\brdrw", border_width) + border_wid <- paste0("\\brdrw", border_width) ## cell border - border_type <- .border_type() - border_left_rtf <- factor(border_left, levels = border_type$name, labels = border_type$rtf_code) - border_right_rtf <- factor(border_right, levels = border_type$name, labels = border_type$rtf_code) - border_top_rtf <- factor(border_top, levels = border_type$name, labels = border_type$rtf_code) - border_bottom_rtf <- factor(border_bottom, levels = border_type$name, labels = border_type$rtf_code) + border_type <- .border_type() + border_left_rtf <- factor(border_left, levels = border_type$name, labels = border_type$rtf_code) + border_right_rtf <- factor(border_right, levels = border_type$name, labels = border_type$rtf_code) + border_top_rtf <- factor(border_top, levels = border_type$name, labels = border_type$rtf_code) + border_bottom_rtf <- factor(border_bottom, levels = border_type$name, labels = border_type$rtf_code) - border_left_rtf <- paste0(border_lrtb["left"] , border_left_rtf, border_wid) - border_right_rtf <- paste0(border_lrtb["right"] , border_right_rtf, border_wid) - border_top_rtf <- paste0(border_lrtb["top"] , border_top_rtf, border_wid) - border_bottom_rtf <- paste0(border_lrtb["bottom"], border_bottom_rtf, border_wid) + border_left_rtf <- paste0(border_lrtb["left"], border_left_rtf, border_wid) + border_right_rtf <- paste0(border_lrtb["right"], border_right_rtf, border_wid) + border_top_rtf <- paste0(border_lrtb["top"], border_top_rtf, border_wid) + border_bottom_rtf <- paste0(border_lrtb["bottom"], border_bottom_rtf, border_wid) ## border color col_tb <- .color_table() if (!is.null(border_color_left)) { - border_color_left_rtf <- factor(border_color_left, levels = col_tb$color, labels = col_tb$type) - border_color_left_rtf <- paste0("\\brdrcf", border_color_left_rtf) - border_left_rtf <- paste0(border_left_rtf, border_color_left_rtf) + border_color_left_rtf <- factor(border_color_left, levels = col_tb$color, labels = col_tb$type) + border_color_left_rtf <- paste0("\\brdrcf", border_color_left_rtf) + border_left_rtf <- paste0(border_left_rtf, border_color_left_rtf) } if (!is.null(border_color_right)) { - border_color_right_rtf <- factor(border_color_right, levels = col_tb$color, labels = col_tb$type) - border_color_right_rtf <- paste0("\\brdrcf", border_color_right_rtf) - border_right_rtf <- paste0(border_right_rtf, border_color_right_rtf) + border_color_right_rtf <- factor(border_color_right, levels = col_tb$color, labels = col_tb$type) + border_color_right_rtf <- paste0("\\brdrcf", border_color_right_rtf) + border_right_rtf <- paste0(border_right_rtf, border_color_right_rtf) } if (!is.null(border_color_top)) { - border_color_top_rtf <- factor(border_color_top, levels = col_tb$color, labels = col_tb$type) - border_color_top_rtf <- paste0("\\brdrcf", border_color_top_rtf) - border_top_rtf <- paste0(border_top_rtf, border_color_top_rtf) + border_color_top_rtf <- factor(border_color_top, levels = col_tb$color, labels = col_tb$type) + border_color_top_rtf <- paste0("\\brdrcf", border_color_top_rtf) + border_top_rtf <- paste0(border_top_rtf, border_color_top_rtf) } if (!is.null(border_color_bottom)) { - border_color_bottom_rtf <- factor(border_color_bottom, levels = col_tb$color, labels = col_tb$type) + border_color_bottom_rtf <- factor(border_color_bottom, levels = col_tb$color) + levels(border_color_bottom_rtf) <- col_tb$type border_color_bottom_rtf <- paste0("\\brdrcf", border_color_bottom_rtf) - border_bottom_rtf <- paste0(border_bottom_rtf, border_color_bottom_rtf) + border_bottom_rtf <- paste0(border_bottom_rtf, border_color_bottom_rtf) } ## Cell Background Color if (!is.null(text_background_color)) { - text_background_color_rtf <- factor(text_background_color, levels = col_tb$color, labels = col_tb$type) + text_background_color_rtf <- factor(text_background_color, levels = col_tb$color) + levels(text_background_color_rtf) <- col_tb$type text_background_color_rtf <- paste0("\\clcbpat", text_background_color_rtf) } else { text_background_color_rtf <- NULL @@ -1169,32 +1098,32 @@ utf8Tortf <- function(x) { # Cell Size cell_width <- .cell_size(col_rel_width, col_total_width) - cell_size <- cumsum(cell_width) - cell_size <- foo(cell_size) + cell_size <- cumsum(cell_width) + cell_size <- foo(cell_size) # Cell Border - border_top_left <- matrix(paste0(border_left_rtf, border_top_rtf, text_background_color_rtf, "\\cellx", cell_size), nrow = n_row, ncol = n_col) - border_top_left_right <- matrix(paste0(border_left_rtf, border_top_rtf, border_right_rtf, text_background_color_rtf, "\\cellx", cell_size), nrow = n_row, ncol = n_col) + border_top_left <- matrix(paste0(border_left_rtf, border_top_rtf, text_background_color_rtf, "\\cellx", cell_size), nrow = n_row, ncol = n_col) + border_top_left_right <- matrix(paste0(border_left_rtf, border_top_rtf, border_right_rtf, text_background_color_rtf, "\\cellx", cell_size), nrow = n_row, ncol = n_col) border_top_left_bottom <- matrix(paste0(border_left_rtf, border_top_rtf, border_bottom_rtf, text_background_color_rtf, "\\cellx", cell_size), nrow = n_row, ncol = n_col) - border_all <- matrix(paste0(border_left_rtf, border_top_rtf, border_right_rtf, border_bottom_rtf, text_background_color_rtf, "\\cellx", cell_size), nrow = n_row, ncol = n_col) + border_all <- matrix(paste0(border_left_rtf, border_top_rtf, border_right_rtf, border_bottom_rtf, text_background_color_rtf, "\\cellx", cell_size), nrow = n_row, ncol = n_col) - border_rtf <- border_top_left - border_rtf[, n_col] <- border_top_left_right[, n_col] + border_rtf <- border_top_left + border_rtf[, n_col] <- border_top_left_right[, n_col] ## check page_num if (!is.null(page_num) && !is.null(pageby_endpage_index)) { - #if (!is.null(page_num) && (new_page == TRUE)) { - #if (!is.null(page_num) && page_num <= n_row){ + # if (!is.null(page_num) && (new_page == TRUE)) { + # if (!is.null(page_num) && page_num <= n_row){ - border_rtf[pageby_endpage_index, ] <- border_top_left_bottom[pageby_endpage_index,] + border_rtf[pageby_endpage_index, ] <- border_top_left_bottom[pageby_endpage_index, ] border_rtf[pageby_endpage_index, n_col] <- border_all[pageby_endpage_index, n_col] } ## check last_row if (last_row) { - border_rtf[n_row, ] <- border_top_left_bottom[n_row ,] + border_rtf[n_row, ] <- border_top_left_bottom[n_row, ] border_rtf[n_row, n_col] <- border_all[n_row, n_col] } @@ -1206,14 +1135,15 @@ utf8Tortf <- function(x) { cell <- paste0("\\pard\\intbl\\sb", text_space_before, "\\sa", text_space_after) ## text justificaton - text_justification_rtf <- factor(text_justification, levels = justification$type, labels = justification$rtf_code_text) + text_justification_rtf <- factor(text_justification, levels = justification$type, labels = justification$rtf_code_text) + # if align in decimal always justified at center. - text_justification_rtf <- ifelse( text_justification == "d", paste0(text_justification_rtf, "\\tqdec\\tx", round(foo(cell_width)/2, 0) ), as.character(text_justification_rtf)) + text_justification_rtf <- ifelse(text_justification == "d", paste0(text_justification_rtf, "\\tqdec\\tx", round(foo(cell_width) / 2, 0)), as.character(text_justification_rtf)) ## text font and font size - font_type <- .font_type() - text_font_rtf <- factor(text_font, levels = font_type$type, labels = font_type$rtf_code) - text_font_size_rtf <- paste0("\\fs", round(text_font_size * 2, 0) ) + font_type <- .font_type() + text_font_rtf <- factor(text_font, levels = font_type$type, labels = font_type$rtf_code) + text_font_size_rtf <- paste0("\\fs", round(text_font_size * 2, 0)) ## text format ## The combination of type should is valid. @@ -1221,27 +1151,31 @@ utf8Tortf <- function(x) { font_format <- .font_format() if (!is.null(text_format)) { - text_format_rtf <- lapply(strsplit(text_format, ""), function(x){ + text_format_rtf <- lapply(strsplit(text_format, ""), function(x) { paste0(factor(x, levels = font_format$type, labels = font_format$rtf_code), - collapse = "")} ) - text_format_rtf <- unlist(text_format_rtf) + collapse = "" + ) + }) + text_format_rtf <- unlist(text_format_rtf) } else { text_format_rtf <- NULL } ## cell text color - if ( !is.null(text_color) ) { - text_color_rtf <- factor(text_color, levels = col_tb$color, labels = col_tb$type) - text_color_rtf <- paste0("\\cf", text_color_rtf) + if (!is.null(text_color)) { + text_color_rtf <- factor(text_color, levels = col_tb$color, labels = col_tb$type) + text_color_rtf <- paste0("\\cf", text_color_rtf) } else { text_color_rtf <- NULL } - content_matrix <- as.matrix( sapply( db,function(x) .convert(x))) + content_matrix <- as.matrix(sapply(db, function(x) .convert(x))) - cell_rtf <- paste0(cell, text_justification_rtf, - "{", text_font_rtf, text_font_size_rtf, text_color_rtf, text_format_rtf, - " " , content_matrix , "}", "\\cell") + cell_rtf <- paste0( + cell, text_justification_rtf, + "{", text_font_rtf, text_font_size_rtf, text_color_rtf, text_format_rtf, + " ", content_matrix, "}", "\\cell" + ) cell_rtf <- t(matrix(cell_rtf, nrow = n_row, ncol = n_col)) @@ -1255,13 +1189,6 @@ utf8Tortf <- function(x) { #' end rtf table #' #' @noRd -.end_rtf<-function() { - paste("}", sep= "") +.end_rtf <- function() { + paste("}", sep = "") } - - - - - - - diff --git a/R/add_figure.R b/R/add_figure.R index 2a5be75f..6427cb30 100644 --- a/R/add_figure.R +++ b/R/add_figure.R @@ -20,11 +20,11 @@ #' @param file a vector of PNG file path #' #' @export -rtf_read_png <- function(file){ - lapply(file, readBin, what="raw", size=1, signed=TRUE, endian="little", n = 1e8) +rtf_read_png <- function(file) { + lapply(file, readBin, what = "raw", size = 1, signed = TRUE, endian = "little", n = 1e8) } -#' Add Figure Attrbuties +#' Add Figure Attributes #' #' @inheritParams rtf_body #' @@ -32,7 +32,7 @@ rtf_read_png <- function(file){ #' @param fig_height the height of figures in inch #' #' @export -rtf_figure <- function(gt_tbl, +rtf_figure <- function(tbl, page_width = 8.5, page_height = 11, @@ -40,22 +40,20 @@ rtf_figure <- function(gt_tbl, doctype = "wma", fig_width = 5, - fig_height = 5){ - - gt_tbl <- .rtf_page_size(gt_tbl, - page_width = page_width, - page_height = page_height, - orientation = orientation + fig_height = 5) { + tbl <- .rtf_page_size(tbl, + page_width = page_width, + page_height = page_height, + orientation = orientation ) - gt_tbl <- .rtf_page_margin(gt_tbl, - doctype = doctype, - orientation = orientation + tbl <- .rtf_page_margin(tbl, + doctype = doctype, + orientation = orientation ) - attr(gt_tbl, "fig_width") <- matrix(fig_width, nrow = length(gt_tbl), ncol = 1, byrow = TRUE) - attr(gt_tbl, "fig_height") <- matrix(fig_height, nrow = length(gt_tbl), ncol = 1, byrow = TRUE) - - gt_tbl + attr(tbl, "fig_width") <- matrix(fig_width, nrow = length(tbl), ncol = 1, byrow = TRUE) + attr(tbl, "fig_height") <- matrix(fig_height, nrow = length(tbl), ncol = 1, byrow = TRUE) + tbl } diff --git a/R/add_paragraph.R b/R/add_paragraph.R index 7b31e9e8..3a5ca778 100644 --- a/R/add_paragraph.R +++ b/R/add_paragraph.R @@ -31,10 +31,12 @@ font_size = 12, format = NULL, color = NULL, - background_color = NULL){ + background_color = NULL) { ## Set defalut value - if( (! is.null(background_color)) & is.null(color)){color <- "black"} + if ((!is.null(background_color)) & is.null(color)) { + color <- "black" + } ## Define dictionary font_type <- .font_type() @@ -42,15 +44,14 @@ col_tb <- .color_table() - if(! is.null(format)){ + if (!is.null(format)) { format_check <- unlist(strsplit(format, "")) - }else{ + } else { format_check <- NULL } ## check whether input arguments are valid stopifnot( - font %in% font_type$type, as.vector(format_check) %in% font_format$type, @@ -60,8 +61,6 @@ color %in% col_tb$color, background_color %in% col_tb$color - - ) @@ -71,26 +70,29 @@ ### Font font <- factor(font, levels = font_type$type, labels = font_type$rtf_code) - font_size <- paste0("\\fs", round(font_size * 2, 0) ) - + font_size <- paste0("\\fs", round(font_size * 2, 0)) ## The combination of text format should be valid. ## e.g. type = "bi" or "ib" should be bold and italics. - if(! is.null(format)){ - format <- lapply(strsplit(format, ""), function(x){ + if (!is.null(format)) { + format <- lapply(strsplit(format, ""), function(x) { paste0(factor(x, levels = font_format$type, labels = font_format$rtf_code), - collapse = "")} ) - format <- unlist(format) - }else{format <- NULL} + collapse = "" + ) + }) + format <- unlist(format) + } else { + format <- NULL + } ### Color text_color <- NULL - if(! is.null(color)){ + if (!is.null(color)) { fg_color <- factor(color, levels = col_tb$color, labels = col_tb$type) text_color <- paste0("\\cf", fg_color) } - if(! is.null(background_color)){ + if (!is.null(background_color)) { bg_color <- factor(background_color, levels = col_tb$color, labels = col_tb$type) text_color <- paste0(text_color, "\\chshdng0", "\\chcbpat", bg_color, "\\cb", bg_color) } @@ -104,13 +106,14 @@ end <- "}" - paste0(begin, - font, font_size, - format, - text_color, " ", - text, - end) - + paste0( + begin, + font, font_size, + format, + text_color, " ", + text, + end + ) } #' rtf code to add text to paragraph @@ -130,20 +133,20 @@ #' #' @noRd .rtf_paragraph <- function( - text, + text, - justification = "c", + justification = "c", - indent_first = 0, - indent_left = 0, - indent_right = 0, + indent_first = 0, + indent_left = 0, + indent_right = 0, - space = 1, - space_before = 180, - space_after = 180, + space = 1, + space_before = 180, + space_after = 180, - new_page = FALSE, - hyphenation = TRUE){ + new_page = FALSE, + hyphenation = TRUE) { ## Define dictionary para_justification <- .justification() @@ -151,7 +154,6 @@ ## check whether input arguments are valid stopifnot( - as.vector(justification) %in% para_justification$type, is.numeric(indent_first), @@ -165,30 +167,29 @@ is.numeric(space_before), is.numeric(space_after) - - - ) begin <- "{\\pard" ### line space space_before <- paste0("\\sb", space_before) - space_after <- paste0("\\sa", space_after) + space_after <- paste0("\\sa", space_after) ### paragraph space - space <- factor(space, levels = spacing$type, labels = spacing$rtf_code) + space <- factor(space, levels = spacing$type) + levels(space) <- spacing$rtf_code ### Start new page for this paragraph page_break <- ifelse(new_page, "\\pagebb", "") ### Indent indent_first <- paste0("\\fi", indent_first) - indent_left <- paste0("\\li", indent_left) + indent_left <- paste0("\\li", indent_left) indent_right <- paste0("\\ri", indent_right) ### Alignment - alignment <- factor(justification, levels = para_justification$type, labels = para_justification$rtf_code_text) + alignment <- factor(justification, levels = para_justification$type) + levels(alignment) <- para_justification$rtf_code_text ### Hyphenation hyphenation <- ifelse(hyphenation, "\\hyphpar", "hyphpar0") @@ -197,11 +198,12 @@ ## Paragraph RTF Encode - paste0(begin, page_break, hyphenation, "\n", - space, space_before, space_after, indent_first, indent_left, indent_right, alignment, "\n", - text, "\n", - end) - + paste0( + begin, page_break, hyphenation, "\n", + space, space_before, space_after, indent_first, indent_left, indent_right, alignment, "\n", + text, "\n", + end + ) } #' rtf code to add picture @@ -209,11 +211,12 @@ #' @param path path for rtf figure #' #' @noRd -.rtf_figure <- function(path){ +.rtf_figure <- function(path) { # ToDo # refer rtf:::.add.png and rtf::addPng.RTF - paste0( "{\\field\\fldedit{\\*\\fldinst { INCLUDEPICTURE \\\\d", + paste0( + "{\\field\\fldedit{\\*\\fldinst { INCLUDEPICTURE \\\\d", path, "\\\\* MERGEFORMATINET }}{\\fldrslt { }}}" ) @@ -226,18 +229,17 @@ #' @param file file name to save rtf text paragraph, eg. filename.rtf #' #' @noRd -write_rtf_para <- function(rtf_body, file){ - - col_tb <- .color_table() - rtf_color <- paste(c( "{\\colortbl; ", col_tb$rtf_code, "}"), collapse = "\n") +write_rtf_para <- function(rtf_body, file) { + col_tb <- .color_table() + rtf_color <- paste(c("{\\colortbl; ", col_tb$rtf_code, "}"), collapse = "\n") start_rtf <- paste( .as_rtf_init(), .as_rtf_font(), rtf_color, - sep="\n" + sep = "\n" ) - rtf <- paste(start_rtf, "{\\pard \\par}", paste(rtf_body, collapse = ""), .end_rtf(), sep="\n") + rtf <- paste(start_rtf, "{\\pard \\par}", paste(rtf_body, collapse = ""), .end_rtf(), sep = "\n") write(rtf, file) } diff --git a/R/data.R b/R/data.R index a382f8ad..5ad0b0e4 100644 --- a/R/data.R +++ b/R/data.R @@ -38,4 +38,3 @@ #' unicode_latex "unicode_latex" - diff --git a/R/dictionary.R b/R/dictionary.R index ed6dac63..753a662f 100644 --- a/R/dictionary.R +++ b/R/dictionary.R @@ -20,15 +20,12 @@ #' #' @noRd .font_type <- function() { - data.frame( - type = 1:3, name = c("Times New Roman", "Times New Roman Greek", "Arial Greek"), - style = c("\\froman","\\froman","\\fswiss"), - rtf_code = c("\\f0", "\\f166","\\f266"), + style = c("\\froman", "\\froman", "\\fswiss"), + rtf_code = c("\\f0", "\\f166", "\\f266"), stringsAsFactors = FALSE - ) } @@ -37,12 +34,11 @@ #' #' @noRd .color_table <- function() { - .tb <- data.frame(color = grDevices::colors()) .tb$type <- 1:nrow(.tb) + 1 - .tb <- cbind( .tb, t(grDevices::col2rgb(.tb$color)) ) - .tb$rtf_code <- paste0("\\red",.tb$red, "\\green", .tb$green, "\\blue", .tb$blue,";") + .tb <- cbind(.tb, t(grDevices::col2rgb(.tb$color))) + .tb$rtf_code <- paste0("\\red", .tb$red, "\\green", .tb$green, "\\blue", .tb$blue, ";") .tb } @@ -53,14 +49,11 @@ #' #' @noRd .font_format <- function() { - data.frame( - - type = c("","b", "i", "u","s","^","_"), - name = c("normal","bold", "italics","underline","strike","superscript","subscript"), - rtf_code = c("","\\b", "\\i", "\\ul", "\\strike", "\\super", "\\sub"), + type = c("", "b", "i", "u", "s", "^", "_"), + name = c("normal", "bold", "italics", "underline", "strike", "superscript", "subscript"), + rtf_code = c("", "\\b", "\\i", "\\ul", "\\strike", "\\super", "\\sub"), stringsAsFactors = FALSE - ) } @@ -68,39 +61,37 @@ #' #' @noRd .justification <- function() { - data.frame( - type = c("l", "c", "r", "d", "j"), name = c("left", "center", "right", "decimal", "justified"), rtf_code_text = c("\\ql", "\\qc", "\\qr", "\\qj", "\\qj"), - rtf_code_row = c("\\trql", "\\trqc", "\\trqr", "", ""), + rtf_code_row = c("\\trql", "\\trqc", "\\trqr", "", ""), stringsAsFactors = FALSE - ) - } #' create a data frame as dictionary to look up for rtf table border type #' #' @noRd .border_type <- function() { - data.frame( - - name = c("", "single","double thick","shadowed","double","dot", "dash", "hairline","small dash","dot dash", "dot dot", "triple", - "thick thin small" , "thin thick small" , "thin thick thin small", - "thick thin medium", "thin thick medium", "thin thick thin medium", - "thick thin large" , "thin thick large" , "thin thick thin large", - "wavy", "double wavy", "stripe", "emboss", "engrave"), - - rtf_code = c("", "\\brdrs", "\\brdrth", "\\brdrsh", "\\brdrdb", "\\brdrdot","\\brdrdash", - "\\brdrhair","\\brdrdashsm","\\brdrdashd","\\brdrdashdd","\\brdrtriple", - "\\brdrtnthsg", "\\brdrthtnsg", "\\brdrtnthtnsg", - "\\brdrtnthmg", "\\brdrthtnmg", "\\brdrtnthtnmg", - "\\brdrtnthlg", "\\brdrthtnlg", "\\brdrtnthtnlg", - "\\brdrwavy", "\\brdrwavydb", "\\brdrdashdotstr", - "\\brdremboss", "\\brdrengrave"), + name = c( + "", "single", "double thick", "shadowed", "double", "dot", "dash", "hairline", "small dash", "dot dash", "dot dot", "triple", + "thick thin small", "thin thick small", "thin thick thin small", + "thick thin medium", "thin thick medium", "thin thick thin medium", + "thick thin large", "thin thick large", "thin thick thin large", + "wavy", "double wavy", "stripe", "emboss", "engrave" + ), + + rtf_code = c( + "", "\\brdrs", "\\brdrth", "\\brdrsh", "\\brdrdb", "\\brdrdot", "\\brdrdash", + "\\brdrhair", "\\brdrdashsm", "\\brdrdashd", "\\brdrdashdd", "\\brdrtriple", + "\\brdrtnthsg", "\\brdrthtnsg", "\\brdrtnthtnsg", + "\\brdrtnthmg", "\\brdrthtnmg", "\\brdrtnthtnmg", + "\\brdrtnthlg", "\\brdrthtnlg", "\\brdrtnthtnlg", + "\\brdrwavy", "\\brdrwavydb", "\\brdrdashdotstr", + "\\brdremboss", "\\brdrengrave" + ), stringsAsFactors = FALSE ) } @@ -108,10 +99,8 @@ #' create a data frame as dictionary to look up for rtf paragraph spacing #' #' @noRd -.spacing <- function(){ - +.spacing <- function() { data.frame( - type = c(1, 2, 1.5), name = c("single-space", "double-space", "1.5-space"), rtf_code = c("", "\\sl480\\slmult1", "\\sl360\\slmult1"), diff --git a/R/write_rtf.R b/R/write_rtf.R index 43924a8a..75d582c0 100644 --- a/R/write_rtf.R +++ b/R/write_rtf.R @@ -21,62 +21,61 @@ #' to an RTF file. #' #' @name rtf_encode -#' @param gt_tbl a data frame for table or a list of binary string for figure +#' @param tbl a data frame for table or a list of binary string for figure #' @param type the type of input, default is table. #' #' @rdname rtf_encode #' @export -rtf_encode <- function(gt_tbl, type = "table"){ - +rtf_encode <- function(tbl, type = "table") { match.arg(type, c("table", "figure")) - if(type == "table"){ - return(.rtf_encode_table(gt_tbl)) + if (type == "table") { + return(.rtf_encode_table(tbl)) } - if(type == "figure"){ - return(.rtf_encode_figure(gt_tbl)) + if (type == "figure") { + return(.rtf_encode_figure(tbl)) } - } #' @rdname rtf_encode #' @export -as_rtf <- function(gt_tbl, type = "table"){ - +as_rtf <- function(tbl, type = "table") { message("`as_rtf()` is deprecated, use `rtf_encode`.") - rtf_encode(gt_tbl, type) + rtf_encode(tbl, type) } #' Render Table to RTF encoding #' #' @noRd -.rtf_encode_figure <- function(gt_tbl){ +.rtf_encode_figure <- function(tbl) { ## get rtf code for page, margin, header, footnote, source, newpage - page_rtftext <- .as_rtf_page(gt_tbl) - margin_rtftext <- .as_rtf_margin(gt_tbl) - header_rtftext <- .as_rtf_header(gt_tbl) - footnote_rtftext <- .as_rtf_footnote(gt_tbl) - source_rtftext <- .as_rtf_source(gt_tbl) - newpage_rtftext <- .as_rtf_newpage() + page_rtftext <- .as_rtf_page(tbl) + margin_rtftext <- .as_rtf_margin(tbl) + header_rtftext <- .as_rtf_header(tbl) + footnote_rtftext <- .as_rtf_footnote(tbl) + source_rtftext <- .as_rtf_source(tbl) + newpage_rtftext <- .as_rtf_newpage() ## get rtf code for figure width and height - fig_width <- attr(gt_tbl, "fig_width") - fig_height <- attr(gt_tbl, "fig_height") + fig_width <- attr(tbl, "fig_width") + fig_height <- attr(tbl, "fig_height") - rtf_fig <- paste0("{\\pict\\pngblip\\picwgoal", - round(fig_width*1440),"\\pichgoal", - round(fig_height*1440)," ", lapply(gt_tbl, paste, collapse = ""),"}") + rtf_fig <- paste0( + "{\\pict\\pngblip\\picwgoal", + round(fig_width * 1440), "\\pichgoal", + round(fig_height * 1440), " ", lapply(tbl, paste, collapse = ""), "}" + ) start_rtf <- paste( .as_rtf_init(), .as_rtf_font(), - sep="\n" + sep = "\n" ) rtf_feature <- paste( @@ -87,7 +86,7 @@ as_rtf <- function(gt_tbl, type = "table"){ .rtf_paragraph(""), # new line after figure footnote_rtftext, source_rtftext, - c(rep(newpage_rtftext, length(rtf_fig) -1), ""), + c(rep(newpage_rtftext, length(rtf_fig) - 1), ""), sep = "\n" ) rtf_feature <- paste(rtf_feature, collapse = "\n") @@ -95,126 +94,119 @@ as_rtf <- function(gt_tbl, type = "table"){ end_rtf <- .end_rtf() - paste(start_rtf, rtf_feature, end_rtf, end_rtf, sep="\n") - + paste(start_rtf, rtf_feature, end_rtf, end_rtf, sep = "\n") } #' Render Table to RTF encoding #' #' @noRd -.rtf_encode_table <- function(gt_tbl){ +.rtf_encode_table <- function(tbl) { start_rtf <- paste( .as_rtf_init(), .as_rtf_font(), - .as_rtf_color(gt_tbl), - sep="\n" + .as_rtf_color(tbl), + sep = "\n" ) - if ( "data.frame" %in% class(gt_tbl) ) { + if ("data.frame" %in% class(tbl)) { ## get rtf code for page, margin, header, footnote, source, newpage - page_rtftext <- .as_rtf_page(gt_tbl) - margin_rtftext <- .as_rtf_margin(gt_tbl) - header_rtftext <- .as_rtf_header(gt_tbl) - footnote_rtftext <- .as_rtf_footnote(gt_tbl) - source_rtftext <- .as_rtf_source(gt_tbl) - newpage_rtftext <- .as_rtf_newpage() + page_rtftext <- .as_rtf_page(tbl) + margin_rtftext <- .as_rtf_margin(tbl) + header_rtftext <- .as_rtf_header(tbl) + footnote_rtftext <- .as_rtf_footnote(tbl) + source_rtftext <- .as_rtf_source(tbl) + newpage_rtftext <- .as_rtf_newpage() ## get rtf code for colheader and table - colheader_rtftext <- .as_rtf_colheader(gt_tbl) - table_rtftext <- .as_rtf_table(gt_tbl) + colheader_rtftext <- .as_rtf_colheader(tbl) + table_rtftext <- .as_rtf_table(tbl) ## combine table_rtftext with pageby_colheader - page_by <- attr(gt_tbl, "page_by") - pageby_db <- attr(gt_tbl, "pageby_db") - pageby_condition <- attr(gt_tbl, "pageby_condition") - pageby_colheader <- attr(gt_tbl, "pageby_colheader") - new_page <- attr(gt_tbl, "new_page") - page_num <- attr(gt_tbl, "page_num") - - - newtable_list <- .page_by_newtable_rtf(page_by, - pageby_colheader, - pageby_condition, - table_rtftext, - new_page) + page_by <- attr(tbl, "page_by") + pageby_db <- attr(tbl, "pageby_db") + pageby_condition <- attr(tbl, "pageby_condition") + pageby_colheader <- attr(tbl, "pageby_colheader") + new_page <- attr(tbl, "new_page") + page_num <- attr(tbl, "page_num") + + + newtable_list <- .page_by_newtable_rtf( + page_by, + pageby_colheader, + pageby_condition, + table_rtftext, + new_page + ) - table_rtftext <- newtable_list$table_rtftext + table_rtftext <- newtable_list$table_rtftext category_index <- newtable_list$category_index n_row <- ncol(table_rtftext) - pages <- .table_rtftext_index(new_page, category_index, page_num, n_row) - - if (length(pages) > 1){ - - #if (!is.null(page_num) && !is.null(category_index)) { - - #pages <- .table_rtftext_index(new_page, category_index, page_num, n_row) - - rtf_feature <- lapply( 1:(length(pages)-1), function(x){ + pages <- .table_rtftext_index(new_page, category_index, page_num, n_row) - paste( - - page_rtftext, - - margin_rtftext, - - paste("{\\pard \\par}", header_rtftext, sep = "\n"), + if (length(pages) > 1) { - paste(unlist(colheader_rtftext), collapse = "\n"), + # if (!is.null(page_num) && !is.null(category_index)) { - paste(table_rtftext[, c( (pages[x] + 1) : pages[x+1])], - collapse = "\n"), + # pages <- .table_rtftext_index(new_page, category_index, page_num, n_row) - footnote_rtftext, + rtf_feature <- lapply(1:(length(pages) - 1), function(x) { + paste( - source_rtftext, + page_rtftext, - newpage_rtftext, + margin_rtftext, - sep="\n" + paste("{\\pard \\par}", header_rtftext, sep = "\n"), - ) + paste(unlist(colheader_rtftext), collapse = "\n"), - }) + paste(table_rtftext[, c((pages[x] + 1):pages[x + 1])], + collapse = "\n" + ), - if (pages[length(pages)] < n_row) { + footnote_rtftext, - rtf_feature <- c(rtf_feature, + source_rtftext, - paste( + newpage_rtftext, + sep = "\n" + ) + }) - page_rtftext, + if (pages[length(pages)] < n_row) { + rtf_feature <- c( + rtf_feature, - margin_rtftext, + paste( - paste("{\\pard \\par}", header_rtftext, sep = "\n"), + page_rtftext, - paste(unlist(colheader_rtftext), collapse = "\n"), + margin_rtftext, - paste(table_rtftext[, c( (pages[length(pages)] + 1) : n_row )], - collapse = "\n"), + paste("{\\pard \\par}", header_rtftext, sep = "\n"), - footnote_rtftext, + paste(unlist(colheader_rtftext), collapse = "\n"), - source_rtftext, + paste(table_rtftext[, c((pages[length(pages)] + 1):n_row)], + collapse = "\n" + ), - sep="\n") + footnote_rtftext, + source_rtftext, + sep = "\n" ) - } - - rtf_feature <- paste(unlist(rtf_feature), collapse = "\n") - - - + ) + } + rtf_feature <- paste(unlist(rtf_feature), collapse = "\n") } else { - rtf_feature <- paste( page_rtftext, @@ -230,54 +222,43 @@ as_rtf <- function(gt_tbl, type = "table"){ footnote_rtftext, source_rtftext, - - sep="\n" + sep = "\n" ) - } - - - - }else if (class(gt_tbl) == "list") { - - + } else if (class(tbl) == "list") { rtf_feature <- paste( - .as_rtf_page(gt_tbl[[1]]), + .as_rtf_page(tbl[[1]]), - .as_rtf_margin(gt_tbl[[1]]), + .as_rtf_margin(tbl[[1]]), - paste("{\\pard \\par}", unlist(lapply(gt_tbl, function (x) .as_rtf_header(x))), sep = "\n"), + paste("{\\pard \\par}", unlist(lapply(tbl, function(x) .as_rtf_header(x))), sep = "\n"), - paste(unlist(lapply(gt_tbl, function(x) { - paste( - paste(unlist(.as_rtf_colheader(x)), collapse = "\n"), - paste(.as_rtf_table(x), collapse = "\n"), - sep = "\n" - ) - })), - collapse = "\n"), + paste(unlist(lapply(tbl, function(x) { + paste( + paste(unlist(.as_rtf_colheader(x)), collapse = "\n"), + paste(.as_rtf_table(x), collapse = "\n"), + sep = "\n" + ) + })), + collapse = "\n" + ), - paste(unlist(lapply(gt_tbl, function (x) .as_rtf_footnote(x))), sep = ""), + paste(unlist(lapply(tbl, function(x) .as_rtf_footnote(x))), sep = ""), - paste(unlist(lapply(gt_tbl, function (x) .as_rtf_source(x))), sep = ""), - - sep="\n" + paste(unlist(lapply(tbl, function(x) .as_rtf_source(x))), sep = ""), + sep = "\n" ) - } else { - stop("Input must be a data frame or a list of data frame to render an rtf table") - } - rtf <- paste(start_rtf, rtf_feature, .end_rtf(), sep="\n") + rtf <- paste(start_rtf, rtf_feature, .end_rtf(), sep = "\n") rtf - } @@ -287,16 +268,10 @@ as_rtf <- function(gt_tbl, type = "table"){ #' @description #' The write_rtf function writes rtf encoding string to an .rtf file #' -#' @param rtf rtf encoing string rendered by `as_rtf()` +#' @param rtf rtf encoding string rendered by `as_rtf()` #' @param file File name to write the output RTF table. #' #' @export -write_rtf <- function(rtf, file){ - +write_rtf <- function(rtf, file) { write(rtf, file) - } - - - - diff --git a/README.Rmd b/README.Rmd index a6855c61..ebd93815 100644 --- a/README.Rmd +++ b/README.Rmd @@ -7,7 +7,7 @@ knitr::opts_chunk$set(echo = TRUE) ``` ```{r, echo = FALSE} -pkgname = "r2rtf" +pkgname <- "r2rtf" ``` # Overview diff --git a/data/t1_gt.rda b/data/t1_gt.rda index 142b4aff7cd194d476fd95ea727c078a2e3d0add..dc17ecb701595a0dd561d0854621765003a3c007 100644 GIT binary patch literal 7446 zcmeHM>u=jO5Lf(+oi^>7?vZwDiLC`vEYad7P8?tzmL&^Npv{UV-TGmeKwGq}RTe#p zPMUq{=lyH@hxTdNQ6yzrk36;{*nrs(EZ+UdJ06e6y`TJx@B2Kt5}(`ie-4U z%CGi!mRgooDnMh(Dp@r_y;|^(409}uO zmh}XFci=HQ&NSBSHMFp5uQnd3o->V>y^0pr?3L9=r}bWndN=KjX54#e!(K)U>-O>) zdIJhAY}k#paqpJBjuu*WGwN+>I=2*|mw?w=L`zM3rKNk_1|sxYYAoB0b>OYr4d5lr z*YR-}CT3scZC_i^#T?sRh6g0kv&QJ59ROYQj%@i3UXG8C|4abO8YI-7R^t};8CS1` z-G+KAKPNcQjl%9@ldKzs-4&Cp8-=Z>39;2SecN~3Zo)N+phOL{JdS^*AC-L41viSk zAP-Y!Uax-|=)XCT(pqe-k}%DctW{A8^^mGsGK$Vct5bBKT=AS zn<=IIwJxPRpqzx`8C28^^z?5?vxScO1@#FqxZ3fss3cV1~F5038n0Ywp zkVUlh6g>e#(Dhsb1oSlEgdJdi5k1=j&NG5Tj`n^TVMfA5w6_hkJ&pqxGZ$@>0}peL zCRblOQUxNIFpkvsqT`Borh1hHWZw-){xZ3p-j?;<>j zC%N0NOACii$T1u&5h%5?%HS8KDlBqBRk13Ue!`_DKdZd$tW3sbAm<-Ic##4(nhzlgJ<_o(;aiuw zkSWKnLj=jQXEH`#S$kryU9CN4F=IIB5hprQwU3DyphDk-ZrZgf8lAFlRpbNX^YZ_j z!WnN0akSJXo=B|3BIL!{I8I%y<5cO88)3PmJf^8mYDkO%j=g{|=g@O`Uy*N)$$b)K z`7(95J*LwG!n!^^bl$2yS-c~~o94Lf6UTE^dq%cRkvAl%3;H;r_p44BKak`$?z|Ds z9JnHdqfC!8z^vy%IxKE0QpIbEBrhkDrU#+Sg^6-Hgo6>13)LgdHT6n!O$9#c6YP3H z&&g5nL(S(N2LmK$cSp0sQ9B!PS0ma|`8MU84kq-^ftZuXftWM72aWh<5$4Wk5|y0K zd6#Ba)KePp~GWnj>fXKsLfOVK&0F;3s1h@)s)? zWXj3~nd0uMok86rN6AZib`Hc8l>;#a-AfC~@WOnQDJ~ynN}Lgv9Aa1OEae>Yf)sM* z4aIKrf{s6O2@pnY1-PFH7^|*eABUp>M2I6tz;ib3oQauK6dhSGpck?{@K3CU2+b5`Gqot}R*)N%b*Oik{en=xlnhua|?u?`XU z>s0i*W$<(_%Mx|UCOlamk+A&JM~r(BW1KXO;E7LCj!3rj(OHYnLS^#5K`2N5srp}4 zqpFS+CH5klu!-Re3H8Y5X^H}>jQ-l3{}Mty6+1V&r7;!}b&qjJL6-!k2 z^E0M(s8A!Ew_P8H4K;#EkvAH>$x3*{sY0FQz20UaIsCcn@;6z%8f!zHu2w(Wi9T5{ zLufgqew?-z9~<2_TjC1=K~@Z9rdet{Za!2)7F+S_xkoYd^a782SQmiHJDbn;zD-HZ z$DgLZ)caHgF9TL=#pYDgQbyc=`6@X@16%ciK4G4yqnM`8LdfwdU$z07+WJ1`f2If;@Je8deDPA#cHJu zbr~HXQRVjG&WJEaKM?W;iCtj!`~0~VhLESBZKyJ!&Eb$y-07qGxcL2o4oALGvW{=Z V`oDv6bRE*B)Yl`B17%D3`~{;=lV|_{ literal 1547 zcmV+m2K4zKiwFP!000002JKl}Z`(E$mTyVyc5T*nm$thQTMHyuqQz;PIKVnAOIDyj z+ZA=U^OJ*&e{FwgPt8b4q$x^Dnk-E>U=D1F=X~V3@bK`Ed9wFx zz4feRSyt7mHTZ9hzt*e#r()HuCVw_q+wquX)vof!0{pL;fvhMQlJ)`4=_NKiFmNx8-_Oc>%?G3QBY2VpcKCbs_+`D6McU14yZF>zY zZP{zD(R)ikx9#@ktasPm0!v-H6Zh89R}(Y`bh;~GwPWAu%3jx!UaRdjyS>GETXviC z4EGHJNU1UAoW~s252O=a$e=wWaEy%3O@a^XkkhF&=_UU;JUo15N|B(&c#;xg?I~gD zYxPlEA|E0cwiS6@C$B5=9i1#2)!qAs*!ezwF>>6Y5gj6inq136^-SRP01eqOm?hzbKoB;Nb48V&697N-=kOl+a3zMO$a;QpC;96!( z&QlikXTecbYrynQDLvyUxptbd{vzI`9KJ|GwRVnHQhCH!OgZH*4l!mSW{A!#m@`Jc zoVbWO>64Q#3HCPvlzb9+*3gPRMX@54mpVG({&DM8Pa%Nwhv8vovhN@!JH=Z?f#$QV3>}c!%I$P^oTxgP% zd2XrdJFJT5rvyPZMjj_=BO zN!q%|%L!@72XUzXyWDc$Psn{ZcrJoDbVUh=i5zDPiRbfjSd{B&Ihc}&rnVde6PIhp z@WhFWi&CzxSDvdY@ZktS*AKli1wW8{=CcCpZb&wb`o)NwN8U0Hjx)CK1 zUDHqWlLalcCyO$*y3H+<^|JT>st4nuK2Tzi{tis=e9(5)$55z(e(5~pZQQ;Lp1K~ zJm`IQ0{n53-y*EmRh-nU)SRbJelShcu-w8CB0hT!MADr5s!za|UrS~fjr)kmyi?m= zQxmqKMlh+_BV1kPiU|}4Kc@0|oeroRcwqn;@-UHWyRi?0sO*sV=jrb4MG*j*IN*!J zon>C4s6wF(q4IZfpHMZVFQvEE;;MQit{=dV;4u)l+yURk0A%1Ngr0-0(eI0gKBatE xu*bCrJCg~)a4-U`+2!|RJc$DB$~yPIgGPKDlCG4;qr?Zv_iuJFevJ?v002w<4G;hT diff --git a/data/t2_gt.rda b/data/t2_gt.rda index c92b547a3219855a3aed47cdbc71fa2b8edce8de..ab250855db63b325fde96ba0a08ddcd1eb809327 100644 GIT binary patch literal 5943 zcmd^D>u=md5O?BxghibW}EC357^z(qnxRYN4CR;rp7^+P3VZSVO^eO|L( zCpkXx|M53bm_6^>>$RO%(+UYk7kg)aJFlIYeZ1Izz0-f)Hw?ox%+8!)w&Bxgzj}GF zF*JRU(2zdwn z-xXl^B(=aG!B5CILw8dju;^2g#&(DtEd9FVk}#b_wKNn4ew4XkUb2#bQkoCro$joJ zrB2~29${G^70%MyB?IOB_h$O?X%n;3g}I(JXHk2)Qk>(=16oW}lwBGT!Xm}=8t@HzWfpGk_8>9a7bK5{|;}a6WQt0Sn2G-R4C03w>8JM7(Rh`Dj5Z` zc{_K5jOh-f4L2o=lBOi8_@S4uY50G40*^2y4(7nee4hCmex*5-Sc%T&gyd%(BmM%))Oex zhz1FPf+T857T(|N2cr?DIC8NSMAp+o>lsvW>%rdcee20D58rsm_c8ri8`X_Bennv_ z){@*E=kZ@9Z~BnNO=dLKJ7GiKUy7_tsj-YGMUju~S<#dp<$+sQpyb4NB)Vc&m#?@* zMf?bxfjl{+a-~J4RQj~EdcO(ml9(yU)DkY+6$SLVOCpAX2vhqw@Yq<8R|@hN2mY7| z`mKUajxZgC09q6GA;Ol#v+987v24M73AdtJmEVrfWu-0S=-XwjsKP>)buSdUOW_(h>Y^JF!GR9TH6Rooqs z8N{2~LY^Mk4G>jS14I>cw<@S63Y$@?xMq|paglp6Mjp>Bk)&&!lrS2^JllfE4O0&T zA$0`c%UVF8x`2J2q!XwRQ=7vZl6FQyZE-%X0R|NBSPiI_bVR=o~_~<#H>}3 zWnoqoP%ARuP;BNfBbNvI$8H zYe*tFU!=*eIMcYGVy+^8@2U)EVrxOdk3?p4yFigCnU_bt>(5e z{PB?gK|#o_$i%hP*7ojw!O|S&pBLt$=ov%-3y{3iY9Bm)diZliYBT;U{WHDKRPaN< z%wg_MVU}>>%NMV76BTSXh{l)({035WeH|j>*ZI+*)^|UNY3ahnlY^-&Qs&-fK4Fh? zeROL1cBCa(_2AeJ7kCWI^GGXk;i5N_y5J&)eM03KsC`r%$}4wwe`&W5wWq}DF_!N; c5aXA_{DuJ@evpLKG1H)*?@bg0XJWkj7Z6IJR{#J2 literal 1230 zcmV;<1Tp&`iwFP!000002IW})kJ~g9PrqNg?bhwaU^l)*z|bbKa(CN7PeMr3j!8(H zH0=QG2c*bJ+|(?Ii|t&m{Ivg%zljaIu~WxMdTZ$c60O?C?|uBf`T0G&FOFXx^j`KX z%c@(A7XNPW$7Y>>)vTt~<-aX<-~`OF8asR-xP6Uz^Mob-%swVbV4u=~{X7I7bg_ZD zwm?bC?^-QO^eq3`PV*(3spM zcshtVT?n`$1ia>7Z~4pAqCow*dnvK$;b@|sBM4&oT$>oPJ1#yOJO0QBkNEAT%H*$< z6~YnQ97dSZe7mCU4RgY!fZ$}}gusO=u9rO=CQ)2U10f3HR8(Dws+FyW^~MYqWr@28 zRy~`%aMBp(98@XLo!cvxP08hJ9cL-9+^8%9Motury*$F0#h5|5u(&NHTXMdojVtIm z58BG$5PO>aZ81zD#SBQ!IUaT$D}2qcO$N`H;gn^BK`nEeZyVuCI%-sGqCyiqXI?awDJnC}y{Trk z6}p&WV(p3z?*h*Q>(%qWAGr>mFl{q6rL05AzUtwa0Te^xOp(vVlH6aA#}EZ$Ch0d8 zbbJcQD8y6eYzc2Bd0Py)A#{+hnsqwXRbEX=BQC_D=yz2lZ>D4yc(252#=gTh7A8tg z1W15*hZhG4+3_TaXl5%RnE2c}h9}Ov9aM64yNX=hfDgtH_$Usl418bl8Db^g?J71+ z+;YV2OhIaZiy6aF&i)FB?nDJdxAbHEutY2U$)ikbZv!uDTJ!w; zhX)jFBA1`UeU?tMELM>UFv877In&aN0Y?M&) zo2&^EhF5s*MQl9&?G=vvU(1mDUr*F=we#7N`Rg2kEsDeJ*xESIrau~rw`KgLwSRDU zN1=z=|rLsq~>p8O;s!SwVmJJSXR%Q)T2u9mIoLNFj0HE sb-K8e7w&q0toK)>I0OJDZn)xdXPKAx?4Y0_gb?e^U#8`o4>1=2019<{9 diff --git a/data/t3_gt.rda b/data/t3_gt.rda index db66f5e519d5c7e1c14cafa7ca1d346f32e355a2..19dbf8cfb28514b57386f88e880cc92e6c3169cf 100644 GIT binary patch literal 5673 zcmd^D-E-775I6CC6m;msqTbv}d7a%DM} z@YMgW{}Xg&t$ea%6GDOMOwEL|RzL0jcC}hbKKWo6 zk3Fxq290Z8&l^dhI1FL|z@19y`PbDi0Ghx-O3!FoK<{>iP{Z$@GA1T}P?Aj^{aF%D zqsc?g8K1D(?5oCYHL4&1r#MyFRYnFbm{RRKMg2w_5Lv}t7qS-1;RS~ znh6Si$Vm4zH63w-c3=1T$aN#;tjvRygjCbtoU*iBWUVriCUK_B)Dh5T8g4rQ9TuVt zS02fXP}92d$Z9uy(P17{d}RpHfgyynYF56#o|M#BMZgNZLw0ipNtQ7|ixuMmGKL>d zj+c*QEFb-A$r~OFG~tv@4gLe!EEl>n=DE>1gsCu^1L!{%raFOjg40@Ue zke$*Ml`dVm>cnAGh>P_99t4?TMjk+!s^(w*V##t=+;ufkMNkOB?K!g6{JWYfnJX4e zwV>3T8%4mOyM<}?LHUlssH!ngX4iI9G_fXJP8r>CGIk6Ls7q^IX&UQNm#;33TZD7D ztpru&vAN=cb3!`MXoulY?hdQ60x4wgfNQ!)Yid{A^XiP!&5Z@&aRPfJooR}j zDB=cft%UIi92G2wf&c{-mAJhoFSpku@Y$S_D9PfWgW#vSUnBwoV0*WxyNfbxN8Hwk zP>~Or5Ny%l-vKe5=zy4>+<``Y+$cKzX`*a@c3ZlaRsxw;=1COM4Ci4FsqeOtH)JGp63LZ?$+0U%h2TjpS6h-z(=wtUC_@B%*$P-uN7&~@xqu3B z5lDE)qTMkuO&WV3=@Y}Y+a4z~(ca=6yOA>656H;q0$%Jbyy^9cUh9z3kc1KV5wNxlDO zyd0~aEK*I4RG@~dw#Tcoff`In^L*MPrC^A9llSqn z8P8ulC(9*i8+Gq~u8*t3uTQF{4Q3ea7c8xht^R>A{K2vO2bDs73BtS5y@R7~P^Eud zzg}63!86Gckr4e=sDJX{_eT#MtKIm^_$%I*5_}&p|F{k(x`jb}eEP(8(ZCLqY)*Ls z_xVQX+Yn0M;HQvJzWW8IWeA^cLdtcK@_+okp0FQkKDM;^MX!gdMmdpR7v(2EWL`|+ zE?fUfki4_d?hm6@zho LHZc%ViTCm!GI4XD literal 1160 zcmV;31b6!%iwFP!000002IW}aZ`(EyRxH_$-L%cx?nm2gH8vF3Q?{mSkpbI)Vr!qa zmvjUACQuS3tCdBKq~f?w{r~nqH6tyOq9`({jkFsu8@9!}Pj}y)jz`kRzrHw}zL2W19lKg}K=96mJN#swgzu~73jS4ZECV+y26f+}+;R!~|18JOxK6t~v&e+QUjw5tB50kXb)Y>1<=cIv) zU*SK7C55;#5}di256_gPMt3E{sII~SL{QS-i&0T8N~;VMc~%-p*s+D(%juZVI%*>t zsGHk}jBzIxnd!-zFHfPg%TijZOrK9mWxz;%kL+H`>a0W*l9usESoXyIo;G&KI}wZ| z;R3}P{}CV73#rU-CpeaN9m``?*nq-QY6RsOX^@Y3#Hy2r(u{mZt@iRTA#_#z-;=;A zjCALs(Y1Or?rOu4goFZY(i^<-^f`ZNG+CNRzhzjOK#%SL-@cgmbLJ%%;I!KRdj zu5Xpqj?1dOvs`5H8o-#ZEaAHIm{!dKSBr~8_n#BbO6NJ5i{QXCw&AkZYl6L%?z|=9 zl3M5(Ra7g-Kp1@_)YoHFQjnJrhs!*nb0OYu#dDZvb1LMwS~)s_I4#gJJUvIZ61rUq zq5_6_BA2^nth>D4h*D-GB>8LEWxSyo>b&||oxo>v2$H7q=ww=L?WQ9wFio+k+`WinW|Zf3X3`^^?%dj8l@b-e19?KNOW z=qa=#bar3#5SEAK1nIth$l>z?!OiVHvg>Tt2UuOIZE{FpC6`Mj%ZgPc(|nS*XIWwjKyN`9)?YKC)*4ss^|U3 z1k+v*d4Ce0IY0OEiq;G^5`EO`C0i?YWvke7JZ;;CMbe#Q0jMe3;ClKp#ntOqV7UY~ zT40C~V7Hlxw5~Z4DfblD*R=$w0|39}YSuBH+nylC^)bLU zmA`8(Ykr#kH2tkca%T0Pk99S6I-S=BXwfA0YOr{XU~tx5%Sm06S{EA}cXBH`qB>yMVI z*yL=hPN5Uml%tH63RgAjFfB^P!DF86ppHqqf&>GFW z%2fXcX@Zf;G?_V3k0_|JSumuvAY!1U9w$^YCh;@0SOy^bH4FgQVqDxexs$f^F* zQiGvDvsM=bk~Er%h(pBEO>$Nx#d(y}5`7BaszS48bgx=Jeq3&J)jEsn>;hW-g_vKN z3xUA^Xs$ezcjxw0fY9DDG-MAy9pR#3j>sW!+_NsS3656i8|F_RcJIri%|jRoyrPw4 z)HL#Mq#W`a-M@LWWL34(dwM?j`~6Q8ECX)*Zy+lRV!N=is0Cmm6OwoLj{u zkEBKowvW$r^`5vi-(Nf^EB{*m4JD86$}8NwdL;Y!o;mxY>Alms^S86na^{Ucnw~su z^7Qn^P~M&30?z;b6D{5G50HeXb$1=i%`Gn1RyraFz>6om|6KYz`uy*U!RL#iiVJ`q z|LQCH|LO}V`EM3jexYd}=KouyO5qWIks!uI6_O-$n-A-0q-Nno=54(_34MBc9QIBsTDvDSH01Se?zCLh&A1%y zh44r(`Vzff)ZblE=YoR#%L#jOGP5?-R>fK&d*AN7WqN-Fc4BqJRJGqStRF{4p<88%6&= z;cl#9+QM1}SEhq~a%G9R9wW^u8hGI2VWHc@jjnxh)V5TZrVCt_z9x!`xbewv{!fYX zjTbJp2M%NJ1vJ~we_phu0&Wx#8dcP`P!_EFZP$ep6VO zSJBBQ(=Cb5t!Clc-;b;ol=^!~#Fhmn?t%-O6;Et}yD8%q`UZX8*m2jDZMl?DlrlRr;R|(L#i{u& zA&olGn(G@cQ0iA5HHko66m1a*Pdha=4VU2BjLgfa;T4rYdPB{OdTdbiAP0Yn8Sd z&NRQVSulVGp>o9+JyS8cYmj9I(Gc}u0Wvk!wWwWSqLQknN`35+WSp#pR|X=v->(7@ z?~9&&DxC=|tJpxW$ZK$Nc_Dteq54QOZ5SI1B%x;8Se}@%#wNKVm?{8QlmL-?4kpqG zb-A?-Kpvtg9-qkf`buhm|LORFOaF0H^x<#Mgn~B?=wMFjAEL^K%-?@?uo`x^QR6IG zJ?i|z&b@V4RbBfL?clRu*Au$DP;cSej_NmOO&4;u#G>l?4d4YP8FE_oAx_~e+?KrP z51n^jk6Ki-!j|0%BU>BVx{Rc1X5cV|9on=5Hpz#YlEbFK*E01!fkhbQWnpYweM|GD zA4;m97mvTk8fv8iT6ar+p1ABu|9#IY+FE->6CyA%?=0odqz}_t^<7V&>z1BBiV}Kf z<}kspT{Kl1+qZfKQtO&*0DgOZHQSA4R)h3g^RxcKU9xBxEWpIu(w?}kc;z(1C>ZA? z6Ew<)D^b!$vHWZv9O219hWpmsdf1wLo?hWr+&>+{?4-YU;?8>Oqh3|J3pX6L64a~q zCp&-YBg4lq2ACN`Yh+V_7NyM-ZW4TV?Qn)-*fi-1+ru9Y2J!|71ZTNe{MEzym~Unw zPBbo{e>ij7ODu3?Tgk4rX@XyrT?#7r`C0O%H3i?N-2=^Ba%eX+6OW9~?Ac>_ zUwS^e$`2k8GaC{{RK`@syopGUCNEYIrE&EeL>W@M)`m=3-T=X4v9dd@m1XQ&ZWg3c z=3ng^-)aJwo=B7#6a`NtRh8$1X;9BRPbCXlJmkEWYf`)z!Am%2?J}6)=+jXua1rZB{%+X>54RN$s z$tlZZC;JpIHIcL3Ez@J> z@CkI1lS6aVE0ROK*it`SQ#viSsVNmHP1w^^1wM(yr{I+jPG~lhmhmj#q@H zb@(5_DR*Z{e$B&1YHE{}(ri%$e$Z@QYIe% zj!P4F_oeZpF{NvVn>p;1*tWfoznK-`S_*V@y!5nJpOz=5B38gU^EH7u9_|vBZSee|6~k1^*x1 zp?>od&)eOqZx+3+)bMl`IQ{sNRqf;MaMkuo?l8HYKI7*am%J6$!_gupV*tR3xFn9r zje+FkCKBw0qN47(6cbEVm2|0V13cM5)ezuKt-Hof(?SmC~f(sOh{dbkN{oqPlLq2IJhGv zLfty~y>ut5?p3~>$Hf3MA`=kC9o9*0VCIHXl&QP$L+?7NICHolu1yfvDY!0fR!beJ zcCgs`m5`Hg8qFnI0uQcK}A>gfLk3|qd=$;lKP+vaOS!kVGn>-^tt42c-W z<9dpVgm`3!Bv*>&Td=SD(6eogkrLE3xs8OL?b`QORy6*)dhe_AuQP2?q`hDhGAO;l z;x=_N*i4iqk2%6GWV)1#NBdZ{bdHNGUn zHlBckTxxgL`sHqnFnrMc>Y~Y0LH12iy?5|D{h9Af(`Yo@v!vQ_A?*QUY`!2VFvjo> zeS&!^m&bGxPd*&<(ZldrNYD$AR(z`51_NNTKv2a&*tM@~I5p{09Q?zVp=R*O3+=R$ z&cOn{u?(K#ZLQ)E?G5DPKe?VtFv3A4UGbmao;Huv0g4=XsgB=4`@O z6Q!h@tefE`yh0MA<^r2L43yjhzfkX1gNjC?qm#4GpsdemyinC)x5iebJgRC)n;=rV z5PG|73u4a{j6QHI4OWow?+j<_Bn*2m9C?b%-PH1$i7yZekWUkC2H-C>AlrsISjpd34z9`u)HGQ8~g z0X5dBE66yd=Xq3cY*CoDt!aF{n9ObLOb~yy(>;Mz6VP$Sc3v90e$#JmbMLl5K(59s zh^frRl0cS7U`hRa!CcS-lA@nrUVz;?1K!nNqa^mr2)Mk}>K!WDhs|DvnULq?St-MH z`Kdo(>9zWt{u@v+Pp?=kr#)Y~j5U)7?0e)oQ<)WI)_?S>lAQOrIoa8lPT*SJz7C8R z*U|s}-7h+3`9mZ8$UEsgV#p8lrEzHno48o_?QiwE-?E091I07yrh32~2AD_Eii(N~ z-FH;62mG7@FqDeUs&-qINlr2%RnRj3S_3Td>k=+VM28Od1yA#1JRSp^Fdl7+8{1zC z-R+GSy z+k8=u$$~I@>p7#EL4CL+nrSc;&sVUuPYgqYBMmEDkGj*U;Gpj0faH}7QnAxI@vtQQd3MmFFJ$N#aA?Fk-rQ-?y-fPPo%+*f$ z8nT@DN7ts6fstB6=fVd!kI~iQQo8UE&b#;tAc(K=2czs;Yeq98gF}SiB*wC~j z)D$-tVhHTWk4aDtVq>xf?~a?k3lCfjv~_oKq^@#)Fb7rv*Zj$mw0X-mkdYN|LV%w+3obF28_=dVnhF~HD1bF_ITf)F_hIpjAm}H*rxHd zeI+c|xwk#nxMk*52r4$KQU*g) zEA-8#Tqk6`CpeG^t02;*xX3pb8zh=#?3Il~$|UrKlq%`$2E8BJtEKPc{x zSz|6!boVI{Lw2T)?f%r|tnux()-7(KPc_yF{fQi=kY*0(42P*`{Ia%{)WooCrLGre zgfh3Sz(CHq2zye;%iFM$z#?b%D+Y87vO!$=$_z>ld2V{z9#>fL?(dT34suAASqGZTEmMOn)NqRe{|T}^K_JiEdNeF~Y9aO7snqp_44M+U zxP)ZhmA9sNS^*7~50XX&^C0qKh{`Q>jna+|!0knw)wymCP zis{zSaQ^k?dm>z$9i`KMVLEl7gMjd%7F|OwuIw(3NtLJ9h7yAvh=NH_bx`8N#D~|f z+pj!dLby>7rO`UcR+8o+F=epCW!N2^>YEacYOIZ(aPf@0tb1#vo{5YorH8pW#m>BX z*zdfTm5MhmZ}o4_My0nq{LcqXJw0?Tn5X{u1O&lzaTCR0@ zx^LRk!p)4VngbQE%fDe5a?rH*HBc@pazI)4i(K|n;rb)bwMLn_!o^GVG_whxjTC>z zN>ADj-L)>Rbp}F)!?kzzLc89*FqmPSh10wijcXSj@0?QHaEt7Hzv!NQn^vOsfdP9Y zzOBr2kmVSZCWxy}2U|XUB&86Fhc<6_D(0*U{w2cjX*Oq6)$R>_d|1Y+p6WZ_wOAvS zNPf!V70WJ?Ez$)>Xh>#{5gM@q?x?L1SYC;8(zsWRS1Vj^Hktnr+itPDyL(7Ha;fQb zE@u)kF5gvmFcBSbwt-E>OBb0T{CiR>jy$i>jH>rV8MB0cz#*a>R$itz|Lnc@)yUj z-VqW_EfcG&=22-Tl}hYY5h3`5eL4@i7JtIa;9dN#2Pn&;K2hre<=wlvpD^q^z290$ z3^r?@H*dJ{?oL-*66jqdaNXVro$t-*J!NGEEVGc9iAQ?PK4WGKxvufGAH$u)>b+*& z6`X8XTWVB>h3+U2+|aYnd6v;@_?U!w5C_TUT}i?Yd?LVb3rhaVo$+!awE9IBsPJ#b z-`O&YCf)kOdLmACWz4M8+#9JIa_AzCy!0z7_P<3f1lO8_Bd-opYak&dU+iY7`*rdn zHBJYV0MJlR>I3cU%utyCYT{VDM(`R~48{W?nE=|l+K9UPsU-f0TeZmaU*W9_6JRp{ zml++w0`NN@9#8$$bLF7A-2jVqQBw?e;l;-v_2>lv2>M1v2x^2I9MaXG#Oz1F&G(yZF3`v{iOjyd{ zi&$Aga+p)fp^zdfo%^rf_5b~^|9w60bG`5Lx$n>Oy!ZQD_j^CL1tq`)ZSJn&qV@M7YVHe_u~3Gc8VPMH@%BhkUuz(J#;2n+c5f4CX6MOlI-hQ$G} zz4TtNEdGv@EY4S?ObjReUkbo3{AvII0CFZN$C9L#0U|jXwEx8tl~yH ztSxG5tLFn`>}v4AVP3{J6Z3=5>r)33$bC1 zm3Q~(P@H7`$OTNAW2|2HSMD+I{vP+k^g_kCMxU2seTQ@t(hHl3WB1N~P*<%q^gis| z=y<@f(($%Abn6iE4265{!&m3ZkJ_2W3z;UHceXUgjs@*HGEL=vOh?~PXy6?|XSMGeo@vl6`j=AG7Y^$A3*5`|7h1AW9w*dM1adB0s7W7AmSg|tK_|TUt;t~I z-%hv)%nl)rBJiYe0KmJ(K0@9OXx(bx?96>XLf*ltsYw)ZwBn2L8)Ay0!<7UYk?DGO z%<|-JaTQn3=v6IpQD8+;Alsq4yVjz_0A=sQA-QRC?2TVv1=S?)m)f1)k&U?2N?k9Z zK9pn{VCp`+A;Lk&=gNMpPZcZIIw?uPz1=E(h=uyT?L71iloqHLeM1&<26Q^E$_4Wh~}RRcjH)85cBsQuBd9T!bxmw(CHxBp~it{gF~p;&_T6C5cV2d@9r0srX6uS~aHblD)_B21=%an3g%{WKmQF=i4TWz3CK zom~1cTe{Wp(<6MV?YsRI)UM{}^~$ODQam!|y7{5YN=$7-+l%^bb03;c3%uo6M__m) zgA{z}TLc4-3knj+A+Hs}PQI+nkvzXU%|_AsJ;jm*04x7kJG$ zv7`Z{26FCNwb6vzglHjT`PFCE=gTZt?5X6V+iM;?Az$Q+yZyTINl7M&Mz1O=mIE zsZFk1uJurkmKrEXxV5z0TZb?CapO%C zJ7<%9xD?GxlPlOhidf#OxiypIxGopf8iv{qgF(B312-M8BWG^UpAE*=Ta>8pHQ{)j z*`Y|>XOPn8vwk`{rWldwBq}YdG(~d>OGtRhJC2H znR;DZ%4ET?ui{|w>NTP32zAGI~ijB0d z56NsDFV)VWS$>i{>JdcoVfsC6vymC;+I$gUA+Is9tYBw6nWneZ*b^~VG=E#8RbQeo zSl3?x7XOwtyDW2vl-eHma10kR?qyxd$FF-!2X%S*5k{g*hGg0&3bl_&T_Y4{eybBd zHJBMEAAZp_al|I7BmfGOJ+1ahrEuV&PN+5^z-vx#k#o3>@;u+Y6Z3u$?a}D%rFl01 zU*rfw9gL_W%HuyK0<8d-m*Jw8wvfyLH6R!!vGclx*ef&`2^q0~9nWR~L^gT>y;3j> z2{odv4>0RS%p5LR#88bhjD|v20w>;m{u+BUlzoTq)DZbjGm2G{Rz3diyy@YY}3d%H+m@3a60{5I<+%LTd~`y z?%{$#Cjp*6iVJoHob|t_C#R>eg5vAS*BB;G;hQzqy5PO9)x~uZo$}qm4q#L+W4zgm zzkQ*tt*zs2tm#9_D0}6_?ovL1%4JGSD=U*)!*T+}0!Xy(+lEMiMwbdKL`8PmHcO+I z37`tc%c#gHe51w)iN%Bn#C%AphBD+-q@kgqbZUk4OW^G?9~A&yjVjGD1PBZn)O0G= z65hzoIYY{z3Fyf{jbWZZh-mP-0?R_EjTvHrjg1+GDP18{>9P<-UJo4JEaroMpvU@R zGf*ExATxD?=SZ08(%849GaRk$si_SA$jJO&8VD)(6v7N+^wSc8L~YHHe1ifY9cg6} zf}^&I!0@^qqEWTMj=Rj=p^c*yj$3k+6`hAT6yGm1*mNKtvt&Z$+A{3$$W#({ntCVJ z_8tKrZhD(fI`6O2nC%~wUcGw|vE5!WMwJ`PpychX_vF?z3nPTN3CbJ7hd^xrqz09E zast6VDzVL+NM5BUpN;7lgQDZeSvf6@GUIG)iD8`}4-5yZ!Eiu!mk9TjJ^U^xeaN0n#Q=d;D^nYDM=K2+famTv^RFoAN57UjGa~`yx;|C zx#yJeM>v4A=vv_ud45FoXYZ-^3IQn&U>)+QsKPv(=}^X;tghAxp|kI6k)exEIWx8v zmRVsdA8!^rDZZfL*W*ulL!o3J_erZd3x$0CjuEGHx$LD5zK((5Wr|F&?#L`2ABTjW+A8Gg>V zWOlpsKwfkG&+~NVrW-L)TIlH*_f8FKBCBbS>PNwJ!DdSf?^!h0m-4P+*0b@vhm%5D zFEaDIX=U?bIVSIrY|Yv--`LMbjUHR{Zk=x0_MpV<)=SSgWSE&}IgG55)Psw&RTF zHCep_R%s`e9Pi{N11yqFHG}579V^}a5*1LRRrMa3J>>*$xVB#Mn*&)NGbv#c%Bc0T z?3>5pFZOP#EaXojjpgSHBXu^b*rcfCr}*|mr9ie0gCk+eGO!!r`F+yPuTb2$uILCo zp~Qd1i-fEBvr27yN5JFvz!opJaq0|0DnqxEzGNa@QxfOOk*k`W^z@^6Vop`z4J^96 zcf}8qpR-RnBc~{K&;ugvJqu;D8Kq^S{-f7DmMXID0f`Z^niLn8AoWFUytDf-ZEcrTD`-dG8>8?7<6fiCXo zBORD_x2X)}e5fUr4nV8ivyJ z`MBvL$_kk;IpuO1!z9=&)W zs(bQP^DtZDf|(|FQ=f9wv#!}Ix0>UGH7fEI(U%$%iB28uFF5_4Ki*L*{%-g6=dCAP zmBYhtx_%sWLb)#Zves@!>euY@`-a8#%^wWb?14kRu9;r2BHH*aQGceTMN&f4TFSn? z_kRdN)KVHV!zLaNAV~nFaQ-gI7VaLMn&^?pXUuSF`RHK@p?htqf+!1-)&g3xUW9Z* zx%FFv{dV7^L**66zqx!!RKyM!3_rR4+HeGYfRPB?ue863o{-k4T{)w?csyt{cI9m4 z{v%#p%TFHY*Lgr_H(M4~4dSf#`&zvn^i+~me_7ZH{QBtN@e<~<$aUUWI`N;HwlvTd zC?r7aK?*N-yI`*mUYTism!9f%;rs01_;&?c@P5_7{>rjRC_f=Tm03{PDZ8_Vw4^Zs&)3~W(#Aef#TGck-UmjN$lI|JM_x~- zH*r9k_rL)(rPW)EZ--QdW(nnb}GNreQc?5sa7v#x4&vLO}s z+bY#w!!DgxZg_nlxNYgjrfwuUZ%Be1ut1WC`B3K3A#&IC(o_G6?6Hyf#7YGw2zt;_ zsq57*w0SXs$DcmW{bLTOvjz0dT)3b zv%D{*$V-?OhH&kZBGV2z2Z}c)*2gGAA=at0HH8bSAMIo$(`=**75OB?u8`rlvyd>q zoM`_~vf%#5jMb)0^W_Yw-t4V4c?l70dI-;FL?Ij&h>Yv%^4J^NsjlL2WLO4d@|j@L zS=b=AT9n9FORP#l4`)Zq<^{u_o$|Uz2AbI#gTAQi+#_S;PzjAWv?`=qU?egi_&I5e)EH36DSr^53I*{3W)$7$g zD9|}IEa9LWZd!$!*>`id%^ewkW$)}Zgl$L&31*AzP6Fn{iB8FnTysxfxE+K+$QOoF z;WY|RLkhXM)scH#6%EnpAw{+$b@GT&0m@xz{qj)!=2E+4=&63*Rox5oGST2NnS$pc z6=E%why_Ws;;XVY7|iKAoZ?KDQ`JJB_$i% z<-gY~j+pJX8JIpl|Mb@Li+f^o&z7opH~k7*ze!9_VIPX0G@DMgIG>0Wb>CtsnK3V&2D_=q^X^7Y#{GTF*%D8~U% zob!>!xW64pVOv+P2#hB*&^|FsSpXUxbj6MV z=pSP_dkrx2tAI|QWCwCPjlYloCojfB#4u#0{GY-ifb{pkm@t4y^(jk?YekEIn(t3T zi+O$u=10tgvKaPbfexr4`?hlUEJPoG!6aeyq-atD!vjNV&ceb9ao`Cv=RQ9*Ox)$9 zr&5gngL40>_Ke>R{Hm(Tq0TQ)brOz_3u=Q;84eD18qU~9s?W~2wwa2K1Eed^Ukfg7 zypr&nkFl%Vz2_U?^lFt*lmMbZYt>hmo<|5LOSZClqW|b#Rh1$@1Pzr{qKQDEyTu;s z(3Sb z*kf7_FT5rDy681CZ+7n7;kBnl8hy@FcQdO}Ilrf>3kyFx-n% - rtf_read_png() %>% # read PNG files from the file path - rtf_title("title", "subtitle") %>% # add title or subtitle - rtf_footnote("footnote") %>% # add footnote - rtf_source("[datasource: mk0999]") %>% # add data source - rtf_figure() %>% # default seting of page and figure - rtf_encode(type = "figure") %>% # encode rtf as figure - write_rtf(file = "rtf/fig-simple.rtf") # write RTF to a file +filename %>% + rtf_read_png() %>% # read PNG files from the file path + rtf_title("title", "subtitle") %>% # add title or subtitle + rtf_footnote("footnote") %>% # add footnote + rtf_source("[datasource: mk0999]") %>% # add data source + rtf_figure() %>% # default seting of page and figure + rtf_encode(type = "figure") %>% # encode rtf as figure + write_rtf(file = "rtf/fig-simple.rtf") # write RTF to a file ``` In `rtf_figure`, the features of page and figure can be set up: @@ -52,18 +52,20 @@ In `rtf_figure`, the features of page and figure can be set up: The figure height and width can be set up for each figure in a vector. The code below provides an example for these features. ```{r, eval = FALSE} -filename %>% - rtf_read_png() %>% # read PNG files from the file path - rtf_title("title", "subtitle") %>% # add title or subtitle - rtf_footnote("footnote") %>% # add footnote - rtf_source("[datasource: mk0999]") %>% # add data source - rtf_figure(page_height = 8.5, # page height - page_width = 11, # page width - orientation = "landscape", # page direction - doctype = "narrow", # set page margin as narrow i.e. 0.5 inch at each side - fig_height = 5, # set figure height - fig_width = c(6,7,8) ) %>% # set figure width individually. - rtf_encode(type = "figure") %>% # encode rtf as figure - write_rtf(file = "rtf/fig-landscape.rtf") # write RTF to a file +filename %>% + rtf_read_png() %>% # read PNG files from the file path + rtf_title("title", "subtitle") %>% # add title or subtitle + rtf_footnote("footnote") %>% # add footnote + rtf_source("[datasource: mk0999]") %>% # add data source + rtf_figure( + page_height = 8.5, # page height + page_width = 11, # page width + orientation = "landscape", # page direction + doctype = "narrow", # set page margin as narrow i.e. 0.5 inch at each side + fig_height = 5, # set figure height + fig_width = c(6, 7, 8) + ) %>% # set figure width individually. + rtf_encode(type = "figure") %>% # encode rtf as figure + write_rtf(file = "rtf/fig-landscape.rtf") # write RTF to a file ``` diff --git a/vignettes/example-pipeline.Rmd b/vignettes/example-pipeline.Rmd new file mode 100644 index 00000000..7f6e6fdc --- /dev/null +++ b/vignettes/example-pipeline.Rmd @@ -0,0 +1,576 @@ +--- +title: "RTF Examples for Tables" +output: rmarkdown::html_vignette +vignette: > + %\VignetteIndexEntry{example-table} + %\VignetteEngine{knitr::rmarkdown} + %\VignetteEncoding{UTF-8} +--- + +```{r setup, include=FALSE} +knitr::opts_chunk$set(echo = TRUE) +devtools::load_all() # need to be updated after the package mature + +library(tidyverse) +library(emmeans) +library(stringr) +``` + +Define some utility functions +```{r} +#' Format Model Estimator +#' +#' The function assume 1 or 2 column. +#' If there is only 1 column, only represent mean +#' If there are 2 column, represent mean (sd) or mean(se) +#' Decimals will understand the number will be formated as x.x(x.xx) +#' @noRd +fmt_est <- function(data, columns = c("mean", "sd"), decimals = c(1, 2)) { + .mean <- formatC(data[[columns[[1]]]], digits = decimals[1], format = "f", flag = "0") + if (length(columns) > 1) { + .sd <- formatC(data[[columns[[2]]]], digits = decimals[2], format = "f", flag = "0") + paste0(.mean, " (", .sd, ")") + } else { + .mean + } +} + +#' Format Confidence Interval +#' @noRd +fmt_ci <- function(data, columns = c("lower.CL", "upper.CL"), decimals = 2) { + .lower <- formatC(data[[columns[[1]]]], digits = decimals, format = "f", flag = "0") + .upper <- formatC(data[[columns[[2]]]], digits = decimals, format = "f", flag = "0") + paste0("(", .lower, ", ", .upper, ")") +} + +#' Format P-Value +#' @noRd +fmt_pval <- function(data, columns = "p.value", decimals = 3) { + scale <- 10^(-1 * decimals) + p_scale <- paste0("<", scale) + if_else(data[[columns[[1]]]] < scale, p_scale, + formatC(data[[columns[[1]]]], digits = decimals, format = "f", flag = "0") + ) +} +``` + +# Examples +## Example 1: ANCOVA analysis for HOMA data + + +* The data is available at [https://missingdata.lshtm.ac.uk/dia-working-group/example-data-sets/](https://missingdata.lshtm.ac.uk/dia-working-group/example-data-sets/) + +* For example, we want to summary the analysis results using ANCOVA model + +```{r} +data("HAMD17") +ana_week <- 8 # Analysis Week + +HAMD17_lmfit <- HAMD17 %>% + filter(week == ana_week) %>% + lm(change ~ basval + TRT, data = .) +``` + +### Raw summary +```{r} +t11 <- HAMD17 %>% + filter(week == ana_week) %>% + group_by(TRT) %>% + summarise( + N = n(), + mean_bl = mean(basval), + sd_bl = sd(basval), + mean = mean(change), + sd = sd(change) + ) +``` + +### LS mean +```{r} +t12 <- emmeans(HAMD17_lmfit, "TRT") +t1 <- merge(t11, t12) %>% + mutate(emmean_sd = SE * sqrt(df)) %>% + mutate( + Trt = c("Study Drug", "Placebo"), + N1 = N, + Mean1 = fmt_est(., c("mean_bl", "sd_bl")), + N2 = N, + Mean2 = fmt_est(., c("mean", "sd")), + N3 = N, + Mean3 = fmt_est(., c("emmean", "emmean_sd")), + CI = paste(fmt_est(., "emmean"), fmt_ci(., c("lower.CL", "upper.CL"))) + ) %>% + select(Trt:CI) +``` + +### Treatment Comparison +```{r} +t2 <- data.frame(pairs(t12)) + +t2 <- t2 %>% + mutate( + lower = estimate - 1.96 * SE, + upper = estimate + 1.96 * SE + ) %>% + mutate( + comp = "Study Drug vs. Placebo", + mean = paste(fmt_est(., "estimate"), fmt_ci(., c("lower", "upper"))), + p = fmt_pval(., "p.value") + ) %>% + select(comp:p) +``` + +### RMSE +```{r} +t3 <- data.frame(rmse = paste0( + "Root Mean Squared Error of Change = ", + formatC(sd(HAMD17_lmfit$residuals), digits = 2, format = "f", flag = "0") +)) +``` + +The purpose of this exercise is to create a table as in `rtf_example1.rtf` by using the three datasets `t1`, `t2` and `t3` + +```{r} +t1 +``` + +```{r} +t2 +``` + +```{r} +t3 +``` + + +For multiple tables like the efficacy example, we have a flow in the following to print an rtf table +```{r} + +tbl_1 <- t1 %>% + rtf_title( + title = "ANCOVA of Change from Baseline at Week 8", + subtitle = c( + "Missing Data Approach", + "Analysis Population" + ) + ) %>% + rtf_colheader( + colheader = " | Baseline | Week 20 | Change from Baseline", + col_rel_width = c(3, 4, 4, 9), + first_row = TRUE + ) %>% + rtf_colheader(colheader = "Treatment | N | Mean (SD) | N | Mean (SD) | N | Mean (SD) | LS Mean (95% CI)\\dagger") %>% + rtf_body( + col_rel_width = c(3, 1, 3, 1, 3, 1, 3, 5), + text_justification = c("l", rep("c", 7)), + last_row = FALSE + ) %>% + rtf_footnote( + footnote = "\\daggerBased on an ANCOVA model.\n ANCOVA = Analysis of Covariance, CI = Confidence Interval, LS = Least Squares, SD = Standard Deviation", + justification = "l" + ) + + +tbl_2 <- t2 %>% + rtf_colheader( + colheader = "Pairwise Comparison | Difference in LS Mean (95% CI)\\dagger | p-Value", + text_justification = c("l", "c", "c") + ) %>% + rtf_body( + col_rel_width = c(8, 7, 5), + text_justification = c("l", "c", "c"), + last_row = FALSE + ) + + +tbl_3 <- t3 %>% + rtf_body( + colheader = FALSE, + col_rel_width = c(1), + text_justification = "l" + ) %>% + rtf_source( + source = "Source: [study999: adam-adeff]", + justification = "l" + ) + + +tbl <- list(tbl_1, tbl_2, tbl_3) + +tbl %>% + rtf_encode() %>% + write_rtf("rtf/efficacy_example.rtf") +``` + + +## Example 2: a simplified adverse events summary table + + +# get raw summary +```{r} +# Step 1: Get raw summary +data(adae) +ae_t1 <- adae %>% + group_by(TRTP) %>% + mutate(n_subj = n_distinct(SUBJID)) %>% + group_by(TRTP, AEDECOD) %>% + summarise( + n_ae = n_distinct(SUBJID), + pct = round(n_ae / unique(n_subj) * 100, 2) + ) %>% + dplyr::filter(n_ae > 4) %>% # only show AE terms with at least 10 subjects in one treatment group. + gather(key = "var", value = "value", n_ae, pct) %>% + unite(temp, TRTP, var) %>% + spread(temp, value, fill = 0) +ae_t1 +``` + +# write to an rtf table +```{r} +ae_tbl <- ae_t1 %>% + rtf_title( + "Analysis of Subjects With Specific Adverse Events", + c( + "(Incidence > 10 Subjects in One or More Treatment Groups)", + "ASaT" + ) + ) %>% + rtf_colheader(" | Placebo | Drug High Dose | Drug Low Dose", + col_rel_width = c(4, rep(2, 3)), + first_row = TRUE + ) %>% + rtf_colheader(" | n | (%) | n | (%) | n | (%)", + border_top = c("", rep("single", 6)), + border_left = c("single", rep(c("single", ""), 3)) + ) %>% + rtf_body( + col_rel_width = c(4, rep(1, 6)), + text_justification = c("l", rep("c", 6)), + border_left = c("single", rep(c("single", ""), 3)) + ) %>% + rtf_footnote(c("\\daggerThis is footnote 1", "This is footnote 2"), + justification = "l" + ) %>% + rtf_source("Source: xxx", + justification = "l" + ) + + +ae_tbl %>% + rtf_encode() %>% + write_rtf("rtf/ae_example.rtf") +``` + +# Example 3: adverse events example page_by option + +# write to an rtf table +```{r} +ae_tbl <- ae_t1 %>% + rtf_title( + "Analysis of Subjects With Specific Adverse Events", + c( + "(Incidence > 10 Subjects in One or More Treatment Groups)", + "ASaT" + ) + ) %>% + rtf_colheader(" | Placebo | Drug High Dose | Drug Low Dose", + col_rel_width = c(4, rep(2, 3)), + first_row = TRUE + ) %>% + rtf_colheader(" | n | (%) | n | (%) | n | (%)", + border_top = c("", rep("single", 6)), + border_left = c("single", rep(c("single", ""), 3)) + ) %>% + rtf_body( + col_rel_width = c(4, rep(1, 6)), + text_justification = c("l", rep("c", 6)), + border_left = c("single", rep(c("single", ""), 3)), + page_num = 10 + ) %>% + rtf_footnote("This is a footnote") %>% + rtf_source("Source: xxx") + + +ae_tbl %>% + rtf_encode() %>% + write_rtf("rtf/ae_example_page_num_10.rtf") +``` + + +# Example 4: group_by feature + +```{r} +data(iris) + +iris <- cbind(iris, new_cat = rep(c("A", "B", "C", "D", "E"), 30)) + +iris_tbl <- iris %>% + rtf_title("IRIS DATA") %>% + rtf_colheader("Sepal Length | Sepal Width | Petal Length | PetalWidth", + first_row = TRUE + ) %>% + rtf_body( + page_by = c("Species", "new_cat"), + new_page = TRUE, + page_num = 30 + ) %>% + rtf_footnote("This is a footnote") %>% + rtf_source("Source: xxx") + +iris_tbl %>% + rtf_encode() %>% + write_rtf("rtf/iris_example.rtf") +``` + +## Example 5: A very simple example +```{r} +data(iris) + +iris_tbl <- iris[1:20, ] %>% rtf_body() + +iris_tbl %>% + rtf_encode() %>% + write_rtf("rtf/iris_very_simple.rtf") +``` + +## Example 6: A simple example +```{r} +data(iris) + +iris_tbl <- iris[1:20, ] %>% + rtf_title("IRIS DATA") %>% + rtf_colheader("Sepal Length | Sepal Width | Petal Length | PetalWidth | Species", + first_row = TRUE + ) %>% + rtf_body() %>% + rtf_footnote("This is a footnote") %>% + rtf_source("Source: xxx") + +iris_tbl %>% + rtf_encode() %>% + write_rtf("rtf/iris_simple.rtf") +``` + +## Example 7: baseline characteristics example feature +```{r} +bs_count <- function(data, grp, var, + var_label = var, + decimal = 1, + total = TRUE) { + data <- data %>% rename(grp = !!grp, var = !!var) + coding <- levels(factor(data$grp)) + data <- data %>% mutate(grp = as.numeric(factor(grp))) + + # res <- data %>% count(grp, var, .drop = FALSE) + res <- with(data, table(var, grp)) %>% + as.data.frame() %>% + mutate(grp = as.numeric(grp)) + + if (total) { + res_tot <- with(data, table(var)) %>% + as.data.frame() %>% + mutate(grp = 9999) + res <- bind_rows(res, res_tot) + } + + res <- res %>% rename(n = Freq) + + res <- res %>% mutate(pct = formatC(n / sum(n) * 100, digits = decimal, format = "f", flag = "0")) + + res <- res %>% + gather("key", "value", n, pct) %>% + unite(keys, grp, key) %>% + spread(keys, value) %>% + mutate(var_label = var_label) %>% + mutate(var = as.character(var)) + + names(res) <- gsub("_n", "", names(res), fixed = TRUE) + attr(res, "coding") <- coding + + res +} + +bs_continous <- function(data, grp, var, + var_label = var, + decimal = 1, + total = TRUE, + blank_row = FALSE) { + data <- data %>% rename(grp = !!grp, var = !!var) + coding <- levels(factor(data$grp)) + data <- data %>% mutate(grp = as.numeric(factor(grp))) + + res <- data %>% + select(grp, var) %>% + na.omit() %>% + group_by(grp) %>% + summarise( + `Subjects with data` = n(), + Mean = formatC(mean(var), digits = decimal, format = "f", flag = "0"), + SD = formatC(sd(var), digits = decimal, format = "f", flag = "0"), + Median = formatC(median(var), digits = decimal, format = "f", flag = "0"), + Range = paste(range(var), collapse = " to ") + ) + + if (total) { + res_tot <- data %>% + select(grp, var) %>% + na.omit() %>% + summarise( + `Subjects with data` = n(), + Mean = formatC(mean(var), digits = decimal, format = "f", flag = "0"), + SD = formatC(sd(var), digits = decimal, format = "f", flag = "0"), + Median = formatC(median(var), digits = decimal, format = "f", flag = "0"), + Range = paste(range(var), collapse = " to ") + ) %>% + mutate(grp = 9999) + res <- bind_rows(res, res_tot) + } + + + res <- res %>% + gather("key", "value", -grp) %>% + mutate(key = factor(key, levels = c("Subjects with data", "Mean", "SD", "Median", "Range"))) %>% + spread(grp, value) %>% + mutate(var_label = var_label) %>% + mutate(key = as.character(key)) %>% + rename(var = key) + + if (blank_row) { + res <- bind_rows(tibble(var_label = var_label), res) + } + + res +} + +# The code above define two utility function for baseline characterstic tables. + + + +# Analaysis Set +data(adsl) +ana <- adsl %>% subset(ITT == "Y") +ana <- ana %>% mutate( + RACE = factor( + RACE, + toupper(c( + "African Descent (Negro, Black)", "Caucasian", "Hispanic (Mexican - American, Mexico, Central And South America)", + "Other (Mixed - Racial Heritage, American Indian, Eskimo)" + )), + c("Black", "Caucasian", "Hispanic", "Other") + ), + SEX = factor(SEX, c("F", "M"), c("Female", "Male")) +) + +# Build Data for r2rtf +bs_tb <- bind_rows( + bs_count(ana, "TRTPN", "SEX", "Gender"), + bs_count(ana, "TRTPN", "AGEGRP", "Age (Years)"), + bs_continous(ana, "TRTPN", "AGE", "Age (Years)", blank_row = TRUE), + bs_count(ana, "TRTPN", "RACE", "Race") +) + +bs_tb[is.na(bs_tb)] <- "" +``` + + +```{r} +bs_rtf <- bs_tb %>% + rtf_title("Demographic and Anthropometric Characteristics", "ITT Subjects") %>% + rtf_colheader(" | Placebo | Drug Low Dose | Drug High Dose | Total | label", + col_rel_width = c(3, rep(2, 4), 3), + page_width = 9.5, + first_row = TRUE + ) %>% + rtf_colheader(" | n | (%) | n | (%) | n | (%) | n | (%) | label", + page_width = 9.5, + border_top = c("", rep("single", 9)), + border_left = c("single", rep(c("single", ""), 4), "single") + ) %>% + rtf_body( + page_width = 9.5, + col_rel_width = c(3, rep(c(1.2, 0.8), 4), 3), + text_justification = c("l", rep("d", 8), "c"), + border_left = c("single", rep(c("single", ""), 4), "single") + ) %>% + rtf_footnote("This is a footnote") %>% + rtf_source("Source: xxx") + + +# Output + +bs_rtf %>% + rtf_encode() %>% + write_rtf("rtf/bs_example.rtf") +``` + + +## Example 8: baseline characteristics example page_by feature + +```{r} +## r2rtf rtf table createion pipeline +bs_rtf <- bs_tb %>% + rtf_title("Demographic and Anthropometric Characteristics", "ITT Subjects") %>% + rtf_colheader(" | Placebo | Drug Low Dose | Drug High Dose | Total", + col_rel_width = c(3, rep(2, 4)), + first_row = TRUE + ) %>% + rtf_colheader(" | n | (%) | n | (%) | n | (%) | n | (%)", + border_top = c("", rep("single", 8)), + border_left = c("single", rep(c("single", ""), 4)) + ) %>% + rtf_body( + page_by = "var_label", # this option show the label in one row. + col_rel_width = c(3, rep(c(1.2, 0.8), 4)), + text_justification = c("l", rep("d", 8)), + border_left = c("single", rep(c("single", ""), 4)) + ) %>% + rtf_footnote("This is a footnote") %>% + rtf_source("Source: xxx") + + +# Output + +bs_rtf %>% + rtf_encode() %>% + write_rtf("rtf/bs_pageby_example.rtf") +``` + + + +## Example 9: baseline characteristics example page_by and new_page feature +```{r} +## r2rtf rtf table createion pipeline +bs_rtf <- bs_tb %>% + rtf_title("Demographic and Anthropometric Characteristics", "ITT Subjects") %>% + rtf_colheader(" | Placebo | Drug Low Dose | Drug High Dose | Total", + col_rel_width = c(3, rep(2, 4)), + first_row = TRUE + ) %>% + rtf_colheader(" | n | (%) | n | (%) | n | (%) | n | (%)", + border_top = c("", rep("single", 8)), + border_left = c("single", rep(c("single", ""), 4)) + ) %>% + rtf_body( + page_by = "var_label", # this option show the label in one row. + new_page = TRUE, + col_rel_width = c(3, rep(c(1.2, 0.8), 4)), + text_justification = c("l", rep("d", 8)), + border_left = c("single", rep(c("single", ""), 4)) + ) %>% + rtf_footnote("This is a footnote", + justification = "l" + ) %>% + rtf_source("Source: xxx", + justification = "l" + ) + + +# Output + +bs_rtf %>% + rtf_encode() %>% + write_rtf("rtf/bs_pageby_newpage_example.rtf") +``` + + + diff --git a/vignettes/example_pipeline.Rmd b/vignettes/example_pipeline.Rmd deleted file mode 100644 index 58c946b3..00000000 --- a/vignettes/example_pipeline.Rmd +++ /dev/null @@ -1,505 +0,0 @@ ---- -title: "RTF Examples for Tables" -output: rmarkdown::html_vignette -vignette: > - %\VignetteIndexEntry{example-table} - %\VignetteEngine{knitr::rmarkdown} - %\VignetteEncoding{UTF-8} ---- - -```{r setup, include=FALSE} -knitr::opts_chunk$set(echo = TRUE) -devtools::load_all() # need to be updated after the package mature - -library(tidyverse) -library(emmeans) -library(stringr) - -``` - -Define some utility functions -```{r} -#' Format Model Estimator -#' -#' The function assume 1 or 2 column. -#' If there is only 1 column, only represent mean -#' If there are 2 column, represent mean (sd) or mean(se) -#' Decimals will understand the number will be formated as x.x(x.xx) -#' @noRd -fmt_est <- function(data, columns = c("mean", "sd"), decimals = c(1,2)){ - .mean = formatC(data[[columns[[1]]]], digits = decimals[1], format = "f", flag = "0") - if(length(columns) > 1){ - .sd = formatC(data[[columns[[2]]]], digits = decimals[2], format = "f", flag = "0") - paste0(.mean, " (", .sd, ")") - }else{ - .mean - } - -} - -#' Format Confidence Interval -#' @noRd -fmt_ci <- function(data, columns = c("lower.CL", "upper.CL"), decimals = 2){ - .lower = formatC(data[[columns[[1]]]], digits = decimals, format = "f", flag = "0") - .upper = formatC(data[[columns[[2]]]], digits = decimals, format = "f", flag = "0") - paste0("(", .lower, ", " , .upper, ")") -} - -#' Format P-Value -#' @noRd -fmt_pval <- function(data, columns = "p.value", decimals = 3){ - scale <- 10 ^ (-1 * decimals) - p_scale <- paste0("<",scale) - if_else(data[[columns[[1]]]] < scale, p_scale, - formatC(data[[columns[[1]]]], digits = decimals, format = "f", flag = "0") ) -} -``` - -# Examples -## Example 1: ANCOVA analysis for HOMA data - - -* The data is avaliable at [https://missingdata.lshtm.ac.uk/dia-working-group/example-data-sets/](https://missingdata.lshtm.ac.uk/dia-working-group/example-data-sets/) - -* For example, we want to summary the analysis results using ANCOVA model - -```{r} -data("HAMD17") -ana_week = 8 # Analysis Week - -HAMD17_lmfit <- HAMD17 %>% filter(week == ana_week) %>% - lm(change ~ basval + TRT, data = .) - -``` - -### Raw summary -```{r} -t11 <- HAMD17 %>% filter(week == ana_week) %>% - group_by(TRT) %>% - summarise( N = n(), - mean_bl = mean(basval), - sd_bl = sd(basval), - mean = mean(change), - sd = sd(change)) -``` - -### LS mean -```{r} -t12 <- emmeans(HAMD17_lmfit, "TRT") -t1 <- merge(t11, t12) %>% - mutate(emmean_sd = SE * sqrt(df)) %>% - mutate( Trt = c("Study Drug", "Placebo"), - N1 = N, - Mean1 = fmt_est(., c("mean_bl", "sd_bl") ), - N2 = N, - Mean2 = fmt_est(., c("mean", "sd")), - N3 = N, - Mean3 = fmt_est(., c("emmean", "emmean_sd")), - CI = paste(fmt_est(., "emmean"), fmt_ci(., c("lower.CL", "upper.CL"))) - ) %>% - select(Trt:CI) -``` - -### Treatment Comparision -```{r} -t2 <- data.frame(pairs(t12)) - -t2 <- t2 %>% mutate( - lower = estimate - 1.96 * SE, - upper = estimate + 1.96 * SE) %>% - mutate( - comp = "Study Drug vs. Placebo", - mean = paste(fmt_est(., "estimate"), fmt_ci(., c("lower", "upper"))), - p = fmt_pval(., "p.value") - ) %>% - select(comp:p) - -``` - -### RMSE -```{r} -t3 <- data.frame(rmse = paste0("Root Mean Squared Error of Change = ", - formatC(sd(HAMD17_lmfit$residuals), digits = 2, format = "f", flag = "0"))) -``` - -The prupose of this exercise is to create a table as in `rtf_example1.rtf` by using the three datasets `t1`, `t2` and `t3` - -```{r} -t1 -``` - -```{r} -t2 -``` - -```{r} -t3 -``` - - -For multiple tables like the efficacy example, we have a flow in the following to print an rtf table -```{r} - -tbl_1 <- t1 %>% - rtf_title(title = "ANCOVA of Change from Baseline at Week 8", - subtitle = c("Missing Data Approach", - "Analysis Population")) %>% - rtf_colheader(colheader = " | Baseline | Week 20 | Change from Baseline", - col_rel_width = c(3, 4, 4, 9), - first_row = TRUE) %>% - rtf_colheader(colheader = "Treatment | N | Mean (SD) | N | Mean (SD) | N | Mean (SD) | LS Mean (95% CI)\\dagger") %>% - rtf_body(col_rel_width = c(3,1,3,1,3,1,3,5), - text_justification = c("l",rep("c",7)), - last_row = FALSE) %>% - rtf_footnote(footnote = "\\daggerBased on an ANCOVA model.\n ANCOVA = Analysis of Covariance, CI = Confidence Interval, LS = Least Squares, SD = Standard Deviation", - justification = "l") - - -tbl_2 <- t2 %>% - rtf_colheader(colheader = "Pairwise Comparison | Difference in LS Mean (95% CI)\\dagger | p-Value", - text_justification = c("l","c","c")) %>% - rtf_body(col_rel_width = c(8,7,5), - text_justification = c("l","c","c"), - last_row = FALSE) - - -tbl_3 <- t3 %>% - rtf_body(colheader = FALSE, - col_rel_width = c(1), - text_justification = "l") %>% - rtf_source(source = "Source: [study999: adam-adeff]", - justification = "l") - - -tbl <- list(tbl_1, tbl_2, tbl_3) - -tbl %>% rtf_encode() %>% write_rtf("rtf/efficacy_example.rtf") - -``` - - -## Example 2: a simplified adverse events summary table - - -# get raw summary -```{r} -# Step 1: Get raw summary -data(adae) -ae_t1 <- adae %>% - group_by(TRTP) %>% - mutate(n_subj = n_distinct(SUBJID)) %>% - group_by(TRTP, AEDECOD) %>% - summarise(n_ae = n_distinct(SUBJID), - pct = round(n_ae/unique(n_subj) * 100, 2) ) %>% - dplyr::filter(n_ae > 4) %>% # only show AE terms with at least 10 subjects in one treatment group. - gather( key = "var", value = "value", n_ae, pct) %>% - unite(temp, TRTP, var) %>% - spread( temp, value, fill = 0) -ae_t1 -``` - -# write to an rtf table -```{r} -ae_tbl <- ae_t1 %>% - rtf_title( "Analysis of Subjects With Specific Adverse Events", - c("(Incidence > 10 Subjects in One or More Treatment Groups)", - "ASaT") ) %>% - rtf_colheader(" | Placebo | Drug High Dose | Drug Low Dose", - col_rel_width = c(4, rep(2,3)), - first_row = TRUE) %>% - rtf_colheader(" | n | (%) | n | (%) | n | (%)", - border_top = c("", rep("single", 6)), - border_left = c("single", rep(c("single",""), 3))) %>% - rtf_body(col_rel_width = c(4, rep(1,6)) , - text_justification = c("l", rep("c",6)), - border_left = c("single", rep(c("single",""), 3) )) %>% - rtf_footnote(c("\\daggerThis is footnote 1", "This is footnote 2"), - justification = "l") %>% - rtf_source("Source: xxx", - justification = "l") - - -ae_tbl %>% rtf_encode() %>% write_rtf("rtf/ae_example.rtf") -``` - -# Example 3: adverse events example page_by option - -# write to an rtf table -```{r} -ae_tbl <- ae_t1 %>% - rtf_title( "Analysis of Subjects With Specific Adverse Events", - c("(Incidence > 10 Subjects in One or More Treatment Groups)", - "ASaT") ) %>% - rtf_colheader(" | Placebo | Drug High Dose | Drug Low Dose", - col_rel_width = c(4, rep(2,3)), - first_row = TRUE) %>% - rtf_colheader(" | n | (%) | n | (%) | n | (%)", - border_top = c("", rep("single", 6)), - border_left = c("single", rep(c("single",""), 3))) %>% - rtf_body(col_rel_width = c(4, rep(1,6)) , - text_justification = c("l", rep("c",6)), - border_left = c("single", rep(c("single",""), 3) ), - page_num = 10) %>% - rtf_footnote("This is a footnote") %>% - rtf_source("Source: xxx") - - -ae_tbl %>% rtf_encode() %>% write_rtf("rtf/ae_example_page_num_10.rtf") -``` - - -# Example 4: group_by feature - -```{r} -data(iris) - -iris <- cbind(iris, new_cat = rep(c("A","B","C","D","E"), 30)) - -iris_tbl <- iris %>% - rtf_title("IRIS DATA") %>% - rtf_colheader("Sepal Length | Sepal Width | Petal Length | PetalWidth", - first_row = TRUE) %>% - rtf_body( - page_by = c("Species", "new_cat"), - new_page = TRUE, - page_num = 30) %>% - rtf_footnote("This is a footnote") %>% - rtf_source("Source: xxx") - -iris_tbl %>% rtf_encode() %>% write_rtf("rtf/iris_example.rtf") - - -``` - -## Example 5: A very simple example -```{r} -data(iris) - -iris_tbl <- iris[1:20,] %>% rtf_body() - -iris_tbl %>% rtf_encode() %>% write_rtf("rtf/iris_very_simple.rtf") -``` - -## Example 6: A simple example -```{r} -data(iris) - -iris_tbl <- iris[1:20,] %>% - rtf_title("IRIS DATA") %>% - rtf_colheader("Sepal Length | Sepal Width | Petal Length | PetalWidth | Species", - first_row = TRUE) %>% - rtf_body() %>% - rtf_footnote("This is a footnote") %>% - rtf_source("Source: xxx") - -iris_tbl %>% rtf_encode() %>% write_rtf("rtf/iris_simple.rtf") -``` - -## Example 7: baseline characteristics example feature -```{r} -bs_count <- function(data, grp, var, - var_label = var, - decimal = 1, - total = TRUE){ - - - data <- data %>% rename(grp = !! grp, var = !! var) - coding <- levels( factor(data$grp) ) - data <- data %>% mutate(grp = as.numeric(factor(grp))) - - # res <- data %>% count(grp, var, .drop = FALSE) - res <- with(data, table(var, grp)) %>% as.data.frame() %>% - mutate(grp = as.numeric(grp)) - - if(total){ - res_tot <- with(data, table(var)) %>% as.data.frame() %>% mutate(grp = 9999) - res <- bind_rows(res, res_tot) - } - - res <- res %>% rename(n = Freq) - - res <- res %>% mutate(pct = formatC( n / sum(n) * 100, digits = decimal, format = "f", flag = "0") ) - - res <- res %>% gather("key", "value", n, pct) %>% - unite(keys, grp, key) %>% - spread(keys, value) %>% - mutate(var_label = var_label) %>% - mutate(var = as.character(var)) - - names(res) <- gsub("_n", "", names(res), fixed = TRUE) - attr(res, "coding") <- coding - - res -} - -bs_continous <- function(data, grp, var, - var_label = var, - decimal = 1, - total = TRUE, - blank_row = FALSE){ - - data <- data %>% rename(grp = !! grp, var = !! var) - coding <- levels( factor(data$grp) ) - data <- data %>% mutate(grp = as.numeric(factor(grp))) - - res <- data %>% select(grp, var) %>% na.omit() %>% - group_by(grp) %>% - summarise(`Subjects with data` = n(), - Mean = formatC( mean(var), digits = decimal, format = "f", flag = "0"), - SD = formatC( sd(var) , digits = decimal, format = "f", flag = "0"), - Median = formatC( median(var), digits = decimal, format = "f", flag = "0"), - Range = paste( range(var), collapse = " to ") ) - - if(total){ - - res_tot <- data %>% select(grp, var) %>% na.omit() %>% - summarise(`Subjects with data` = n(), - Mean = formatC( mean(var), digits = decimal, format = "f", flag = "0"), - SD = formatC( sd(var) , digits = decimal, format = "f", flag = "0"), - Median = formatC( median(var), digits = decimal, format = "f", flag = "0"), - Range = paste( range(var), collapse = " to ") ) %>% - mutate(grp = 9999) - res <- bind_rows(res, res_tot) - } - - - res <- res %>% gather("key", "value", - grp) %>% - mutate(key = factor(key, levels = c("Subjects with data", "Mean", "SD", "Median", "Range")) ) %>% - spread(grp, value) %>% - mutate(var_label = var_label) %>% - mutate(key = as.character(key)) %>% - rename(var = key) - - if(blank_row){ - res <- bind_rows(tibble(var_label = var_label), res) - } - - res -} - -# The code above define two utility function for baseline characterstic tables. - - - -# Analaysis Set -data(adsl) -ana <- adsl %>% subset(ITT == "Y") -ana <- ana %>% mutate( - RACE = factor(RACE, - toupper( c("African Descent (Negro, Black)", "Caucasian", "Hispanic (Mexican - American, Mexico, Central And South America)", - "Other (Mixed - Racial Heritage, American Indian, Eskimo)")), - c("Black", "Caucasian", "Hispanic", "Other")), - SEX = factor(SEX, c("F", "M"), c("Female", "Male")) -) - -# Build Data for r2rtf -bs_tb <- bind_rows( - bs_count(ana, "TRTPN", "SEX", "Gender"), - bs_count(ana, "TRTPN", "AGEGRP", "Age (Years)"), - bs_continous(ana, "TRTPN", "AGE", "Age (Years)", blank_row = TRUE), - bs_count(ana, "TRTPN", "RACE", "Race") -) - -bs_tb[ is.na(bs_tb) ] <- "" -``` - - -```{r} -bs_rtf <- bs_tb %>% - - rtf_title("Demographic and Anthropometric Characteristics","ITT Subjects") %>% - - rtf_colheader(" | Placebo | Drug Low Dose | Drug High Dose | Total | label", - col_rel_width = c(3, rep(2,4),3), - page_width = 9.5, - first_row = TRUE) %>% - - rtf_colheader(" | n | (%) | n | (%) | n | (%) | n | (%) | label", - page_width = 9.5, - border_top = c("", rep("single", 9)), - border_left = c("single", rep(c("single",""), 4),"single")) %>% - - rtf_body(page_width = 9.5, - col_rel_width = c(3, rep(c(1.2, 0.8), 4),3) , - text_justification = c("l", rep("d",8),"c"), - border_left = c("single", rep(c("single",""), 4),"single" )) %>% - - rtf_footnote("This is a footnote") %>% - - rtf_source("Source: xxx") - - -# Output - -bs_rtf %>% rtf_encode() %>% write_rtf("rtf/bs_example.rtf") -``` - - -## Example 8: baseline characteristics example page_by feature - -```{r} -## r2rtf rtf table createion pipeline -bs_rtf <- bs_tb %>% - - rtf_title("Demographic and Anthropometric Characteristics","ITT Subjects") %>% - - rtf_colheader(" | Placebo | Drug Low Dose | Drug High Dose | Total", - col_rel_width = c(3, rep(2,4)), - first_row = TRUE) %>% - - rtf_colheader(" | n | (%) | n | (%) | n | (%) | n | (%)", - border_top = c("", rep("single", 8)), - border_left = c("single", rep(c("single",""), 4))) %>% - - rtf_body(page_by = "var_label", # this option show the label in one row. - col_rel_width = c(3, rep(c(1.2, 0.8), 4)) , - text_justification = c("l", rep("d",8)), - border_left = c("single", rep(c("single",""), 4) )) %>% - - rtf_footnote("This is a footnote") %>% - - rtf_source("Source: xxx") - - -# Output - -bs_rtf %>% rtf_encode() %>% write_rtf("rtf/bs_pageby_example.rtf") -``` - - - -## Example 9: baseline characteristics example page_by and new_page feature -```{r} -## r2rtf rtf table createion pipeline -bs_rtf <- bs_tb %>% - - rtf_title("Demographic and Anthropometric Characteristics","ITT Subjects") %>% - - rtf_colheader(" | Placebo | Drug Low Dose | Drug High Dose | Total", - col_rel_width = c(3, rep(2,4)), - first_row = TRUE) %>% - - rtf_colheader(" | n | (%) | n | (%) | n | (%) | n | (%)", - border_top = c("", rep("single", 8)), - border_left = c("single", rep(c("single",""), 4))) %>% - - rtf_body(page_by = "var_label", # this option show the label in one row. - new_page = TRUE, - col_rel_width = c(3, rep(c(1.2, 0.8), 4)) , - text_justification = c("l", rep("d",8)), - border_left = c("single", rep(c("single",""), 4) )) %>% - - rtf_footnote("This is a footnote", - justification = "l") %>% - - rtf_source("Source: xxx", - justification = "l") - - -# Output - -bs_rtf %>% rtf_encode() %>% write_rtf("rtf/bs_pageby_newpage_example.rtf") -``` - - - diff --git a/vignettes/rtf-row.Rmd b/vignettes/rtf-row.Rmd index 64ac2b76..dde26b9b 100644 --- a/vignettes/rtf-row.Rmd +++ b/vignettes/rtf-row.Rmd @@ -1,5 +1,5 @@ --- -title: "RTF Examples for Controling Table Details" +title: "RTF Examples for Controlling Table Details" date: "`r Sys.Date()`" output: rmarkdown::html_vignette vignette: > @@ -27,7 +27,7 @@ This vignette documents how to use `.rtf_row` to customize table in details. All `.rtf_row` supports `r length(.border_type()$name)` different types of border as listed below. ```{r} -.border_type()$name +.border_type()$name ``` The border type can be used to define the top, left, right and bottom border types. @@ -35,12 +35,13 @@ The border type can be used to define the top, left, right and bottom border typ This example define different top border line. ```{r} .n <- length(.border_type()$name) -db <- data.frame( border_type = .border_type()$name ) %>% - rtf_title("Summary of Border Type Using Top Border") %>% - rtf_body(border_top = .border_type()$name) - -db %>% rtf_encode() %>% - write_rtf("rtf/border-type.rtf") +db <- data.frame(border_type = .border_type()$name) %>% + rtf_title("Summary of Border Type Using Top Border") %>% + rtf_body(border_top = .border_type()$name) + +db %>% + rtf_encode() %>% + write_rtf("rtf/border-type.rtf") ``` @@ -49,27 +50,32 @@ The bottom border only defined in last row. This example show that top border an cell border as single. Only last column use right border as double. Only last row use bottom border as dash line. ```{r} -iris %>% head() %>% - rtf_body(border_top = "single", - border_left = "single", - border_right = "double", - border_bottom = "dash") %>% - rtf_encode() %>% - write_rtf("rtf/border-order.rtf") +iris %>% + head() %>% + rtf_body( + border_top = "single", + border_left = "single", + border_right = "double", + border_bottom = "dash" + ) %>% + rtf_encode() %>% + write_rtf("rtf/border-order.rtf") ``` -This example display table with specific border type (i.e. double line at the frist and last line and blank at the middle) +This example display table with specific border type (i.e. double line at the first and last line and blank at the middle) ```{r} -rtf_db <- iris %>% - head() %>% - rtf_title("Border Using Double Line at First/Last Line") %>% - rtf_colheader("Sepal Length | Sepal Width | Petal Length | Petal Width | Species", - first_row = TRUE) %>% - rtf_body() - +rtf_db <- iris %>% + head() %>% + rtf_title("Border Using Double Line at First/Last Line") %>% + rtf_colheader("Sepal Length | Sepal Width | Petal Length | Petal Width | Species", + first_row = TRUE + ) %>% + rtf_body() + -rtf_db %>% rtf_encode() %>% - write_rtf("rtf/border-example.rtf") +rtf_db %>% + rtf_encode() %>% + write_rtf("rtf/border-example.rtf") ``` Internally, the border type will be saved as a matrix to define the border type of each cell. For example, the top border type in the last example is saved as @@ -80,22 +86,24 @@ rtf_db %>% attr("border_top") the bottom border type in the last example is saved as below. Based on the rule, all cells use top border. cells at last row use bottom border at last row. ```{r} -rtf_db %>% attr("border_bottom") +rtf_db %>% attr("border_bottom") ``` -User can use single value, vector, and matrix to control the border type. Specifically, a verctor is transfered to a matrix by row. Therefore, it is useful to set columns type by using vector. +User can use single value, vector, and matrix to control the border type. Specifically, a vector is transferred to a matrix by row. Therefore, it is useful to set columns type by using vector. ```{r} -matrix( .border_type()$name[1:5], nrow = 6, ncol = 5, byrow = TRUE) +matrix(.border_type()$name[1:5], nrow = 6, ncol = 5, byrow = TRUE) ``` ```{r} -rtf_db <- iris %>% - head() %>% - rtf_title("Left Border Defined by a Vector") %>% - rtf_body(border_left = .border_type()$name[2:6]) +rtf_db <- iris %>% + head() %>% + rtf_title("Left Border Defined by a Vector") %>% + rtf_body(border_left = .border_type()$name[2:6]) -rtf_db %>% rtf_encode() %>% write_rtf("rtf/border-vector.rtf") +rtf_db %>% + rtf_encode() %>% + write_rtf("rtf/border-vector.rtf") ``` @@ -107,7 +115,7 @@ The table cell allow to be left, center or right justified. the cell is also all ``` ```{r} -.justification()[, 1:2] %>% +.justification()[, 1:2] %>% rtf_body(text_justification = rep(.justification()$type, each = 2)) %>% rtf_encode() %>% write_rtf("rtf/justification-type.rtf") @@ -115,11 +123,11 @@ The table cell allow to be left, center or right justified. the cell is also all ```{r} -db <- iris %>% mutate(Sepal.Length = formatC(Sepal.Length * 2, digits = 1, format = "f") ) +db <- iris %>% mutate(Sepal.Length = formatC(Sepal.Length * 2, digits = 1, format = "f")) -db[, rep(1,4)] %>% +db[, rep(1, 4)] %>% head() %>% - rtf_body(text_justification = c("d", "l", "c", "r") ) %>% + rtf_body(text_justification = c("d", "l", "c", "r")) %>% rtf_encode() %>% write_rtf("rtf/justification-number.rtf") ``` @@ -127,26 +135,28 @@ db[, rep(1,4)] %>% ## Column Width -Column width is determined by width ratio between the row using `col_rel_width`. The default is to have the same width for each column. The actual width is calcuate with actual width `col_total_width`. The default value of `col_total_width` is page_width divided by 1.4. +Column width is determined by width ratio between the row using `col_rel_width`. The default is to have the same width for each column. The actual width is calculate with actual width `col_total_width`. The default value of `col_total_width` is page_width divided by 1.4. This example shows the default setting ```{r} -iris %>% head() %>% - rtf_body() %>% - rtf_encode() %>% - write_rtf("rtf/column-width-default.rtf") +iris %>% + head() %>% + rtf_body() %>% + rtf_encode() %>% + write_rtf("rtf/column-width-default.rtf") ``` This example customizes the column width ```{r} -iris %>% head() %>% - rtf_body(col_rel_width = 1:ncol(iris)) %>% - rtf_encode() %>% - write_rtf("rtf/column-width-ratio.rtf") +iris %>% + head() %>% + rtf_body(col_rel_width = 1:ncol(iris)) %>% + rtf_encode() %>% + write_rtf("rtf/column-width-ratio.rtf") ``` -## Text Apperance +## Text Appearance The `.rtf_row` function allow **bold**, *italics*, ~~strikethrough~~, underline and any combinations of them. @@ -157,14 +167,14 @@ The `.rtf_row` function allow **bold**, *italics*, ~~strikethrough~~, underline This example considers the text format defined below ```{r} -fmt <- matrix( c(.font_format()$type, paste0(.font_format()$type, "b") ), ncol = 2 ) +fmt <- matrix(c(.font_format()$type, paste0(.font_format()$type, "b")), ncol = 2) fmt ``` ```{r} -.font_format()[, 1:2] %>% - rtf_body(text_format = fmt) %>% +.font_format()[, 1:2] %>% + rtf_body(text_format = fmt) %>% rtf_encode() %>% write_rtf("rtf/text-format.rtf") ``` @@ -174,42 +184,48 @@ fmt Font size can be defined for each cell. ```{r} -iris %>% head() %>% - rtf_body(text_font_size = c(7:11) ) %>% - rtf_encode() %>% - write_rtf("rtf/text-font-size.rtf") +iris %>% + head() %>% + rtf_body(text_font_size = c(7:11)) %>% + rtf_encode() %>% + write_rtf("rtf/text-font-size.rtf") ``` ## Color -The text, border and background color can be set seperately for each cell. It is important to note that the cell can be defined condition by the data. For example, one can highlight p-value < 0.05 in gold. +The text, border and background color can be set separately for each cell. It is important to note that the cell can be defined condition by the data. For example, one can highlight p-value < 0.05 in gold. This example define text color for each column ```{r} -iris %>% head()%>% - rtf_body(text_color = c("black", "red", "gold", "blue", "grey") ) %>% - rtf_encode() %>% - write_rtf("rtf/color-text.rtf") +iris %>% + head() %>% + rtf_body(text_color = c("black", "red", "gold", "blue", "grey")) %>% + rtf_encode() %>% + write_rtf("rtf/color-text.rtf") ``` This example define left border color for each column ```{r} -iris %>% head() %>% - rtf_body(border_color_left = c("black", "red", "gold", "blue", "grey") ) %>% - rtf_encode() %>% - write_rtf("rtf/color-border.rtf") +iris %>% + head() %>% + rtf_body(border_color_left = c("black", "red", "gold", "blue", "grey")) %>% + rtf_encode() %>% + write_rtf("rtf/color-border.rtf") ``` This example define background color for each column ```{r} -iris %>% head() %>% - rtf_body(text_background_color = c("white", "red", "gold", "blue", "grey"), - text_color = "black") %>% - rtf_encode() %>% - write_rtf("rtf/color-background.rtf") +iris %>% + head() %>% + rtf_body( + text_background_color = c("white", "red", "gold", "blue", "grey"), + text_color = "black" + ) %>% + rtf_encode() %>% + write_rtf("rtf/color-background.rtf") ``` diff --git a/vignettes/rtf-text.Rmd b/vignettes/rtf-text.Rmd index 72fb952c..a85188eb 100644 --- a/vignettes/rtf-text.Rmd +++ b/vignettes/rtf-text.Rmd @@ -1,5 +1,5 @@ --- -title: "RTF Examples for Controling Text and Paragraph Details" +title: "RTF Examples for Controlling Text and Paragraph Details" date: "`r Sys.Date()`" output: rmarkdown::html_vignette vignette: > @@ -23,7 +23,7 @@ This vignette documents how to use `.rtf_text` and `.rtf_paragraph` to customize ```{r} -text <- paste( rep("Sample Text", 20), collapse = " ") +text <- paste(rep("Sample Text", 20), collapse = " ") ``` ```{r} @@ -37,20 +37,21 @@ text <- rep(text, 5) Paragraph alignment supports four types. ```{r} -.justification() %>% subset(type %in% c("l","c","r","j") ) +.justification() %>% subset(type %in% c("l", "c", "r", "j")) ``` This example display text in different alignment methods. ```{r} -res <- .rtf_paragraph(.rtf_text(text), - justification = c("l","c","r","j")) +res <- .rtf_paragraph(.rtf_text(text), + justification = c("l", "c", "r", "j") +) write_rtf_para(res, "rtf/para-justification.rtf") ``` ### Indent -First line, left, and right indent can be controle. One can also use a negative number to have the text "outdent". +First line, left, and right indent can be control. One can also use a negative number to have the text "outdent". ```{r} res <- .rtf_paragraph(.rtf_text(text), indent_first = c(1000, 0, -1000), indent_left = c(500, -500), indent_right = 500) @@ -63,23 +64,25 @@ write_rtf_para(res, "rtf/para-indent.rtf") Different types of line space can be controlled. ```{r} -.spacing()[,1:2] +.spacing()[, 1:2] ``` This example show different line spaces in paragraph. ```{r} -res <- .rtf_paragraph(.rtf_text(text), - space = c(1,2,1.5)) +res <- .rtf_paragraph(.rtf_text(text), + space = c(1, 2, 1.5) +) write_rtf_para(res, "rtf/para-line-space.rtf") ``` ### Paragraph Space ```{r} -res <- .rtf_paragraph(.rtf_text(text), - space_before = c(50, 180), - space_after = c(180,50)) +res <- .rtf_paragraph(.rtf_text(text), + space_before = c(50, 180), + space_after = c(180, 50) +) write_rtf_para(res, "rtf/para-space.rtf") ``` @@ -88,8 +91,9 @@ write_rtf_para(res, "rtf/para-space.rtf") This example add page break before paragraphs. ```{r} -res <- .rtf_paragraph(.rtf_text(text)[1:2], - new_page = TRUE) +res <- .rtf_paragraph(.rtf_text(text)[1:2], + new_page = TRUE +) write_rtf_para(res, "rtf/para-page.rtf") ``` @@ -97,29 +101,34 @@ write_rtf_para(res, "rtf/para-page.rtf") ### Font Size ```{r} -res <- .rtf_paragraph(.rtf_text(text, - font_size = 8:12)) +res <- .rtf_paragraph(.rtf_text(text, + font_size = 8:12 +)) write_rtf_para(res, "rtf/text-font-size.rtf") ``` ### Text Format ```{r} -res <- .rtf_paragraph(.rtf_text(text, - format = c("b","i","bi","^", "_", "u", "s"))) +res <- .rtf_paragraph(.rtf_text(text, + format = c("b", "i", "bi", "^", "_", "u", "s") +)) write_rtf_para(res, "rtf/text-format.rtf") ``` ### Text Color ```{r} -res <- .rtf_paragraph(.rtf_text(text, - color = c("red","gold","black","orange","blue"))) +res <- .rtf_paragraph(.rtf_text(text, + color = c("red", "gold", "black", "orange", "blue") +)) write_rtf_para(res, "rtf/text-color.rtf") ``` ### Text Background Color ```{r} -res <- .rtf_paragraph(.rtf_text(text, color = "white", - background_color = c("red","gold","black","orange","blue"))) +res <- .rtf_paragraph(.rtf_text(text, + color = "white", + background_color = c("red", "gold", "black", "orange", "blue") +)) write_rtf_para(res, "rtf/text-background-color.rtf") ``` @@ -130,10 +139,10 @@ This example call `rtf_text` multiple times to combine a text. ```{r} res <- .rtf_paragraph(paste0( .rtf_text("3.5"), - .rtf_text("\\dagger", format = "^"), - .rtf_text("\\line red ", color = "red"), - .rtf_text("highlight", background_color = "yellow") ) -) + .rtf_text("\\dagger", format = "^"), + .rtf_text("\\line red ", color = "red"), + .rtf_text("highlight", background_color = "yellow") +)) write_rtf_para(res, "rtf/text-combine1.rtf") ``` @@ -141,15 +150,15 @@ This example call `rtf_text` one time to combine a text. ```{r} text <- c(3.5, "\\dagger", "\\line red ", "highlight") format <- c("", "^", "", "") -color <- c("black","black","red","black") -background_color <- c("white","white","white","yellow") +color <- c("black", "black", "red", "black") +background_color <- c("white", "white", "white", "yellow") res <- .rtf_paragraph(paste(.rtf_text(text, format = format, color = color, background_color = background_color), collapse = "")) write_rtf_para(res, "rtf/text-combine2.rtf") ``` -### Inline Formating -This example provide an inline formating options with superscript and subscript. It is important to note the location of `{}` is before the special character. +### Inline Formatting +This example provide an inline formatting options with superscript and subscript. It is important to note the location of `{}` is before the special character. ```{r} text <- c("X{_1} = \\alpha{^2} + \\beta{^\\dagger}") From 7b22093c7dad62f46279e5a8ebbfec5d5e29fb35 Mon Sep 17 00:00:00 2001 From: yilong zhang Date: Thu, 26 Mar 2020 11:35:13 -0400 Subject: [PATCH 2/4] CRAN Resubmission v0.1.1 1. Explain RTF in Description text. 2. add examples to every function export to user. files only write/save in tempdir(). 3. add Merck Sharp & Dohme Corp as copyright holder in the Authors@R field. --- DESCRIPTION | 9 +++--- R/add_attributes.R | 45 ++++++++++++++++++++++++++ R/add_figure.R | 24 ++++++++++++++ R/data.R | 12 +++---- R/write_rtf.R | 63 +++++++++++++++++++++++++++++++++++++ data/t1_gt.rda | Bin 7446 -> 0 bytes data/t2_gt.rda | Bin 5943 -> 0 bytes data/t3_gt.rda | Bin 5673 -> 0 bytes data/tbl_1.rda | Bin 0 -> 1620 bytes data/tbl_2.rda | Bin 0 -> 1302 bytes data/tbl_3.rda | Bin 0 -> 1214 bytes man/rtf_body.Rd | 12 +++++++ man/rtf_colheader.Rd | 11 +++++++ man/rtf_figure.Rd | 14 +++++++++ man/rtf_footnote.Rd | 9 ++++++ man/rtf_read_png.Rd | 12 +++++++ man/rtf_source.Rd | 9 ++++++ man/rtf_title.Rd | 9 ++++++ man/{t1_gt.Rd => tbl_1.Rd} | 10 +++--- man/{t2_gt.Rd => tbl_2.Rd} | 10 +++--- man/{t3_gt.Rd => tbl_3.Rd} | 10 +++--- 21 files changed, 234 insertions(+), 25 deletions(-) delete mode 100644 data/t1_gt.rda delete mode 100644 data/t2_gt.rda delete mode 100644 data/t3_gt.rda create mode 100644 data/tbl_1.rda create mode 100644 data/tbl_2.rda create mode 100644 data/tbl_3.rda rename man/{t1_gt.Rd => tbl_1.Rd} (82%) rename man/{t2_gt.Rd => tbl_2.Rd} (82%) rename man/{t3_gt.Rd => tbl_3.Rd} (82%) diff --git a/DESCRIPTION b/DESCRIPTION index 85253711..863bd786 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,12 +1,13 @@ Package: r2rtf -Title: Easily Create Presentation-Ready RTF Table and Figure +Title: Easily Create Presentation-Ready Rich Text Format (RTF) Table and Figure Version: 0.1.1 Authors@R: c( person("Yilong", "Zhang", email = "yilong.zhang@merck.com", role = c("aut", "cre")), - person("Siruo", "Wang", email = "swang171@jhu.edu", role = c("aut")), - person("Simiao", "Ye", email = "simiao.ye1@merck.com", role = c("aut")) + person("Siruo", "Wang", email = "swang171@jhu.edu", role = "aut"), + person("Simiao", "Ye", email = "simiao.ye1@merck.com", role = "aut"), + person("Merck Sharp & Dohme Corp", role = "cph") ) -Description: Create RTF table and figure with flexible format. +Description: Create presentation-ready Rich Text Format (RTF) table and figure with flexible and customized format. Depends: R (>= 3.5.0) License: GPL-3 Encoding: UTF-8 diff --git a/R/add_attributes.R b/R/add_attributes.R index 2e74134a..74e4bb9c 100644 --- a/R/add_attributes.R +++ b/R/add_attributes.R @@ -39,6 +39,14 @@ #' @param new_page boolean value to indicate whether to start a new page #' @param hyphenation boolean value to indicate whether to use hyphenation #' +#' @examples +#' \dontrun{ +#' library(dplyr) # required to run examples +#' data(tbl_1) +#' tbl_1 %>% rtf_title(title = "ANCOVA of Change from Baseline at Week 8") %>% +#' attr("rtf_heading") +#' } +#' #' @export rtf_title <- function(tbl, @@ -112,6 +120,14 @@ rtf_title <- function(tbl, #' @param new_page boolean value to indicate whether to start a new page #' @param hyphenation boolean value to indicate whether to use hyphenation #' +#' @examples +#' \dontrun{ +#' library(dplyr) # required to run examples +#' data(tbl_1) +#' tbl_1 %>% rtf_footnote("\\dagger Based on an ANCOVA model.") %>% +#' attr("rtf_footnote") +#' } +#' #' @export rtf_footnote <- function(tbl, @@ -191,6 +207,14 @@ rtf_footnote <- function(tbl, #' @param new_page boolean value to indicate whether to start a new page #' @param hyphenation boolean value to indicate whether to use hyphenation #' +#' @examples +#' \dontrun{ +#' library(dplyr) # required to run examples +#' data(tbl_1) +#' tbl_1 %>% rtf_source("Source: [study999:adam-adeff]") %>% +#' attr("rtf_source") +#' } +#' #' @export rtf_source <- function(tbl, @@ -336,6 +360,16 @@ rtf_source <- function(tbl, #' @param text_space_after line space after text #' @param first_row boolean value to indicate whether column header is the first row of the table #' +#' @examples +#' \dontrun{ +#' library(dplyr) # required to run examples +#' data(tbl_1) +#' tbl_1 %>% +#' rtf_colheader(colheader = "Treatment | N | Mean (SD) | N | Mean (SD) | N | +#' Mean (SD) | LS Mean (95% CI)\\dagger") %>% +#' attr("rtf_colheader") +#' } +#' #' @export rtf_colheader <- function(tbl, @@ -497,6 +531,17 @@ rtf_colheader <- function(tbl, #' @param new_page a boolean value to indicate whether to separate grouped table into pages by sections #' @param last_row a boolean value to indicate whether the table contains the last row of the final table #' +#' @examples +#' \dontrun{ +#' library(dplyr) # required to run examples +#' data(tbl_1) +#' tbl_1 %>% +#' rtf_body(col_rel_width = c(3,1,3,1,3,1,3,5), +#' text_justification = c("l",rep("c",7)), +#' last_row = FALSE) %>% +#' attributes() +#' } +#' #' @export rtf_body <- function(tbl, diff --git a/R/add_figure.R b/R/add_figure.R index 6427cb30..4743b3e9 100644 --- a/R/add_figure.R +++ b/R/add_figure.R @@ -19,6 +19,17 @@ #' #' @param file a vector of PNG file path #' +#' @examples +#' \dontrun{ +#' file <- file.path(tempdir(), "figure1.png") +#' png(file) +#' plot(1:10) +#' dev.off() +#' +#' # Read in PNG file in binary format +#' rtf_read_png(file) +#' } +#' #' @export rtf_read_png <- function(file) { lapply(file, readBin, what = "raw", size = 1, signed = TRUE, endian = "little", n = 1e8) @@ -31,6 +42,19 @@ rtf_read_png <- function(file) { #' @param fig_width the width of figures in inch #' @param fig_height the height of figures in inch #' +#' @examples +#' \dontrun{ +#' library(dplyr) # required to run examples +#' file <- file.path(tempdir(), "figure1.png") +#' png(file) +#' plot(1:10) +#' dev.off() +#' +#' # Read in PNG file in binary format +#' rtf_read_png(file) %>% rtf_figure() %>% +#' attributes() +#' } +#' #' @export rtf_figure <- function(tbl, diff --git a/R/data.R b/R/data.R index 5ad0b0e4..c222eca3 100644 --- a/R/data.R +++ b/R/data.R @@ -27,14 +27,14 @@ #' HAMD17 "HAMD17" -#' t1_gt -"t1_gt" +#' tbl_1 +"tbl_1" -#' t2_gt -"t2_gt" +#' tbl_2 +"tbl_2" -#' t3_gt -"t3_gt" +#' tbl_3 +"tbl_3" #' unicode_latex "unicode_latex" diff --git a/R/write_rtf.R b/R/write_rtf.R index 75d582c0..81a4b4a2 100644 --- a/R/write_rtf.R +++ b/R/write_rtf.R @@ -24,6 +24,69 @@ #' @param tbl a data frame for table or a list of binary string for figure #' @param type the type of input, default is table. #' +#' @examples +#' \dontrun{ +#' library(dplyr) # required to run examples +#' +#' # Example 1 +#' head(iris) %>% +#' rtf_body() %>% +#' rtf_encode() %>% +#' write_rtf(file = file.path(tempdir(), "table1.rtf")) +#' +#' # Example 2 +#' library(dplyr) # required to run examples +#' file <- file.path(tempdir(), "figure1.png") +#' png(file) +#' plot(1:10) +#' dev.off() +#' +#' # Read in PNG file in binary format +#' rtf_read_png(file) %>% rtf_figure() %>% +#' rtf_encode(type = "figure") %>% +#' write_rtf(file = file.path(tempdir(), "figure1.rtf")) +#' +#' # Example 3 +#' +#' ## convert tbl_1 to the table body. Add title, subtitle, two table +#' ## headers, and footnotes to the table body. +#' data(tbl_1) +#' data(tbl_2) +#' data(tbl_3) +#' t1 <- tbl_1 %>% +#' rtf_title(title = "ANCOVA of Change from Baseline at Week 8", +#' subtitle = c("Missing Data Approach", +#' "Analysis Population")) %>% +#' rtf_colheader(colheader = " | Baseline | Week 20 | Change from Baseline", +#' col_rel_width = c(3, 4, 4, 9), +#' first_row = TRUE) %>% +#' rtf_colheader(colheader = "Treatment | N | Mean (SD) | N | Mean (SD) | N | +#' Mean (SD) | LS Mean (95% CI)\\dagger") %>% +#' rtf_body(col_rel_width = c(3,1,3,1,3,1,3,5), +#' text_justification = c("l",rep("c",7)), +#' last_row = FALSE) %>% +#' rtf_footnote(footnote = "\\dagger Based on an ANCOVA model. +#' justification = "l"); +#' ## convert tbl_2 to the table body. Add a table column header to table body. +#' t2 <- tbl_2 %>% +#' rtf_colheader(colheader = "Pairwise Comparison | +#' Difference in LS Mean(95% CI)\\dagger | p-Value", +#' text_justification = c("l","c","c")) %>% +#' rtf_body(col_rel_width = c(8,7,5), +#' text_justification = c("l","c","c"), +#' last_row = FALSE); +#' ## convert tbl_3 to the table body. Add data source to the table body. +#' t3 <- tbl_3 %>% +#' rtf_body(colheader = FALSE, +#' text_justification = "l") %>% +#' rtf_source(source = "Source: [study999:adam-adeff]", +#' justification = "l") +#' # add t1, t2, and t3 into a list in order +#' tbl <- list(t1, t2, t3) +#' # concatenate a list of table and save to an RTF file +#' tbl %>% rtf_encode() %>% write_rtf(file.path(tempdir(), "table2.rtf")) +#' } +#' #' @rdname rtf_encode diff --git a/data/t1_gt.rda b/data/t1_gt.rda deleted file mode 100644 index dc17ecb701595a0dd561d0854621765003a3c007..0000000000000000000000000000000000000000 GIT binary patch literal 0 HcmV?d00001 literal 7446 zcmeHM>u=jO5Lf(+oi^>7?vZwDiLC`vEYad7P8?tzmL&^Npv{UV-TGmeKwGq}RTe#p zPMUq{=lyH@hxTdNQ6yzrk36;{*nrs(EZ+UdJ06e6y`TJx@B2Kt5}(`ie-4U z%CGi!mRgooDnMh(Dp@r_y;|^(409}uO zmh}XFci=HQ&NSBSHMFp5uQnd3o->V>y^0pr?3L9=r}bWndN=KjX54#e!(K)U>-O>) zdIJhAY}k#paqpJBjuu*WGwN+>I=2*|mw?w=L`zM3rKNk_1|sxYYAoB0b>OYr4d5lr z*YR-}CT3scZC_i^#T?sRh6g0kv&QJ59ROYQj%@i3UXG8C|4abO8YI-7R^t};8CS1` z-G+KAKPNcQjl%9@ldKzs-4&Cp8-=Z>39;2SecN~3Zo)N+phOL{JdS^*AC-L41viSk zAP-Y!Uax-|=)XCT(pqe-k}%DctW{A8^^mGsGK$Vct5bBKT=AS zn<=IIwJxPRpqzx`8C28^^z?5?vxScO1@#FqxZ3fss3cV1~F5038n0Ywp zkVUlh6g>e#(Dhsb1oSlEgdJdi5k1=j&NG5Tj`n^TVMfA5w6_hkJ&pqxGZ$@>0}peL zCRblOQUxNIFpkvsqT`Borh1hHWZw-){xZ3p-j?;<>j zC%N0NOACii$T1u&5h%5?%HS8KDlBqBRk13Ue!`_DKdZd$tW3sbAm<-Ic##4(nhzlgJ<_o(;aiuw zkSWKnLj=jQXEH`#S$kryU9CN4F=IIB5hprQwU3DyphDk-ZrZgf8lAFlRpbNX^YZ_j z!WnN0akSJXo=B|3BIL!{I8I%y<5cO88)3PmJf^8mYDkO%j=g{|=g@O`Uy*N)$$b)K z`7(95J*LwG!n!^^bl$2yS-c~~o94Lf6UTE^dq%cRkvAl%3;H;r_p44BKak`$?z|Ds z9JnHdqfC!8z^vy%IxKE0QpIbEBrhkDrU#+Sg^6-Hgo6>13)LgdHT6n!O$9#c6YP3H z&&g5nL(S(N2LmK$cSp0sQ9B!PS0ma|`8MU84kq-^ftZuXftWM72aWh<5$4Wk5|y0K zd6#Ba)KePp~GWnj>fXKsLfOVK&0F;3s1h@)s)? zWXj3~nd0uMok86rN6AZib`Hc8l>;#a-AfC~@WOnQDJ~ynN}Lgv9Aa1OEae>Yf)sM* z4aIKrf{s6O2@pnY1-PFH7^|*eABUp>M2I6tz;ib3oQauK6dhSGpck?{@K3CU2+b5`Gqot}R*)N%b*Oik{en=xlnhua|?u?`XU z>s0i*W$<(_%Mx|UCOlamk+A&JM~r(BW1KXO;E7LCj!3rj(OHYnLS^#5K`2N5srp}4 zqpFS+CH5klu!-Re3H8Y5X^H}>jQ-l3{}Mty6+1V&r7;!}b&qjJL6-!k2 z^E0M(s8A!Ew_P8H4K;#EkvAH>$x3*{sY0FQz20UaIsCcn@;6z%8f!zHu2w(Wi9T5{ zLufgqew?-z9~<2_TjC1=K~@Z9rdet{Za!2)7F+S_xkoYd^a782SQmiHJDbn;zD-HZ z$DgLZ)caHgF9TL=#pYDgQbyc=`6@X@16%ciK4G4yqnM`8LdfwdU$z07+WJ1`f2If;@Je8deDPA#cHJu zbr~HXQRVjG&WJEaKM?W;iCtj!`~0~VhLESBZKyJ!&Eb$y-07qGxcL2o4oALGvW{=Z V`oDv6bRE*B)Yl`B17%D3`~{;=lV|_{ diff --git a/data/t2_gt.rda b/data/t2_gt.rda deleted file mode 100644 index ab250855db63b325fde96ba0a08ddcd1eb809327..0000000000000000000000000000000000000000 GIT binary patch literal 0 HcmV?d00001 literal 5943 zcmd^D>u=md5O?BxghibW}EC357^z(qnxRYN4CR;rp7^+P3VZSVO^eO|L( zCpkXx|M53bm_6^>>$RO%(+UYk7kg)aJFlIYeZ1Izz0-f)Hw?ox%+8!)w&Bxgzj}GF zF*JRU(2zdwn z-xXl^B(=aG!B5CILw8dju;^2g#&(DtEd9FVk}#b_wKNn4ew4XkUb2#bQkoCro$joJ zrB2~29${G^70%MyB?IOB_h$O?X%n;3g}I(JXHk2)Qk>(=16oW}lwBGT!Xm}=8t@HzWfpGk_8>9a7bK5{|;}a6WQt0Sn2G-R4C03w>8JM7(Rh`Dj5Z` zc{_K5jOh-f4L2o=lBOi8_@S4uY50G40*^2y4(7nee4hCmex*5-Sc%T&gyd%(BmM%))Oex zhz1FPf+T857T(|N2cr?DIC8NSMAp+o>lsvW>%rdcee20D58rsm_c8ri8`X_Bennv_ z){@*E=kZ@9Z~BnNO=dLKJ7GiKUy7_tsj-YGMUju~S<#dp<$+sQpyb4NB)Vc&m#?@* zMf?bxfjl{+a-~J4RQj~EdcO(ml9(yU)DkY+6$SLVOCpAX2vhqw@Yq<8R|@hN2mY7| z`mKUajxZgC09q6GA;Ol#v+987v24M73AdtJmEVrfWu-0S=-XwjsKP>)buSdUOW_(h>Y^JF!GR9TH6Rooqs z8N{2~LY^Mk4G>jS14I>cw<@S63Y$@?xMq|paglp6Mjp>Bk)&&!lrS2^JllfE4O0&T zA$0`c%UVF8x`2J2q!XwRQ=7vZl6FQyZE-%X0R|NBSPiI_bVR=o~_~<#H>}3 zWnoqoP%ARuP;BNfBbNvI$8H zYe*tFU!=*eIMcYGVy+^8@2U)EVrxOdk3?p4yFigCnU_bt>(5e z{PB?gK|#o_$i%hP*7ojw!O|S&pBLt$=ov%-3y{3iY9Bm)diZliYBT;U{WHDKRPaN< z%wg_MVU}>>%NMV76BTSXh{l)({035WeH|j>*ZI+*)^|UNY3ahnlY^-&Qs&-fK4Fh? zeROL1cBCa(_2AeJ7kCWI^GGXk;i5N_y5J&)eM03KsC`r%$}4wwe`&W5wWq}DF_!N; c5aXA_{DuJ@evpLKG1H)*?@bg0XJWkj7Z6IJR{#J2 diff --git a/data/t3_gt.rda b/data/t3_gt.rda deleted file mode 100644 index 19dbf8cfb28514b57386f88e880cc92e6c3169cf..0000000000000000000000000000000000000000 GIT binary patch literal 0 HcmV?d00001 literal 5673 zcmd^D-E-775I6CC6m;msqTbv}d7a%DM} z@YMgW{}Xg&t$ea%6GDOMOwEL|RzL0jcC}hbKKWo6 zk3Fxq290Z8&l^dhI1FL|z@19y`PbDi0Ghx-O3!FoK<{>iP{Z$@GA1T}P?Aj^{aF%D zqsc?g8K1D(?5oCYHL4&1r#MyFRYnFbm{RRKMg2w_5Lv}t7qS-1;RS~ znh6Si$Vm4zH63w-c3=1T$aN#;tjvRygjCbtoU*iBWUVriCUK_B)Dh5T8g4rQ9TuVt zS02fXP}92d$Z9uy(P17{d}RpHfgyynYF56#o|M#BMZgNZLw0ipNtQ7|ixuMmGKL>d zj+c*QEFb-A$r~OFG~tv@4gLe!EEl>n=DE>1gsCu^1L!{%raFOjg40@Ue zke$*Ml`dVm>cnAGh>P_99t4?TMjk+!s^(w*V##t=+;ufkMNkOB?K!g6{JWYfnJX4e zwV>3T8%4mOyM<}?LHUlssH!ngX4iI9G_fXJP8r>CGIk6Ls7q^IX&UQNm#;33TZD7D ztpru&vAN=cb3!`MXoulY?hdQ60x4wgfNQ!)Yid{A^XiP!&5Z@&aRPfJooR}j zDB=cft%UIi92G2wf&c{-mAJhoFSpku@Y$S_D9PfWgW#vSUnBwoV0*WxyNfbxN8Hwk zP>~Or5Ny%l-vKe5=zy4>+<``Y+$cKzX`*a@c3ZlaRsxw;=1COM4Ci4FsqeOtH)JGp63LZ?$+0U%h2TjpS6h-z(=wtUC_@B%*$P-uN7&~@xqu3B z5lDE)qTMkuO&WV3=@Y}Y+a4z~(ca=6yOA>656H;q0$%Jbyy^9cUh9z3kc1KV5wNxlDO zyd0~aEK*I4RG@~dw#Tcoff`In^L*MPrC^A9llSqn z8P8ulC(9*i8+Gq~u8*t3uTQF{4Q3ea7c8xht^R>A{K2vO2bDs73BtS5y@R7~P^Eud zzg}63!86Gckr4e=sDJX{_eT#MtKIm^_$%I*5_}&p|F{k(x`jb}eEP(8(ZCLqY)*Ls z_xVQX+Yn0M;HQvJzWW8IWeA^cLdtcK@_+okp0FQkKDM;^MX!gdMmdpR7v(2EWL`|+ zE?fUfki4_d?hm6@zho LHZc%ViTCm!GI4XD diff --git a/data/tbl_1.rda b/data/tbl_1.rda new file mode 100644 index 0000000000000000000000000000000000000000..614308957135432fd7aacc377d50d9481fff8e77 GIT binary patch literal 1620 zcmV-a2CMl(T4*^jL0KkKSrS00000$N&HU z&=~**9B63KpwXac00000WB>pFXbgY@4m31q&}h&!00000G5`PoGzLHcf=MM0Q1u3Y zXagWL&L8+rAAT-ROqedfXG8$rJ^*uc) zyw$Yv-6bL-Pb!CgMGPv1?Ib9~0RapIF%UcUI20^M+ig+MHbJ>)jRt_WrkxEzE`<`} z;zXeeg%X1xxfTNuEJx}4eUfSiiv?3hy@z-{qOaQxrUvd_u1lUI;o)wPwc9nt`Yc|2 z19_833aNBx`Qw{X++`}KFC&=#v93N?!Z<;kO=3Fhp;c|h2>>zz6h49XV31k?2Gn=s zOr&%|bp4dIe6`nfL_vO0Tzrv-wKzZ};KBj{%K!l|2*_%Jux$a=2f!T@c-XOeP(Po6 z^Jb={s7&^WY^bnBf06U6c<&xT;$Y*$gN}}{7w5m0l@CZYubNh*Pf?R`6iVD32gP+@ zzpFseP|f43qPTd#nw%$eL_q{bMoDT|Jm7*2+DzWYM*KKKlx+LWShG2r49rd(mM^T? z%4X^9TGXv1i>GZVNSL3x?RdPxs&PP2fJF}cC~|tVpa(Ppmk2Mh{Su!BD4Om8mmxkx_;(?ez4JgS10;9fm3m(Bkp9woA z?_YPyW_!nYf=V6|fou;E0S4kthQl*y0YHGE=OOH8>5fMNPrsahXz4she#YWi2`n}r zUmoz(YBnEm;B7fdmz`km@@{q)mw}li6d|BNAwmy4;Q>=KNhOO8n*wCv;lomyH6o`7 zvi%iUD219$eg;~tn3EPsm#iOLhucF~$-OR*qFfSq7sE3PePt%*@QsxQDy@AS)9w7(WC)&%c;tS}uYn zbcjY(ohEiKl(BJpOu?t>TuX{zXAotmYjI4Fz$-VG#1<}7KoE-uhgjJ#M~SQ*IL6MK*Uj)JfSc|Kz4QdGeirBVv{bCeFT5-r>(aGkKuUZ-Nrhd(@qjHVjC-l zu+~`#VF>h%1~$OeohW)bC>aC5>C=hTL%1JjbG6(wotXF#VMi4~a551bkVr}~8PEBz z$xwBP@dPsWUX@&1843nvYHSnn^nS7(fGPrA55+hZBBO=?WXTFsE(U^L0O$v`0mOrN zYBDZ8Nj4PJ!#!SO; zQ9Ry{R2to64X_de+pOb>qRB8Jfb<^m$5Gch?|0g!jIlErSwl=BNdaAqK@kwBee>lm@c5x&QTD=gu9Ur z5V$bbM#<6G-dtO)){_J0J};PmypVialECYb9z;7FM^{zMD}aZFa3S*^OUjlFx-nHfK*CE*XWj$~Utg5VlqZ!7|k!js^DLM1d>RKVL2qDIybsmczC z4!B*x3nus+v9F}&C8{(->IVXv3(^Sbp41+8JAWhG4{YQn2I;7BYrStEl{g{O$U1xv zxYh7)-;f>b&rLM+2c8bUGYWQ1hqeb2^U=!by5PF>Jw@%IdYpBZ?p}orq%W5OPT?eT zm+eb|s55{8irZx!(5Pl4%3>`hfwI++WE~5Wv3^gHer}Q?A{2rkQ>eVP2nY$4qN-GT SV37j<@pmLsg$V&Akrx2x-NgU^ literal 0 HcmV?d00001 diff --git a/data/tbl_2.rda b/data/tbl_2.rda new file mode 100644 index 0000000000000000000000000000000000000000..7bb66a7820fee44f3c4855dcff0da7d6ecb3cce0 GIT binary patch literal 1302 zcmV+x1?l=iT4*^jL0KkKS%>gQGyn#qf5iX)|Nq}-|K%?xUqrwE|L{Nn00;mB&;@<~ z1xN&dNCc53HkzhtexiCcJx>sxlgXs?)PA6isi&yK!e}yNFosW4)Wbo*13+jR02*nK z0BF-714c{`7=Qpc0B8*ZKm$!O01X;s0BFgA0}ucQ01W}4XaH%ZKmnsnfDIWiKwr{I!)nrKsM0BP!NKxi}vsi(C=WNLburplS>I2u4mf(gv-AHxz9DO9U6 zMVN$$NC;vfbqzJlz-%&TkfhY8q)vC^0aQkX2?&lbXNt|T>dS$;-6*Nc`;mx&U=zxo(yWTSp8n8P+fnWIf;UuXrAk+uP zBMb)^PTc2p-Px3gh`%_gIH$fsx)gv_OQA%R0yqz>e9t`#ZSCzd3~uCuzwPi+u=9=1 zWA=ND&vwZd?b_Dcz`JhwOf-foIg!=E$kI(IQ0hOm#UQs7+_XElcrU+j5;!6v776?Kh2p|wG3Lu`y@WO#GfnXql1sJ3dK*&V&8@N7G zzn=+TU-U4q2`#ISS<2JmtQ_BifX>e(4kL`fgFhAohPlRV73mDHSH{g2DCNY>!SHbD zxw!vhLenM;p27|NU6u#ZJ!Yfn|57j5F)55k`<*D)824Z4Tt#VfH#&FyvrTT*xt=5~ zEJ%iTcZ0jTyS&IRU0{iw*{7b#wcw}+fSk}_o$-VXjU}MdacL#ROEc08|2p7Qo#vQ> z9Yac!#S6lcv1o$gqGSXj!KiAM2MU4zezWj){aROo2of+@6CFftY9zfKCYJ0z(lr?g_yW0k57&6d{hONywL2H;=x>0`9w`tPA)o8C!%j zT!ffHJ37pabsBJy0eCjsq}+!{eLXzgCe!Ul?LyFGq*NIND$<0cuOG>FS=PcR#24*u zLd_DX>0xrfSUQ(f(s;@5W|%;*D5B5;?J}cIr6D}31(cN%4WWTdr0O*t3vU?rUU<`C z3FXuWK7+fq{~76tz0(FsL{L8FB--|e+H)b4VvvkTBz`0QyFyif%dcFE22 zna7jNqie)k4L(8BNpgi56D4d=xNTm@(TxkX??4MJ^0 z<;-&VA2Ubf{d;i(pz$KC zpfeIz02i)uJ~9;z0$(J^S<5inT1Z&~p>o*1(f6ERI5GxH#XyCCl$nAwI))gCL;s7p MBAh5lL--^b0O}B2`Tzg` literal 0 HcmV?d00001 diff --git a/data/tbl_3.rda b/data/tbl_3.rda new file mode 100644 index 0000000000000000000000000000000000000000..254e51f02c9ef9f94ef4bd85ac83e88290473db0 GIT binary patch literal 1214 zcmV;v1VQ^kT4*^jL0KkKS!A7atN;c$f5iX)|Nq)S|7R}-9zehU|L{Nn00;m9&;>p^ zXlol9)<7fzNT#MrdY(*2k|xoq>FQ5UM23%015E(aPb57F=OK+&c~nl#7^ zOb`GK0iZO<3<;1VN+z0`WB>pGpaVbv00003LyZjsMwuFD(;zW0KmarbfYTr_CP0co z38sw#X;0B7k`K_4=?0p5K+t-IfC1`g)5$gGG_-(`1QVI*JTOR5qgJChA(Gm|3P3{< z4Dpe0*fJR@h@@6`bVsx7BV zfiwt3t(x|pXEQ@`SN;^DL8}9VDU^Zy-l$0`P)IY4E}fAfz7llw_EoTmvkPfX-K5we zVwqHgNCE*-D>6uS0WAXaEvSn3DyY{E)O4|bqYNuD)=KRqI@BwpLtAwLW{r5vC>`+1 zvzZzXv2-o0IuqH+L9PxtAEz$>8tt3P}V-fbq8FgqhkS|&GY0EzbTpnI0f)-lP8QtC| zcXxMs5M=Q%O5z)wtyZ*(pi(AsF~n04I#R_lq{SFS#RArOfuBm`Do*1xL4I+iN#2FQ zNm^SFSkz3QLM{X0EK7l)AK}m4m2^P@MT8Eb0`B8E_GKgveIj}%xqEIg9uO;#Ng~Vy z_$iN;*mvX=5}aY(uxwcb{Kl;vKbpaqGemvyTsM-!T?axJ(y6rdc8F>QR2T>vfw3Lj zLzswdSV0&-K%12n!bUd2sL&D(IEYk;#s{>{PQ3MwbD9S2>6+7kD1BoBQ(77!ZDFK_#NWrj zRI#(T`o7WpBtd6cVSvCnppd4dH)|VqIfBs&mXK+wGJ*0frNEadBQiD^WElUcmXGEr z%(Xd#8QAue()E(LD*|&49i9w?M%Ma`qM@X&I>w20!e@?r=v%g(;}#Judszs zPG6x0ArEc?&cMtL`ki~dH ckpTr|C<)1+p\% + rtf_body(col_rel_width = c(3,1,3,1,3,1,3,5), + text_justification = c("l",rep("c",7)), + last_row = FALSE) \%>\% + attributes() +} + +} diff --git a/man/rtf_colheader.Rd b/man/rtf_colheader.Rd index 884ba44d..306ea4c0 100644 --- a/man/rtf_colheader.Rd +++ b/man/rtf_colheader.Rd @@ -86,3 +86,14 @@ rtf_colheader( \description{ Add column header to the table } +\examples{ +\dontrun{ +library(dplyr) # required to run examples +data(tbl_1) +tbl_1 \%>\% + rtf_colheader(colheader = "Treatment | N | Mean (SD) | N | Mean (SD) | N | + Mean (SD) | LS Mean (95\% CI)\\\\dagger") \%>\% + attr("rtf_colheader") +} + +} diff --git a/man/rtf_figure.Rd b/man/rtf_figure.Rd index 146cf6e0..191127be 100644 --- a/man/rtf_figure.Rd +++ b/man/rtf_figure.Rd @@ -32,3 +32,17 @@ rtf_figure( \description{ Add Figure Attributes } +\examples{ +\dontrun{ + library(dplyr) # required to run examples + file <- file.path(tempdir(), "figure1.png") + png(file) + plot(1:10) + dev.off() + + # Read in PNG file in binary format + rtf_read_png(file) \%>\% rtf_figure() \%>\% + attributes() +} + +} diff --git a/man/rtf_footnote.Rd b/man/rtf_footnote.Rd index 2d919ffd..8747ba76 100644 --- a/man/rtf_footnote.Rd +++ b/man/rtf_footnote.Rd @@ -59,3 +59,12 @@ rtf_footnote( \description{ Add footnote attributes to the table } +\examples{ +\dontrun{ +library(dplyr) # required to run examples +data(tbl_1) +tbl_1 \%>\% rtf_footnote("\\\\dagger Based on an ANCOVA model.") \%>\% + attr("rtf_footnote") +} + +} diff --git a/man/rtf_read_png.Rd b/man/rtf_read_png.Rd index 53f9ae01..373af233 100644 --- a/man/rtf_read_png.Rd +++ b/man/rtf_read_png.Rd @@ -12,3 +12,15 @@ rtf_read_png(file) \description{ Read PNG figures into Binary Files } +\examples{ +\dontrun{ + file <- file.path(tempdir(), "figure1.png") + png(file) + plot(1:10) + dev.off() + + # Read in PNG file in binary format + rtf_read_png(file) +} + +} diff --git a/man/rtf_source.Rd b/man/rtf_source.Rd index 1125dcd3..5e823f1c 100644 --- a/man/rtf_source.Rd +++ b/man/rtf_source.Rd @@ -59,3 +59,12 @@ rtf_source( \description{ Add data source attributes to the table } +\examples{ +\dontrun{ +library(dplyr) # required to run examples +data(tbl_1) +tbl_1 \%>\% rtf_source("Source: [study999:adam-adeff]") \%>\% + attr("rtf_source") +} + +} diff --git a/man/rtf_title.Rd b/man/rtf_title.Rd index d17f616e..ebae19a2 100644 --- a/man/rtf_title.Rd +++ b/man/rtf_title.Rd @@ -62,3 +62,12 @@ rtf_title( \description{ add title, subtitle, and other attributes to the object } +\examples{ +\dontrun{ +library(dplyr) # required to run examples +data(tbl_1) +tbl_1 \%>\% rtf_title(title = "ANCOVA of Change from Baseline at Week 8") \%>\% + attr("rtf_heading") +} + +} diff --git a/man/t1_gt.Rd b/man/tbl_1.Rd similarity index 82% rename from man/t1_gt.Rd rename to man/tbl_1.Rd index 9775cc6b..d89f90e8 100644 --- a/man/t1_gt.Rd +++ b/man/tbl_1.Rd @@ -1,14 +1,14 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/data.R \docType{data} -\name{t1_gt} -\alias{t1_gt} -\title{t1_gt} +\name{tbl_1} +\alias{tbl_1} +\title{tbl_1} \format{An object of class \code{tbl} (inherits from \code{data.frame}) with 2 rows and 8 columns.} \usage{ -t1_gt +tbl_1 } \description{ -t1_gt +tbl_1 } \keyword{datasets} diff --git a/man/t2_gt.Rd b/man/tbl_2.Rd similarity index 82% rename from man/t2_gt.Rd rename to man/tbl_2.Rd index ca24779b..e366d3bb 100644 --- a/man/t2_gt.Rd +++ b/man/tbl_2.Rd @@ -1,14 +1,14 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/data.R \docType{data} -\name{t2_gt} -\alias{t2_gt} -\title{t2_gt} +\name{tbl_2} +\alias{tbl_2} +\title{tbl_2} \format{An object of class \code{tbl} (inherits from \code{data.frame}) with 1 rows and 3 columns.} \usage{ -t2_gt +tbl_2 } \description{ -t2_gt +tbl_2 } \keyword{datasets} diff --git a/man/t3_gt.Rd b/man/tbl_3.Rd similarity index 82% rename from man/t3_gt.Rd rename to man/tbl_3.Rd index 03e544c0..7824f8a6 100644 --- a/man/t3_gt.Rd +++ b/man/tbl_3.Rd @@ -1,14 +1,14 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/data.R \docType{data} -\name{t3_gt} -\alias{t3_gt} -\title{t3_gt} +\name{tbl_3} +\alias{tbl_3} +\title{tbl_3} \format{An object of class \code{tbl} (inherits from \code{data.frame}) with 1 rows and 1 columns.} \usage{ -t3_gt +tbl_3 } \description{ -t3_gt +tbl_3 } \keyword{datasets} From de06a9f6cb9e3de056fba1399eb4269319c8a806 Mon Sep 17 00:00:00 2001 From: yilong zhang Date: Sun, 29 Mar 2020 12:07:13 -0400 Subject: [PATCH 3/4] address CRAN submission comments r2 1. add \value for all export methods 2. remove \donotrun{} for all examples 3. add details of each dataset --- R/add_attributes.R | 20 ++++++------ R/add_figure.R | 8 ++--- R/data.R | 70 ++++++++++++++++++++++++++++++++++++------ R/internal_datasets.R | 30 ------------------ R/write_rtf.R | 32 +++++-------------- data/adtte.rda | Bin 5683 -> 0 bytes man/HAMD17.Rd | 13 ++++++-- man/adae.Rd | 14 +++++++-- man/adsl.Rd | 14 +++++++-- man/adtte.Rd | 14 --------- man/rtf_body.Rd | 5 +-- man/rtf_colheader.Rd | 5 +-- man/rtf_encode.Rd | 47 ++++++++++++++++++++++++++++ man/rtf_figure.Rd | 5 +-- man/rtf_footnote.Rd | 5 +-- man/rtf_read_png.Rd | 5 +-- man/rtf_source.Rd | 5 +-- man/rtf_title.Rd | 5 +-- man/tbl_1.Rd | 6 ++-- man/tbl_2.Rd | 6 ++-- man/tbl_3.Rd | 6 ++-- man/unicode_latex.Rd | 15 +++++---- 22 files changed, 199 insertions(+), 131 deletions(-) delete mode 100644 R/internal_datasets.R delete mode 100644 data/adtte.rda delete mode 100644 man/adtte.Rd diff --git a/R/add_attributes.R b/R/add_attributes.R index 74e4bb9c..661517fa 100644 --- a/R/add_attributes.R +++ b/R/add_attributes.R @@ -39,13 +39,13 @@ #' @param new_page boolean value to indicate whether to start a new page #' @param hyphenation boolean value to indicate whether to use hyphenation #' +#' @return the same data frame \code{tbl} with additional attributes for table title +#' #' @examples -#' \dontrun{ #' library(dplyr) # required to run examples #' data(tbl_1) #' tbl_1 %>% rtf_title(title = "ANCOVA of Change from Baseline at Week 8") %>% #' attr("rtf_heading") -#' } #' #' @export rtf_title <- function(tbl, @@ -120,13 +120,13 @@ rtf_title <- function(tbl, #' @param new_page boolean value to indicate whether to start a new page #' @param hyphenation boolean value to indicate whether to use hyphenation #' +#' @return the same data frame \code{tbl} with additional attributes for table footnote +#' #' @examples -#' \dontrun{ #' library(dplyr) # required to run examples #' data(tbl_1) #' tbl_1 %>% rtf_footnote("\\dagger Based on an ANCOVA model.") %>% #' attr("rtf_footnote") -#' } #' #' @export rtf_footnote <- function(tbl, @@ -207,13 +207,13 @@ rtf_footnote <- function(tbl, #' @param new_page boolean value to indicate whether to start a new page #' @param hyphenation boolean value to indicate whether to use hyphenation #' +#' @return the same data frame \code{tbl} with additional attributes for data source of a table +#' #' @examples -#' \dontrun{ #' library(dplyr) # required to run examples #' data(tbl_1) #' tbl_1 %>% rtf_source("Source: [study999:adam-adeff]") %>% #' attr("rtf_source") -#' } #' #' @export rtf_source <- function(tbl, @@ -360,15 +360,15 @@ rtf_source <- function(tbl, #' @param text_space_after line space after text #' @param first_row boolean value to indicate whether column header is the first row of the table #' +#' @return the same data frame \code{tbl} with additional attributes for table column header +#' #' @examples -#' \dontrun{ #' library(dplyr) # required to run examples #' data(tbl_1) #' tbl_1 %>% #' rtf_colheader(colheader = "Treatment | N | Mean (SD) | N | Mean (SD) | N | #' Mean (SD) | LS Mean (95% CI)\\dagger") %>% #' attr("rtf_colheader") -#' } #' #' @export rtf_colheader <- function(tbl, @@ -531,8 +531,9 @@ rtf_colheader <- function(tbl, #' @param new_page a boolean value to indicate whether to separate grouped table into pages by sections #' @param last_row a boolean value to indicate whether the table contains the last row of the final table #' +#' @return the same data frame \code{tbl} with additional attributes for table body +#' #' @examples -#' \dontrun{ #' library(dplyr) # required to run examples #' data(tbl_1) #' tbl_1 %>% @@ -540,7 +541,6 @@ rtf_colheader <- function(tbl, #' text_justification = c("l",rep("c",7)), #' last_row = FALSE) %>% #' attributes() -#' } #' #' @export rtf_body <- function(tbl, diff --git a/R/add_figure.R b/R/add_figure.R index 4743b3e9..3458b334 100644 --- a/R/add_figure.R +++ b/R/add_figure.R @@ -19,8 +19,9 @@ #' #' @param file a vector of PNG file path #' +#' @return a list of binary data vector returned by \code{readBin} +#' #' @examples -#' \dontrun{ #' file <- file.path(tempdir(), "figure1.png") #' png(file) #' plot(1:10) @@ -28,7 +29,6 @@ #' #' # Read in PNG file in binary format #' rtf_read_png(file) -#' } #' #' @export rtf_read_png <- function(file) { @@ -42,8 +42,9 @@ rtf_read_png <- function(file) { #' @param fig_width the width of figures in inch #' @param fig_height the height of figures in inch #' +#' @return the same data frame \code{tbl} with additional attributes for figure body +#' #' @examples -#' \dontrun{ #' library(dplyr) # required to run examples #' file <- file.path(tempdir(), "figure1.png") #' png(file) @@ -53,7 +54,6 @@ rtf_read_png <- function(file) { #' # Read in PNG file in binary format #' rtf_read_png(file) %>% rtf_figure() %>% #' attributes() -#' } #' #' @export rtf_figure <- function(tbl, diff --git a/R/data.R b/R/data.R index c222eca3..dca09b10 100644 --- a/R/data.R +++ b/R/data.R @@ -15,26 +15,76 @@ # You should have received a copy of the GNU General Public License # along with this program. If not, see . -#' ADAE +#' An Adverse Event Dataset +#' +#' A dataset containing the adverse event information of a clinical trial following +#' CDISC ADaM standard. +#' +#' Definition of each variable can be found in +#' \url{https://www.cdisc.org/pilot-project-submission-package} +#' +#' @format A data frame with 1191 rows and 55 variables. +#' +#' @source \url{https://www.cdisc.org/pilot-project-submission-package} +#' "adae" -#' ADSL +#' A Subject Level Demographic Dataset +#' +#' A dataset containing the demographic information of a clinical trial following +#' CDISC ADaM standard. +#' +#' Definition of each variable can be found in +#' \url{https://www.cdisc.org/pilot-project-submission-package} +#' +#' @format A data frame with 254 rows and 51 variables. +#' +#' @source \url{https://www.cdisc.org/pilot-project-submission-package} "adsl" -#' ADTTE -"adtte" - -#' HAMD17 +#' An Efficacy Clinical Trial Data to Evaluate a Drug to Reduce Lower Back Pain +#' +#' A dataset prepared by the Drug Information Association scientific working group +#' to investigate a drug to reduce lower back pain. +#' +#' Definition of each variable can be found in \url{https://missingdata.lshtm.ac.uk/dia-working-group/} +#' +#' @format A data frame with 831 rows and 6 variables. +#' +#' @source \url{https://missingdata.lshtm.ac.uk/dia-working-group/} "HAMD17" -#' tbl_1 +#' Within Group Results from an ANCOVA Model +#' +#' A dataset containing within group results from an ANCOVA model. +#' +#' @format A data frame with 2 rows and 8 variables. "tbl_1" -#' tbl_2 +#' Between Group Results from an ANCOVA Model +#' +#' A dataset containing between group results from an ANCOVA model. +#' +#' @format A data frame with 1 row and 3 variables. "tbl_2" -#' tbl_3 +#' Root Mean Square Error from an ANCOVA model +#' +#' A dataset containing root mean square error from an ANCOVA model. +#' +#' @format A data frame with 1 row and 1 variable. "tbl_3" -#' unicode_latex +#' Dictionary of Unicode and Latex Code +#' +#' A dataset containing the mapping between unicode and latex code. +#' +#' @format A data frame with 681 rows and 3 variables. +#' \describe{ +#' \item{unicode}{unicode, UTF-8 code} +#' \item{latex}{latex, latex code} +#' \item{int}{int, Converted integer of the UTF-8 code} +#' } +#' +#' @source \url{http://milde.users.sourceforge.net/LUCR/Math/data/unimathsymbols.txt} "unicode_latex" diff --git a/R/internal_datasets.R b/R/internal_datasets.R deleted file mode 100644 index 0b1369c5..00000000 --- a/R/internal_datasets.R +++ /dev/null @@ -1,30 +0,0 @@ -# Copyright (c) 2020 Merck Sharp & Dohme Corp. a subsidiary of Merck & Co., Inc., Kenilworth, NJ, USA. -# -# This file is part of the r2rtf program. -# -# r2rtf is free software: you can redistribute it and/or modify -# it under the terms of the GNU General Public License as published by -# the Free Software Foundation, either version 3 of the License, or -# (at your option) any later version. -# -# This program is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -# GNU General Public License for more details. -# -# You should have received a copy of the GNU General Public License -# along with this program. If not, see . - -#' Unicode characters and corresponding LaTeX math mode commands -#' -#' A dataset containing the unicode, character and latex command. -#' -#' -#' @format A data frame with 2757 rows and 3 variables: -#' \describe{ -#' \item{unicode}{Unicode character number} -#' \item{chr}{literal character (UTF-8 encoded)} -#' \item{latex}{Latex command} -#' } -#' @source \url{http://milde.users.sourceforge.net/LUCR/Math/data/unimathsymbols.txt} -"unicode_latex" diff --git a/R/write_rtf.R b/R/write_rtf.R index 81a4b4a2..10a7982d 100644 --- a/R/write_rtf.R +++ b/R/write_rtf.R @@ -24,8 +24,12 @@ #' @param tbl a data frame for table or a list of binary string for figure #' @param type the type of input, default is table. #' +#' @return +#' For \code{rtf_encode}, a vector of RTF code. +#' For \code{write_rtf}, no return value. +#' #' @examples -#' \dontrun{ +#' #' library(dplyr) # required to run examples #' #' # Example 1 @@ -53,20 +57,6 @@ #' data(tbl_1) #' data(tbl_2) #' data(tbl_3) -#' t1 <- tbl_1 %>% -#' rtf_title(title = "ANCOVA of Change from Baseline at Week 8", -#' subtitle = c("Missing Data Approach", -#' "Analysis Population")) %>% -#' rtf_colheader(colheader = " | Baseline | Week 20 | Change from Baseline", -#' col_rel_width = c(3, 4, 4, 9), -#' first_row = TRUE) %>% -#' rtf_colheader(colheader = "Treatment | N | Mean (SD) | N | Mean (SD) | N | -#' Mean (SD) | LS Mean (95% CI)\\dagger") %>% -#' rtf_body(col_rel_width = c(3,1,3,1,3,1,3,5), -#' text_justification = c("l",rep("c",7)), -#' last_row = FALSE) %>% -#' rtf_footnote(footnote = "\\dagger Based on an ANCOVA model. -#' justification = "l"); #' ## convert tbl_2 to the table body. Add a table column header to table body. #' t2 <- tbl_2 %>% #' rtf_colheader(colheader = "Pairwise Comparison | @@ -75,17 +65,9 @@ #' rtf_body(col_rel_width = c(8,7,5), #' text_justification = c("l","c","c"), #' last_row = FALSE); -#' ## convert tbl_3 to the table body. Add data source to the table body. -#' t3 <- tbl_3 %>% -#' rtf_body(colheader = FALSE, -#' text_justification = "l") %>% -#' rtf_source(source = "Source: [study999:adam-adeff]", -#' justification = "l") -#' # add t1, t2, and t3 into a list in order -#' tbl <- list(t1, t2, t3) +#' #' # concatenate a list of table and save to an RTF file -#' tbl %>% rtf_encode() %>% write_rtf(file.path(tempdir(), "table2.rtf")) -#' } +#' t2 %>% rtf_encode() %>% write_rtf(file.path(tempdir(), "table2.rtf")) #' diff --git a/data/adtte.rda b/data/adtte.rda deleted file mode 100644 index 63acb27f344f12122773d37b3bf05155f840bf0f..0000000000000000000000000000000000000000 GIT binary patch literal 0 HcmV?d00001 literal 5683 zcmai1XH=63vwl;EL5hUlLx{&&)hCKWB_x{PoZ{vb-JnPNL^3U^e;l|CQGg zqUZC!4PTr@G=R)%U-_2Cm{^_Uh*P@BadjJ1f-3L{5Ngps@r2UDJ5eg+7!gdlpGfBe zio_G8U*KOTZEFTzY^}bF8nSzqdtmfIyog70c-a4nLR}ko2C1eN_*ZxUanRck*$~u0 z+CrMV03i)R+AafzZ39@DnpZOHM*gSh|8TIHO_ChX1zYYoARyEK7ZaeV326SJ1R&DC zTKvT{2PPl_7KC(h!2iD#au@9DEOJM*D*$;5pfF8dma`fFVL+KZIJzg;i=qMM7T}EI z)AaAGyP!BT?i?kEV-fDi*E`sGuY1fpC`a=(yb`}E` z3Uz5ke41AX8Kk1S^g~PTLeAu*$?CXYy8+^`I3DqU3eLBjn%VsJpXmdEqBUo zOJn(@8euk9nH+%2O_9zuPDd)@k;;5F{>FTGXt`i$c*BI#YjgK(vXa;Akep7vrBPn% zyT*^C`mzq@d|_C9g=v@D@&wDfMa^2Kb|KyC>)e9V7mLHfrMo4^cYhp6wp(5J+^T%& za`oQsbDPx4zfX58f4EZOc+m7Gu`vE=t_V-!HM-zYHEd#r=W<@eP{l3jy}oL&bDwUe z_v3nrmS%xJyXIO^5AY-F!JmpxCHxkhnlEa2*0pIWsCCX+_*nnT-0vbYNBXL2&QOyn z1|JqkVwWnR_O0cJc;bl|_QgphX?tOq4?0IH2*P0x_LlDcc3On0ZLD5ndabDm@REUT z&&<=5J$L^p50)j4owD*&^7zv1!K`$t;176H&^9|=S8)Ska{sgblgZ17>#UN#jvBMG z7q4G}I-X08@_07y)e;i0IA6XiANkYUu$AZCopXk5K^A}blVhW_!^VG9_}LPhLIPLQ z9aQJ$4Q)oN78;_Pu@}yJ-HFHEbTl6|d~8A9e`9kqW>(^&7K2{sbxSzrDiOjAWthz4dUpIMFgfgMUK2 z(zM1nZDOE@QhihsbDFE~a{D9Z)#Z=D_tnWo*Y9_=Or7iARvot!%tBdgRf{_bXNh<-upDdPalNg~&&2=>o2zkWN5zf3FzdVo& zRY}xAXuF7gVb&vrag2W9;C75}H5y~8QJ$8AnztOAZNQ>2W~fo=fsw-DMu!GAc-Du7 zQ5|M>FvJ4O5ys$se;i3Bt-ZWa%&BRKiS}(Dtju4Ol@HGG=_27>LpNr}i1~|-V{PU( zLV}7tRqcoOuNJs>mprwit)epZUB^{20)q1wRf25H1I&Gx^ri=}v|4=i#_b?ov64~Wk2+vK*Q?c=Kp2{Dm^{erxmz_btoHw|qOYc;A25+AR7GY4_w zjP~BFv&xOV`|PQr>yZ7oP%o19qF3?WPNR>!*0B~*EyWy)=Xr%W9zW#)B2s~<30Yil zD{Od6BoG8HF_ym8R%f@Y+fge-jLX{zbGunN8Ah6sN@y2C=|;^ho_j|PZB8(85s!?^ zJ7%1zhDlgL5+<%PpN5N~_4kZRAMUnudE6+U@HMEDo13myU3ulxz1Xc?PHwuq7li#> zpe>x7HQ*Pg_*|_qVBqPim83`oTa!2 z<(eRZ4mDXHs(Q%4hMN2FR-ku}xJ{EM7hNR5rbW(f>++CxnRhyz5dk+^4! znY6`ZzEx3WndIMgo)L4)I21V_e7o6dbTOR>o;B=EMn|DG6V(%~#KRT)DwT_=55&PE zPZhPycsGjP*TAfOc8U}rHL#eW?QWy1%@XYD!$zVIPIXw_9K-$fpO0G3n($p{Bk!ZC zSok7`ud2%zFQ-$lHX7nuB3jw+Ioe=z=^df)Ytp;7-8lMX1}?S8MxGLMEsJ3qtj75)s~XT7Tnp*+nA zee&bfS7u_U(@&?LVJtUwLp*j`#t7}XJb27E9TvX$3ej;Gi-FYitQw|o5nbM z&?(6{#q7U(RwW(g5Ns9l$M0X8e^{9x9{uH)JkaP=GIptic(n9>c}U$(_v(r@aIIYY za8(ifWDt%-B+PR+{%hd4W z?y|A=obU&kdv5~l`J|1K_=p!Dy5#ap_Xm>Z z?>@wQW(HI;R+)V0` zUYg+oCrg`Ho$y*y-bslK(|>xGDK$vDe*II5nQZaL;XCgCXy1Z_1<$v?{B-~1SY2u6 z*K54z`a-^k=z4~qf=TJx^c9Yu-r-oXoPuZ~8E7v&qerZ0LEOk(4XZ(rjF0QXt_I%9 z6UdQK;J`7OXNZFnm~-s@QBXAhWfTlm$Cd$%9>pFY)L--@GYZ5? z4aiTM_akuGQ?{feesOUnd6yi~+0#+W306h^MG)8Ot($<0LnwQc$6CG5@U}+Vqjh$~ zvB#;C&`2tY53`|xA%q2*bCR%-^%Ajs~W`ksY<^$xPbpSlT znj@RmP%}2<= zfzXAi5ps|c5>$59J-5j+#hP!>MxFX@}4Y6cLreNp^N=kY!*#D5|9Xu`=tOV1r%Z=+LN6+$Ev&5pkd)uN~N&YJP#iRRcZ1_Wytp04b z8ZO;OaqH`k!nK!C+RFgQ!AS#e8BrX;xRl@HpZK@VSa9P_%@9$ZMOWbsrT~>k-nH=^ z`<1_CoLpJSoN;-Cz56zE8pWLbUDhu;nz4d(TE2=+Z?0?fM1B4!;{g}iBICjADidtK@yyBN!mzuXrOSoGJ0PuUGx z7I}hh@d#QKhKX4zoF2i*VzC%3RyF0$bnV51D6hagHgD;ry4yL-I0W_^dUWnJUKZlxm=nQF=YEK`zqRJU!`-1-AY&`W zaA4SEI%un&JlJ}1xiLsXc(nkftjN>gGJ?+)zvT$bI5yW?lU-F)7OU%7@g1ytG=Z+D zrZtXKRs)MgSKp6BFQ>Om>s9EbJ88un1(^-AQ-+7r($A*#j%fQhu1&Q)Y92*cH#awz znhK6Igl%uo@S(qd8L>jmjg-Unn;YPQ#PUy-(%DRq~I`#HqUVvYlY;(Xd1R zm(k`;(;Iu_KgFbF|7OaMV#MyYEruwTEIK$)O*Z*7WPAN$MM0e`7N^r~=>jqChLN#5 zm!cc3D6jk^;$_ZDR8oMh5mBIxgmg<+94L31^e5z*%_x4&B0$p4>^4KFw zu0=a1%uXvYgVSBYRzNEx3HtcU!pPc9S^J4Xf0?9)T=Zz_lS>9mOG_PXu|aqA<0@8=KOMQ5ksJOK#&>00D zTzTkF5aora<|1`eYVk`KF(20nD$7^SaF`N9+#35>HX{b(7WNOxj5KzI)otTT30yK} z!n6ZVY8k~u14HqRnMYETBcW5X}qEk7(=9R8nLD^Yiyd#^f^_QmfT`v1wSfS0MpuuEtCoA%eZi z`oO3!vRv1;ULshurGUefa^G4hUhll{;8aUpK(pf(e_fRKQ-Z(~vZ}uOvdcns3y!a*w5@FYhUVFRKjsT*{;s0~Uf3{q=KjkZ=w!}mt$i1v|^H8=^-0bg~A zCOX@5Kt9Mba;a@F+__N9G|opXn_6fmW zJJM!X@ABLbo6-F)KBY4}rmb`4pEm)o$oFa_Cl8vkX_0!6;_E-}U0ySc{J^OY7iGaE z&v^@iq-36^Mn!>dZ&^pwgfG2Fnm{Ug@s2hb-kb|{&bsvTyPsb>LeM;*^>?>mg}Teay|leEle8HmZ^jnh*4ch59L#dVjhu@zYv z0$_-9rczsfHXmnnEah^|6+RiEO?S}!2BM2lu>}T-Up@cz+668*=vO!$R7#sL$ku&v z{ezkOEE?B?C#3v6UKth-gRH)VXelb(q$R=U(ZE7tl`CbyhI7LjD+?2paZMckTUXjK zn(Q&RB8?~4csf)lLr7ezr{T3mEHeQv3!7F;Jx{dPreY>EH!d(rY^F=w<87YbX1)#4 zLywm69E^8_B*ASHOD{*h000?`bSY&f9{b1RS%skHiHCBY`3yUKulaJagJbT2nR6&7 z8P1o~z=u>67NmGSOsbVWiCzY!H6D~j(n;*4fxf1ZKvNW_jwk@T-U)nI;> zmWl>ja(+-0++Cgs_lqwB{l@h%hu*962*xLxQcS^lYh^14!9g^U2(DZ38Uyg>745_C z=JW5vX%G88ekwiPo}RUlpoeL6b`PukH0rD3>z{@ZZ(k0b;x<7Dk0tU^lLqfNoI~dc zUAi;q=3M>B!aL~=a%DoTrn1`L`}Hcx4NUPtZ>V43c45GH+l7ma>3W~eWJb=wUw?RP zC2*AHy%@X1%U}33vdlzPHKfUxv2Ah`L_T4cO|;m88;BFmS0jatH>OXhzEa~I*lv0` zT|;cHC#%QpSu{vD4htxF`>=V%jg%wSUu_EJ^YSEJ)!Dfub)OyU;gr$+qh@(GcjG|+ ztopm|_T73Lk`2FU3eNbXq*dqVs8xerX?*59r@;p#8c0PpD-U)GcgN(O4dUFMb~Ct8 zK#@E?5mGsE()!zj>YxRy_IvNox!!-$++}Z97}>1&f~6)K5RIxu2S}#dtMNQhteotF zM-FCN7GA8n&O=i9sv>`7mOfa*Lz1`|e1#?4pC{U}rJ\% @@ -113,6 +115,5 @@ tbl_1 \%>\% text_justification = c("l",rep("c",7)), last_row = FALSE) \%>\% attributes() -} } diff --git a/man/rtf_colheader.Rd b/man/rtf_colheader.Rd index 306ea4c0..d22a00ff 100644 --- a/man/rtf_colheader.Rd +++ b/man/rtf_colheader.Rd @@ -83,17 +83,18 @@ rtf_colheader( \item{first_row}{boolean value to indicate whether column header is the first row of the table} } +\value{ +the same data frame \code{tbl} with additional attributes for table column header +} \description{ Add column header to the table } \examples{ -\dontrun{ library(dplyr) # required to run examples data(tbl_1) tbl_1 \%>\% rtf_colheader(colheader = "Treatment | N | Mean (SD) | N | Mean (SD) | N | Mean (SD) | LS Mean (95\% CI)\\\\dagger") \%>\% attr("rtf_colheader") -} } diff --git a/man/rtf_encode.Rd b/man/rtf_encode.Rd index 25c243d2..59c18716 100644 --- a/man/rtf_encode.Rd +++ b/man/rtf_encode.Rd @@ -14,7 +14,54 @@ as_rtf(tbl, type = "table") \item{type}{the type of input, default is table.} } +\value{ +\preformatted{For \code{rtf_encode}, a vector of RTF code. +For \code{write_rtf}, no return value. +} +} \description{ This function extracts table/figure attributes and render to RTF encoding that is ready to save to an RTF file. } +\examples{ + +library(dplyr) # required to run examples + +# Example 1 + head(iris) \%>\% + rtf_body() \%>\% + rtf_encode() \%>\% + write_rtf(file = file.path(tempdir(), "table1.rtf")) + +# Example 2 + library(dplyr) # required to run examples + file <- file.path(tempdir(), "figure1.png") + png(file) + plot(1:10) + dev.off() + + # Read in PNG file in binary format + rtf_read_png(file) \%>\% rtf_figure() \%>\% + rtf_encode(type = "figure") \%>\% + write_rtf(file = file.path(tempdir(), "figure1.rtf")) + +# Example 3 + +## convert tbl_1 to the table body. Add title, subtitle, two table +## headers, and footnotes to the table body. + data(tbl_1) + data(tbl_2) + data(tbl_3) + ## convert tbl_2 to the table body. Add a table column header to table body. + t2 <- tbl_2 \%>\% + rtf_colheader(colheader = "Pairwise Comparison | + Difference in LS Mean(95\% CI)\\\\dagger | p-Value", + text_justification = c("l","c","c")) \%>\% + rtf_body(col_rel_width = c(8,7,5), + text_justification = c("l","c","c"), + last_row = FALSE); + + # concatenate a list of table and save to an RTF file + t2 \%>\% rtf_encode() \%>\% write_rtf(file.path(tempdir(), "table2.rtf")) + +} diff --git a/man/rtf_figure.Rd b/man/rtf_figure.Rd index 191127be..21bec330 100644 --- a/man/rtf_figure.Rd +++ b/man/rtf_figure.Rd @@ -29,11 +29,13 @@ rtf_figure( \item{fig_height}{the height of figures in inch} } +\value{ +the same data frame \code{tbl} with additional attributes for figure body +} \description{ Add Figure Attributes } \examples{ -\dontrun{ library(dplyr) # required to run examples file <- file.path(tempdir(), "figure1.png") png(file) @@ -43,6 +45,5 @@ Add Figure Attributes # Read in PNG file in binary format rtf_read_png(file) \%>\% rtf_figure() \%>\% attributes() -} } diff --git a/man/rtf_footnote.Rd b/man/rtf_footnote.Rd index 8747ba76..9a9daa51 100644 --- a/man/rtf_footnote.Rd +++ b/man/rtf_footnote.Rd @@ -56,15 +56,16 @@ rtf_footnote( \item{hyphenation}{boolean value to indicate whether to use hyphenation} } +\value{ +the same data frame \code{tbl} with additional attributes for table footnote +} \description{ Add footnote attributes to the table } \examples{ -\dontrun{ library(dplyr) # required to run examples data(tbl_1) tbl_1 \%>\% rtf_footnote("\\\\dagger Based on an ANCOVA model.") \%>\% attr("rtf_footnote") -} } diff --git a/man/rtf_read_png.Rd b/man/rtf_read_png.Rd index 373af233..fd861b6b 100644 --- a/man/rtf_read_png.Rd +++ b/man/rtf_read_png.Rd @@ -9,11 +9,13 @@ rtf_read_png(file) \arguments{ \item{file}{a vector of PNG file path} } +\value{ +a list of binary data vector returned by \code{readBin} +} \description{ Read PNG figures into Binary Files } \examples{ -\dontrun{ file <- file.path(tempdir(), "figure1.png") png(file) plot(1:10) @@ -21,6 +23,5 @@ Read PNG figures into Binary Files # Read in PNG file in binary format rtf_read_png(file) -} } diff --git a/man/rtf_source.Rd b/man/rtf_source.Rd index 5e823f1c..2f22e3f8 100644 --- a/man/rtf_source.Rd +++ b/man/rtf_source.Rd @@ -56,15 +56,16 @@ rtf_source( \item{hyphenation}{boolean value to indicate whether to use hyphenation} } +\value{ +the same data frame \code{tbl} with additional attributes for data source of a table +} \description{ Add data source attributes to the table } \examples{ -\dontrun{ library(dplyr) # required to run examples data(tbl_1) tbl_1 \%>\% rtf_source("Source: [study999:adam-adeff]") \%>\% attr("rtf_source") -} } diff --git a/man/rtf_title.Rd b/man/rtf_title.Rd index ebae19a2..3c3f86ee 100644 --- a/man/rtf_title.Rd +++ b/man/rtf_title.Rd @@ -59,15 +59,16 @@ rtf_title( \item{hyphenation}{boolean value to indicate whether to use hyphenation} } +\value{ +the same data frame \code{tbl} with additional attributes for table title +} \description{ add title, subtitle, and other attributes to the object } \examples{ -\dontrun{ library(dplyr) # required to run examples data(tbl_1) tbl_1 \%>\% rtf_title(title = "ANCOVA of Change from Baseline at Week 8") \%>\% attr("rtf_heading") -} } diff --git a/man/tbl_1.Rd b/man/tbl_1.Rd index d89f90e8..714f5c4d 100644 --- a/man/tbl_1.Rd +++ b/man/tbl_1.Rd @@ -3,12 +3,12 @@ \docType{data} \name{tbl_1} \alias{tbl_1} -\title{tbl_1} -\format{An object of class \code{tbl} (inherits from \code{data.frame}) with 2 rows and 8 columns.} +\title{Within Group Results from an ANCOVA Model} +\format{A data frame with 2 rows and 8 variables.} \usage{ tbl_1 } \description{ -tbl_1 +A dataset containing within group results from an ANCOVA model. } \keyword{datasets} diff --git a/man/tbl_2.Rd b/man/tbl_2.Rd index e366d3bb..9819ab6e 100644 --- a/man/tbl_2.Rd +++ b/man/tbl_2.Rd @@ -3,12 +3,12 @@ \docType{data} \name{tbl_2} \alias{tbl_2} -\title{tbl_2} -\format{An object of class \code{tbl} (inherits from \code{data.frame}) with 1 rows and 3 columns.} +\title{Between Group Results from an ANCOVA Model} +\format{A data frame with 1 row and 3 variables.} \usage{ tbl_2 } \description{ -tbl_2 +A dataset containing between group results from an ANCOVA model. } \keyword{datasets} diff --git a/man/tbl_3.Rd b/man/tbl_3.Rd index 7824f8a6..fe544487 100644 --- a/man/tbl_3.Rd +++ b/man/tbl_3.Rd @@ -3,12 +3,12 @@ \docType{data} \name{tbl_3} \alias{tbl_3} -\title{tbl_3} -\format{An object of class \code{tbl} (inherits from \code{data.frame}) with 1 rows and 1 columns.} +\title{Root Mean Square Error from an ANCOVA model} +\format{A data frame with 1 row and 1 variable.} \usage{ tbl_3 } \description{ -tbl_3 +A dataset containing root mean square error from an ANCOVA model. } \keyword{datasets} diff --git a/man/unicode_latex.Rd b/man/unicode_latex.Rd index 372af464..6b2547b3 100644 --- a/man/unicode_latex.Rd +++ b/man/unicode_latex.Rd @@ -1,19 +1,22 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/data.R, R/internal_datasets.R +% Please edit documentation in R/data.R \docType{data} \name{unicode_latex} \alias{unicode_latex} -\title{unicode_latex} -\format{An object of class \code{data.frame} with 681 rows and 3 columns.} +\title{Dictionary of Unicode and Latex Code} +\format{A data frame with 681 rows and 3 variables. +\describe{ +\item{unicode}{unicode, UTF-8 code} +\item{latex}{latex, latex code} +\item{int}{int, Converted integer of the UTF-8 code} +}} \source{ \url{http://milde.users.sourceforge.net/LUCR/Math/data/unimathsymbols.txt} } \usage{ -unicode_latex - unicode_latex } \description{ -A dataset containing the unicode, character and latex command. +A dataset containing the mapping between unicode and latex code. } \keyword{datasets} From d4fc39dce6a4b76c0d30669b6c0752e1f7d1fc52 Mon Sep 17 00:00:00 2001 From: yilong zhang Date: Thu, 16 Apr 2020 16:04:13 -0400 Subject: [PATCH 4/4] remove devel checking --- .github/workflows/check-standard.yaml | 1 - 1 file changed, 1 deletion(-) diff --git a/.github/workflows/check-standard.yaml b/.github/workflows/check-standard.yaml index 39b78666..f3855a35 100644 --- a/.github/workflows/check-standard.yaml +++ b/.github/workflows/check-standard.yaml @@ -20,7 +20,6 @@ jobs: config: - {os: windows-latest, r: '3.6'} - {os: macOS-latest, r: '3.6'} - - {os: macOS-latest, r: 'devel'} - {os: ubuntu-16.04, r: '3.6', rspm: "https://demo.rstudiopm.com/all/__linux__/xenial/latest"} env: