More flexibility in how a fully-merged header stretches columns

[D3SL]

I have to repeatedly fill in and save a lot of basic and repetitive forms for logging purposes. Shiny and Flextable are perfect for this but I ran into a formatting issue I think is a limitation in flextable itself: When all cells are merged in the Header row, and the table is set to autofit, the first column will be expanded to fit long headers. In cases like mine where the first column is basically just labels it'd be preferable to be able to lock or ignore that column and let the other(s) expand instead.

I did find a workaround by leaving the header row unmerged and using only the second cell, but it's a bit awkward in practice to have the label uncentered.

Example illustrations:

If I use a fully merged header row with a long title	.
Who	actual content
What
When

	Two cell workaround
Who	actual content
What
When

[davidgohel]

Is this option ok for you?

library(magrittr)
library(flextable)

dat <- data.frame(
  `If I use a fully merged header row with a long title` = c("Who", "What", "Whyyy"),
  dummy_title = 1:3,
  check.names = FALSE
)

flextable(dat) %>% 
  autofit(part = "body")

I 'd like to add a column selector j in function autofit(). That may help...

[jmobrien]

+1 on this. Though in my use case, what I actually would hope for is for the autofitting to take into account the merged cells can share space across the 2 cols, for example:

dat <- 
  data.frame(
  `Header should span 2 cols` = c("Whoooo", "Whaaaat", "Whyyyyy"),
  dummy_title = c("Whoooo", "Whaaaat", "Whyyyyy"),
  check.names = FALSE
  )
  
longheader <- 
  flextable(dat) %>% 
    autofit(part = "body") %>% 
    set_header_labels(dummy_title = "") %>% 
    merge_at(i = 1, j = 1:2, part = "header")

longheader %>% 
  width(1:2, 1)

versus what we get w/autofitting:

longheader %>% 
  autofit()

It does seems like you could do something like

• Run auto width estimates on n columns spanned by merged cell(s), excluding those merged cells
• Sum the width of those n columns to create a total width
• Estimate width for merged cell(s) separately
• Compare total width vs merged width:
  • If merged <= total, do nothing (merged cell content will just fill the space)
  • If merged >= total, then recalculate the relevant column widths, like:
    • (easy) divide equally, i.e., all columns become (merged width)/n
    • (bit harder) keep between column ratios, i.e., each column is multiplied by (merged/total)

But I'm not sure how annoying/computationally expensive it would be--esp. considering more complex merging schemes (like if someone had 3 separate merges spanning cols 1:2, 2:3, & 1:3 respectively).

[davidgohel]

@jmobrien, can you PR what you're suggesting?

It seems to me that autofit(part = "body") work in your case whereas you seemed to say we should implement a totally new (and quite complex) calculation that produces the same result to me, no? Maybe I misunderstood something. Best would be to see your function to spot differences with autofit(part = "body"). Can you share it?

[davidgohel]

I forgot to say also there is an alternative to fixed-width layouts that works well with HTML (and Word) that can be set with set_table_properties(layout = "autofit"):

library(magrittr)
library(flextable)
dat <- 
  data.frame(
    `Header should span 2 cols` = c("Whoooo", "Whaaaat", "Whyyyyy"),
    dummy_title = c("Whoooo", "Whaaaat", "Whyyyyy"),
    check.names = FALSE
  )

longheader <- 
  flextable(dat) %>% 
  autofit(part = "body") %>% 
  set_header_labels(dummy_title = "") %>% 
  merge_at(i = 1, j = 1:2, part = "header")

longheader %>% 
  set_table_properties(layout = "autofit", width = 0)

See https://ardata-fr.github.io/flextable-book/layout.html#tabwidth

[jmobrien]

@jmobrien, can you PR what you're suggesting?

It seems to me that autofit(part = "body") work in your case whereas you seemed to say we should implement a totally new (and quite complex) calculation that produces the same result to me, no? Maybe I misunderstood something. Best would be to see your function to spot differences with autofit(part = "body"). Can you share it?

Yes, limiting autofitting to the body content would work in that example. But in a plausible alternative like, say, 2 header rows where the upper one was merged (something I would do a lot), you'd still have this issue.

