I am trying to generate a flex table in HTML using R Markdown that has several cells that are merged across multiple rows using ReporteRs::spanFlexTableRows(). However, when I merge the cells together, the numbers displayed in the merged cells appear at the top of the cells. Moreover, the border between the two sets of (adjacent) merged cells disappears. I would like to know:
How to center the contents of each merged cell vertically, and
How to retain the border between the two merged cells
The following R script illustrates the issue I am having:
library(tidyverse)
library(ReporteRs)
mtcars[1:4,] %>%
mutate(
x = row.names(mtcars[1:4,]),
var1 = 1,
var2 = 2
) %>%
select(
x, mpg, cyl, disp, var1, var2
) %>%
make_ft %>%
spanFlexTableRows(j=5, from=1, to= 4) %>%
spanFlexTableRows(j=6, from=1, to= 4)
Thanks for your help!
I have a solution to a closely related question -- merging and vertical alignment using officer/flextable rather than ReporteRs. Since officer/flextable are intended to replace ReporteRs I think this is reasonable to post here.
Vertical alignment can intuitively be done in the github (as of 2019-02-10) version of flextable using valign():
library(tidyverse)
library(officer)
library(flextable)
mtcars[1:4,] %>%
mutate(
x = row.names(mtcars[1:4,]),
var1 = 1,
var2 = 2
) %>%
select(
x, mpg, cyl, disp, var1, var2
) %>%
flextable() %>%
flextable::merge_at(j=5, i=1:4) %>%
flextable::merge_at(j=6, i=1:4) %>%
valign(j = 5:6, valign = 'top') -> myft
myft
Vertical alignment in flextable was historically (as of 2019-02-10 CRAN version) part of the flextable::rotate() function. Here's your example:
library(tidyverse)
# library(ReporteRs)
library(officer)
library(flextable)
# turn into flextable, merge and apply a vertical alignment
# (note that center vertical alignment appears to be the default in flextables
# so despite your goals i do top alignment here)
mtcars[1:4,] %>%
mutate(
x = row.names(mtcars[1:4,]),
var1 = 1,
var2 = 2
) %>%
select(
x, mpg, cyl, disp, var1, var2
) %>%
flextable() %>%
flextable::merge_at(j=5, i=1:4) %>%
flextable::merge_at(j=6, i=1:4) %>%
rotate(j = 5:6, align = 'top', rotation = 'tblr') -> myft
# write to a docx using officer
doc = read_docx()
doc = flextable::body_add_flextable( doc, myft )
print(doc, target = "ftex.docx" )
Related
I'd like to generate small ggplot graphics and use them inline in a reactable. I can generate the plots needed (1 per row), but when inserting them into the table, they come up as broken images. I imagine it has something to do with the file paths?
Note: This will ultimately be used in a shiny app where the graphics are generated dynamically. I am doing this in reactable because I plan to combine this with the expandable rows feature.
Here is some reproducible code
library(tidyverse)
library(palmerpenguins)
library(reactable)
#get list of species names
species <- penguins %>% select(species ) %>%
distinct() %>% pull()
# make a simple df
plot_data <- penguins %>%
group_by(species) %>%
summarize(mean = mean(bill_length_mm, na.rm=T))
# for loop to generate and save plots
for(i in species){
tmp_plot <-
plot_data %>%
filter(species == i) %>%
ggplot(aes(y=species, x=mean))+
geom_col()+
theme_void()
file_name <- i %>% janitor::make_clean_names()
ggsave(plot = tmp_plot,
filename = paste0("plots/",file_name,".png"),
width=4,
height=.5)
}
#make a table
species %>%
as.data.frame() %>%
rename("species" = 1) %>%
mutate(plot = paste0("<img src='plots/", janitor::make_clean_names(species),".png' />")) %>%
reactable(
columns = list(
plot = colDef(html = TRUE,
resizable = TRUE,
show=T)
))
Here is what I get:
Just as a check, doing this loads the graphic: magick::image_read("plots/adelie.png") so I am not sure what I am missing.
Problem
I would like to produce a good looking table which has ggplots within the cells of one column. One key element is that I would like to create a pdf output of this table eventually.
What I have tried so far
Hopefully the example below is understandable. Essentially I found that I can achieve what I want using the gt package. The problem is this creates a html widget which you then have to use phantomJS and webshot to export as a pdf.
library(dplyr)
library(purrr)
library(gt)
library(ggplot2)
dat = tibble(
RowLabel = letters[1:5],
Numeric = seq(100,500,100)
) %>%
mutate(
plotData = RowLabel %>% map(function(pos){
tibble(y=runif(10)*100) %>%
arrange(desc(y)) %>%
mutate(x=row_number())
}),
plot_obj = plotData %>% map(function(df){
df %>%
ggplot(aes(x=x,y=y))+
geom_col()
}),
plot_grob = plot_obj %>% map(cowplot::as_grob)
)
tab = dat %>%
select(RowLabel, Numeric) %>%
mutate(
ggplot = NA
) %>%
gt() %>%
text_transform(
locations = cells_body(vars(ggplot)),
fn = function(x) {
dat$plot_obj %>%
map(ggplot_image, height = px(50))
}
)
tab
What do I want
I would like an output which is similar to the above example. However, I would like a solution which does not require me to use html widgets and can be saved directly as a pdf without the use of other programs. Is this possible to do using ggplot? I have started to learn more about grids/grobs/gtables etc but have not made any meaningful progress.
Thanks in advance!
Perhaps you could tweak the gtsave() function to suit? E.g.
library(dplyr)
library(purrr)
library(gt)
library(ggplot2)
dat = tibble(
RowLabel = letters[1:5],
Numeric = seq(100,500,100)
) %>%
mutate(
plotData = RowLabel %>% map(function(pos){
tibble(y=runif(10)*100) %>%
arrange(desc(y)) %>%
mutate(x=row_number())
}),
plot_obj = plotData %>% map(function(df){
df %>%
ggplot(aes(x=x,y=y))+
geom_col()
}),
plot_grob = plot_obj %>% map(cowplot::as_grob)
)
tab = dat %>%
select(RowLabel, Numeric) %>%
mutate(
ggplot = NA
) %>%
gt() %>%
text_transform(
locations = cells_body(vars(ggplot)),
fn = function(x) {
dat$plot_obj %>%
map(ggplot_image, height = px(50))
}
)
tab %>%
gt::gtsave(filename = "test.pdf", vwidth = 180, vheight = 250)
(R v4.0.3 / gt v0.2.2)
I'm trying to use kable and kableExtra to format tables created using pipes, and I can't get the conditional formatting arguments (row_spec, column_spec) to accept variables piped from the generated code.
In the toy example below I create a variable called bg within the dataframe that I want to use to create bands of background colour, but row_spec and column_spec don't seem to recognize that as a variable. Note that creating the variable outside of the pipes isn't an option - the actual use case is much more complicated than that, and the variables used in the process don't exist before that.
library(kableExtra)
set.seed(111)
df = data.frame(var1 = sort(sample(LETTERS[1:3],10,TRUE)),
var2 = sample(1:4,10,TRUE),
var3 = runif(10,0,1))
df %>%
mutate(bg = cumsum(!duplicated(var1))%%2)%>%
kable() %>%kable_styling()%>%
column_spec(1,color=bg)
Error in ensure_len_html(color, nrows, "color") : object 'bg' not found
EDIT: You can do it in two steps easily enough, so I'll include that here, as well as the resulting table that I'm looking for
d = df %>%
mutate(bg = cumsum(!duplicated(var1))%%2)
kable(d) %>% kable_styling(full_width=FALSE) %>%
row_spec(which(d$bg==1),background=grey(0.75))
This might work:
library(tidyverse)
library(kableExtra)
set.seed(111)
df = data.frame(var1 = sort(sample(LETTERS[1:3],10,TRUE)),
var2 = sample(1:4,10,TRUE),
var3 = runif(10,0,1))
df %>%
mutate(bg = cumsum(!duplicated(var1))%%2) %>%
mutate(bg = cell_spec(bg, color = spec_color(bg))) %>%
kable(escape = F) %>% kable_styling()
Output:
You may find more information here (page 16): https://haozhu233.github.io/kableExtra/awesome_table_in_pdf.pdf
Version with background color:
df %>%
mutate(bg = cumsum(!duplicated(var1))%%2) %>%
mutate(bg = cell_spec(bg, color = "white", bold = T,
background = spec_color(bg))) %>%
kable(escape = F) %>% kable_styling()
Output with background color:
I'm using R version 3.6.1 in RStudio. I have flextable version 0.5.5 and officer version 0.3.5.
I'm having difficulty with formatting my numbers in flextables within RMarkdown. By default, all numbers show up with 3 decimal places. For some of my numbers, this is fine (and actually preferred), but for others, I want to remove the decimals.
Using the advice found here I was able to adjust my table so that all numbers are rounded to the nearest whole number. My code is below (example table used for reproduciblility; otherwise formatting is the same as my current code).
ft_test <- head(iris) %>% flextable() %>%
hline(part = 'header', border = fp_border(color = "black", width = 3)) %>%
align(align ='center', part = 'all') %>%
align(j = 1, align ='left', part = 'all') %>%
set_formatter_type(fmt_double = "%.0f")
ft_test
However, I only want certain columns to be whole numbers, and other columns to still have decimals. I've tried using the j argument to call certain columns:
ft_test <- head(iris) %>% flextable() %>%
hline(part = 'header', border = fp_border(color = "black", width = 3)) %>%
align(align ='center', part = 'all') %>%
align(j = 1, align ='left', part = 'all') %>%
set_formatter_type(fmt_double = "%.0f", j = 2)
ft_test
... but then I get an error telling me j = 2 is an unused argument.
Any suggestions for how to adjust the numbers of only some columns? Thanks in advance for your help!
You can not use argument j as it is not an argument of set_formatter_type. The function is setting formatters for one or several data type. In your case, it's better to use colformat_num.
library(flextable)
library(officer)
library(magrittr)
ft_test <- head(iris) %>% flextable() %>%
hline(part = 'header', border = fp_border(color = "black", width = 3)) %>%
align(align ='center', part = 'all') %>%
align(j = 1, align ='left', part = 'all') %>%
colformat_num(j = c("Sepal.Length", "Sepal.Width",
"Petal.Length", "Petal.Width"), digits = 1)
ft_test
You can learn more about formatting content here: https://davidgohel.github.io/flextable/articles/display.html
Is there a smart way to have a horizontal border table wide when you have merged cells? (In the example below, it is not yet table wide).
Or should I write a function to calculate the correct index?
library(flextable)
library(officer)
library(dplyr)
myft <- flextable(head(mtcars),
col_keys = c("am", "carb", "gear", "mpg", "drat" ))%>%
theme_vanilla()%>%
merge_v(j = c("am"))%>%border(border.bottom = fp_border(style = "solid", width=2), i=c(3,6), part="body")
myft
Here is a code for what you want. It needs more work to be generic - the example is only adapted when column 1 is the only that has merged cells.
library(flextable)
library(officer)
library(dplyr)
bigborder <- fp_border(style = "solid", width=2)
myft <- flextable(head(mtcars),
col_keys = c("am", "carb", "gear", "mpg", "drat" ))%>%
theme_vanilla()%>%
merge_v(j = c("am"))
# here starts the trick
row_loc <- rle(cumsum( myft$body$spans$columns[,1] ))$values
myft <- myft %>%
border(border.bottom = bigborder, i=row_loc, j = 2:5, part="body")
myft <- myft %>%
border(border.bottom = bigborder,
i = myft$body$spans$columns[,1] > 1, j = 1, part="body") %>%
border(border.bottom = bigborder, border.top = bigborder, part = "header")
myft
A much simpler solution is to add a column that indicates which rows need a bottom border and then add an hline() with a row selection that uses that value. That helper selection can be kept out of the table by only selecting the columns you want to show in the original flextable specification using col_keys.
library(tidyverse)
library(flextable)
your_flextable = tibble(
col_group = rep(letters[1:3], each = 3),
the_value = rnorm(length(col_group))
) %>%
group_by(col_group) %>%
mutate(
is_last_val_in_group = row_number() == max(row_number())
) %>%
flextable(col_keys = c('col_group', 'the_value')) %>%
merge_v(j = 'col_group') %>%
hline(i = ~is_last_val_in_group == TRUE, border = fp_border()) %>%
fix_border_issues()