initial commit

.Rbuildignore

@@ -0,0 +1,4 @@
+^ftExtra\.Rproj$
+^\.Rproj\.user$
+^LICENSE\.md$
+^README\.Rmd$

.gitignore

@@ -0,0 +1 @@
+.Rproj.user

DESCRIPTION

@@ -0,0 +1,27 @@
+Package: ftExtra
+Title: Helper Functions For Flextable
+Version: 0.0.0.9000
+Authors@R: 
+    person(given = "Atsushi",
+           family = "Yasumoto",
+           role = c("aut", "cre"),
+           email = "[email protected]",
+           comment = c(ORCID = "0000-0002-8335-495X"))
+Description: What the package does (one paragraph).
+License: MIT + file LICENSE
+Encoding: UTF-8
+LazyData: true
+Imports:
+    dplyr,
+    jsonlite,
+    flextable,
+    tidyr,
+    purrr,
+    magrittr,
+    rmarkdown,
+    stringr,
+    tidyselect
+Suggests: 
+    testthat (>= 2.1.0)
+Roxygen: list(markdown = TRUE)
+RoxygenNote: 7.0.2

LICENSE

@@ -0,0 +1,2 @@
+YEAR: 2020
+COPYRIGHT HOLDER: Atsushi Yasumoto

LICENSE.md

@@ -0,0 +1,21 @@
+# MIT License
+
+Copyright (c) 2020 Atsushi Yasumoto
+
+Permission is hereby granted, free of charge, to any person obtaining a copy
+of this software and associated documentation files (the "Software"), to deal
+in the Software without restriction, including without limitation the rights
+to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
+copies of the Software, and to permit persons to whom the Software is
+furnished to do so, subject to the following conditions:
+
+The above copyright notice and this permission notice shall be included in all
+copies or substantial portions of the Software.
+
+THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
+SOFTWARE.

NAMESPACE

@@ -0,0 +1,6 @@
+# Generated by roxygen2: do not edit by hand
+
+export("%>%")
+export(colformat_md)
+export(span_header)
+importFrom(magrittr,"%>%")

R/ast2df.R

@@ -0,0 +1,39 @@
+add_type <- function(x, t) {
+  x$t <- c(x$t, t)
+  x
+}
+
+resolve_type <- function(x) {
+  if (is.atomic(x$c)) return(x)
+  if (identical(names(x$c), c('t', 'c'))) {
+    return(add_type(x$c, x$t))
+  }
+  return(lapply(x$c, add_type, x$t))
+}
+
+flatten_branch <- function(x) {
+  x %>%
+    lapply(resolve_type) %>%
+    purrr::map_if(function(x) is.character(names(x)), list) %>%
+    unlist(recursive = FALSE)
+}
+
+flatten_ast <- function(x, n = -1) {
+  n <- purrr::vec_depth(x) / 2 - 1.5 # (vec_depth(x) - 1) / 2 - 1
+  purrr::compose(!!!rep(list(flatten_branch), n))(x)
+}
+
+branch2list <- function(x) {
+  c(
+    txt = if (is.null(x$c)) ' ' else x$c,
+    as.list(stats::setNames(rep(TRUE, length(x$t)), x$t))
+  )
+}
+
+ast2df <- function(x) {
+  x$blocks %>%
+    flatten_ast() %>%
+    lapply(branch2list) %>%
+    dplyr::bind_rows() %>%
+    dplyr::mutate_if(is.logical, dplyr::coalesce, FALSE)
+}

R/colformat.R

@@ -0,0 +1,14 @@
+#' Format character columns as markdown text
+#'
+#' @param x A `flextable` object
+#'
+#' @export
+colformat_md <- function(x) {
+  body <- x$body$dataset
+  j = names(body)[vapply(body, is.character, NA)]
+  if (length(j) == 0) return(x)
+  flextable::compose(
+    x, i = seq(nrow(body)), j = j,
+    value = parse_md(unlist(body[j], use.names = FALSE)), part = 'body'
+  )
+}

R/ftExtra.R

@@ -0,0 +1,3 @@
+#' @importFrom magrittr %>%
+#' @export
+magrittr::`%>%`

R/md2ast.R

@@ -0,0 +1,19 @@
+md2ast = function(x) {
+  tf = tempfile()
+  writeLines(x, tf)
+  jsonlite::fromJSON(
+    system(
+      paste(
+        rmarkdown::pandoc_exec(),
+        tf,
+        '--to json'
+      ),
+      intern = TRUE
+    ),
+    simplifyVector = FALSE
+  )
+}
+
+
+
+

R/parse-md.R

@@ -0,0 +1,31 @@
+header <- flextable::as_paragraph('')[[1L]][-1L, ]
+
+`%||%` <- function(e1, e2) {
+  if (is.null(e1)) return(e2)
+  e1
+}
+
+vertical_align <- function(sup, sub) {
+  .f <- rep(FALSE, max(1, length(sup), length(sub)))
+  sup <- sup %||% .f
+  sub <- sub %||% .f
+  dplyr::if_else(
+    sub, 'subscript', dplyr::if_else(sup, 'superscript', NA_character_)
+  )
+}
+
+parse_md_ <- function(x) {
+  y <- x %>% md2ast %>% ast2df %>% as.list
+
+  dplyr::bind_rows(
+    header,
+    data.frame(
+      txt = y$txt,
+      italic = y$Emph %||% NA,
+      bold = y$Strong %||% NA,
+      vertical.align = vertical_align(y$Superscript, y$Subscript)
+    )
+  )
+}
+
+parse_md <- function(x) structure(lapply(x, parse_md_), class = 'paragraph')