I could probably put together a decent draft PR for this without too much trouble. The challenge for me though would be to figure out where's the best place to look within a flextable object to identify what cells are merged so the calculation might be adjusted around it. I don't know the object internal structure all that well, so for efficiency's sake can you point me in the right direction?

EDIT: looks like it's the spans element, yes?

[jmobrien]

Also, I will say this other approach does seems promising and I'll try this out. Though of course it might be nice to have something that works consistently across all output cases, so I'll put a bit into it if I can.

(Also, FWIW, I also already have a simple tool that adjusts width autofitting to account for newlines; if you like, I can toss that in too with any PR.)

[davidgohel]

Hi,

Sure, I can show a direction. It will be easier.

This is a draft I was playing with. It shows how to fortify the part we may need and then do a simple treatment. It returns a data.frame with a row per cell (not a clean code, but enough to figure out how things work or to ask questions).

library(data.table)
library(flextable)

zz <- qflextable(head(iris))
zz <- merge_at(zz, j = 1:2, part = "header")
zz

guessed_size <- function( x ){
  
  txt_data <- flextable:::as_table_text(x)
  spans <- flextable:::fortify_span(x)
  
  fontsize <- txt_data$font.size
  fontsize[!(txt_data$vertical.align %in% "baseline")] <- 
    fontsize[!(txt_data$vertical.align %in% "baseline")]/2
  
  str_extents_ <- gdtools::m_str_extents(txt_data$txt, fontname = txt_data$font.family,
                                fontsize = fontsize, bold = txt_data$bold,
                                italic = txt_data$italic) / 72
  str_extents_[!is.finite(str_extents_)] <- 0
  dimnames(str_extents_) <- list(NULL, c("width", "height"))
  
  z_w <- aggregate(str_extents_[,1],
                   list(part = txt_data$part,
                        ft_row_id = txt_data$ft_row_id,
                        col_id = txt_data$col_id),
                   sum)
  names(z_w)[4] <- "width"
  z_h <- aggregate(str_extents_[,2],
                   list(part = txt_data$part,
                        ft_row_id = txt_data$ft_row_id,
                        col_id = txt_data$col_id),
                   max)
  names(z_h)[4] <- "height"
  setDT(z_w)
  setDT(z_h)
  z <- merge(z_w, z_h, by = c("part", "ft_row_id", "col_id"))
  z <- merge(z, spans, by = c("part", "ft_row_id", "col_id"))
  setorderv(z, cols = c("part", "ft_row_id", "col_id"))
  
  
  # example of specific treatment ----
  z[rowspan != 1, c("width", "height") := 0]
  z[colspan != 1, c("width", "height") := 0]
  
  setDF(z)
  
  z
}

guessed_size(zz)

PS: autofitting to account for newlines would be welcome!

[jmobrien]

Huh.

I was about to post the below as a simple example of newline adjustment for discussion. It was working on the current CRAN package version, but then I went ahead and started setting it up as a draft PR instead, so autofit could use it and I could review the difference in output. After pulling from upstream in preparation for that, this approach didn't work anymore.

The issue seems to be that fortified output from as_table_rows now has table rows with newline on separate rows with <br> in between. I think that's from c07931b making changes to fortify_content.

Seems like those recent commits are important as part of a bigger plan though? So I guess this approach is outdated now. Leaving this here just for illustration purposes, in case you want to try it out with the current CRAN version.

library(data.table)
library(flextable)