R/span-header.R

@@ -0,0 +1,38 @@
+#' Span flextable's header
+#'
+#' @param x A `flextable` object`
+#' @inheritParams tidyr::separate
+#' @inheritParams flextable::flextable
+#' @param ... Passed to `theme_fun`
+#'
+#' @export
+span_header <- function(
+  x, sep = '[_\\.]', theme_fun = flextable::theme_booktabs, ...
+) {
+  header <- names(x$header$dataset)
+
+  mapping <- data.frame(original = header, stringsAsFactors = FALSE) %>%
+    tidyr::separate(
+      'original',
+      paste0('level', seq(max(stringr::str_count(header, sep) + 1))),
+      sep = sep, fill = 'right', remove = FALSE
+    ) %>%
+    tidyr::pivot_longer(
+      tidyselect::starts_with('level'),
+      names_to = 'var',
+      names_prefix = 'level',
+      names_ptypes = integer(),
+      values_to = 'val'
+    ) %>%
+    tidyr::fill('val') %>%
+    tidyr::pivot_wider(
+      'original', names_from = 'var', values_from = 'val', names_prefix = 'level'
+    )
+
+  x %>%
+    flextable::set_header_df(mapping, key = 'original') %>%
+    flextable::merge_h(part = 'header') %>%
+    flextable::merge_v(part = 'header') %>%
+    theme_fun(...) %>%
+    flextable::fix_border_issues()
+}

README.Rmd

@@ -0,0 +1,70 @@
+---
+output: github_document
+---
+
+<!-- README.md is generated from README.Rmd. Please edit that file -->
+
+```{r, include = FALSE}
+library(knitr)
+knitr::opts_chunk$set(
+  collapse = TRUE,
+  comment = "#>",
+  fig.path = "man/figures/README-",
+  out.width = "100%"
+)
+
+render_html <- function(x, options, ...) {
+  to <- if (is.null(options$to)) tempfile(fileext = '.png') else options$to
+  flextable::save_as_image(x, to, webshot = 'webshot2')
+  knit_print(include_graphics(to))
+}
+
+dir.create('inst/image', showWarnings = FALSE, recursive = TRUE)
+```
+
+# ftExtra
+
+<!-- badges: start -->
+<!-- badges: end -->
+
+The ftExtra package provides helper functions for the flextable package: 
+
+* `colformat_md` parses markdown texts in columns
+* `span_header` makes multi-level headers
+
+## Installation
+
+``` r
+remotes::install_github("atusy/ftExtra")
+```
+
+## Example
+
+```{r example, results='hide'}
+library(flextable)
+library(ftExtra)
+```
+
+### Parse markdown texts
+
+```{r, render = render_html, to = 'inst/image/ft_colformat_md.png'}
+data.frame(
+  x = c("**bold**", "*italic*"),
+  y = c("^superscript^", "~subscript~"),
+  z = c("***~ft~^Extra^** is*", "*Cool*"),
+  stringsAsFactors = FALSE
+) %>%
+  flextable::flextable() %>%
+  ftExtra::colformat_md()
+```
+
+
+### Span headers
+
+```{r, render = render_html, to = 'inst/image/ft_span_headers.png'}
+iris %>%
+  head %>%
+  flextable::flextable() %>%
+  ftExtra::span_header()
+```
+

README.md

@@ -0,0 +1,52 @@
+
+<!-- README.md is generated from README.Rmd. Please edit that file -->
+
+# ftExtra
+
+<!-- badges: start -->
+
+<!-- badges: end -->
+
+The ftExtra package provides helper functions for the flextable package:
+
+  - `colformat_md` parses markdown texts in columns
+  - `span_header` makes multi-level headers
+
+## Installation
+
+``` r
+remotes::install_github("atusy/ftExtra")
+```
+
+## Example
+
+``` r
+library(flextable)
+library(ftExtra)
+```
+
+### Parse markdown texts
+
+``` r
+data.frame(
+  x = c("**bold**", "*italic*"),
+  y = c("^superscript^", "~subscript~"),
+  z = c("***~ft~^Extra^** is*", "*Cool*"),
+  stringsAsFactors = FALSE
+) %>%
+  flextable::flextable() %>%
+  ftExtra::colformat_md()
+```
+
+<img src="inst/image/ft_colformat_md.png" width="100%" />
+
+### Span headers
+
+``` r
+iris %>%
+  head %>%
+  flextable::flextable() %>%
+  ftExtra::span_header()
+```
+
+<img src="inst/image/ft_span_headers.png" width="100%" />

ftExtra.Rproj

@@ -0,0 +1,21 @@
+Version: 1.0
+
+RestoreWorkspace: No
+SaveWorkspace: No
+AlwaysSaveHistory: Default
+
+EnableCodeIndexing: Yes
+UseSpacesForTab: Yes
+NumSpacesForTab: 2
+Encoding: UTF-8
+
+RnwWeave: Sweave
+LaTeX: pdfLaTeX
+
+AutoAppendNewline: Yes
+StripTrailingWhitespace: Yes
+
+BuildType: Package
+PackageUseDevtools: Yes
+PackageInstallArgs: --no-multiarch --with-keep.source
+PackageRoxygenize: rd,collate,namespace