guessed_size <- function( x, .newline_adj = FALSE ){
  
  txt_data <- flextable:::as_table_text(x)
  spans <- flextable:::fortify_span(x)
  
  fontsize <- txt_data$font.size
  fontsize[!(txt_data$vertical.align %in% "baseline")] <- 
    fontsize[!(txt_data$vertical.align %in% "baseline")]/2
  
  if(.newline_adj) {
    str_extents_pre1 <-
      mapply(
        FUN = gdtools::m_str_extents,
        x = strsplit(txt_data$txt, "\n"),
        fontname = txt_data$font.family,
        fontsize = fontsize, 
        bold = txt_data$bold,
        italic = txt_data$italic
      ) 
    
    str_extents_pre2 <-
      lapply(
        str_extents_pre1,
        function(x){
          w <- max(x[,1]) # Widest of the elements in each set:
          h <- sum(x[,2]) # Sum of heights
          return(matrix(c(w, h), nrow = 1))
        }
      )
    
    str_extents_ <-
      do.call(rbind, str_extents_pre2) / 72
    
  } else { 
    str_extents_ <- 
      gdtools::m_str_extents(txt_data$txt, fontname = txt_data$font.family,
                                           fontsize = fontsize, bold = txt_data$bold,
                                           italic = txt_data$italic) / 72
    
  }
  str_extents_[!is.finite(str_extents_)] <- 0
  dimnames(str_extents_) <- list(NULL, c("width", "height"))
  
  z_w <- aggregate(str_extents_[,1],
                   list(part = txt_data$part,
                        ft_row_id = txt_data$ft_row_id,
                        col_id = txt_data$col_id),
                   sum)
  names(z_w)[4] <- "width"
  z_h <- aggregate(str_extents_[,2],
                   list(part = txt_data$part,
                        ft_row_id = txt_data$ft_row_id,
                        col_id = txt_data$col_id),
                   max)
  names(z_h)[4] <- "height"
  setDT(z_w)
  setDT(z_h)
  z <- merge(z_w, z_h, by = c("part", "ft_row_id", "col_id"))
  z <- merge(z, spans, by = c("part", "ft_row_id", "col_id"))
  setorderv(z, cols = c("part", "ft_row_id", "col_id"))
  
  
  # example of specific treatment ----
  z[rowspan != 1, c("width", "height") := 0]
  z[colspan != 1, c("width", "height") := 0]
  
  setDF(z)
  
  z
}

# Name line breaks since they're way longer than the content:
names(iris) <- c("Sepal\nLength", "Sepal\nWidth", 
                  "Petal\nLength", "Petal\nWidth", 
                  "Species")

# also have a long entry:
iris$Species <- as.character(iris$Species)
iris$Species[1] <- "Setosa\nSetosa\nStill just a Setosa"

zz <- qflextable(head(iris))
zz

guessed_size(zz)[c(1:4, 10),]
guessed_size(zz, .newline_adj = TRUE)[c(1:4, 10),]

[davidgohel]

The new version now handle new lines (\n) when computing the columns widths. I also added to autofit() and dim_pretty() an argument hspans to help specify how horizontally spanned cells should affect the results.

#' @param hspans specifies how cells that are horizontally are included in the calculation.
#' It must be one of the following values "none", "divided" or "included". If
#' "none", widths of horizontally spanned cells is set to 0 (then do not affect the
#' widths); if "divided", widths of horizontally spanned cells is divided by
#' the number of spanned cells; if "included", all widths (included horizontally
#' spanned cells) will be used in the calculation.

As an illustration:

library(flextable)

x <- data.frame(
  Species = as.factor(c("setosa", "versicolor", "virginica")),
  `Sepal\nLength\nmean` = c(5.006, 5.936, 6.588),
  Sepal.Length_sd_______aaaaaaaaaaaaaaa = c(0.35249, 0.51617, 0.63588),
  Sepal.Width_mean = c(3.428, 2.77, 2.974),
  Sepal.Width_sd = c(0.37906, 0.3138, 0.3225),
  Petal.Length_mean = c(1.462, 4.26, 5.552),
  Petal.Length_sd = c(0.17366, 0.46991, 0.55189),
  check.names = FALSE
)

ft_1 <- flextable(x)
ft_1 <- colformat_double(ft_1, digits = 2)
ft_1 <- add_header_lines(ft_1, values = "blah blah blah blah blah blah blah blah blah blah")
ft_1 <- merge_at(ft_1, i = 2, j = 2:3, part = "header")
ft_1 <- theme_box(ft_1)
ft_1 <- autofit(ft_1, hspans = "included")# previous version
ft_1

ft_1 <- autofit(ft_1)# new version
ft_1

Hope it will help

@jmobrien thanks for your inputs, they have been used and helped to find something better! I am closing the issue as solved and I will close your PR that has been used as inspiration. Let me know if you think it should not be closed

[jmobrien]

Hey, life happened so apologies for not getting back to you. I've tested this out and it's a great improvement. Thanks!

[davidgohel]

thanks for the feedback (and no problem for the time)

next step, we'll try to add a max-width limit, in #411

[github-actions]

This old thread has been automatically locked. If you think you have found something related to this, please open a new issue and link to this old issue if necessary.