I am loving flextable however, incorporating it within my workflow is causing issues in that I am not able to write general purpose functions.
I want a function that would automatically highlight the header and the last row of the table. I am able to do this but I have to specify the name of the first column name. This is simply too much work, is there a work around?
library(tidyverse)
require(flextable)
require(rlang)
# Function that works
my_table <- function(x){
require(flextable)
require(rlang)
x %>%
flextable() %>%
# Header colour and bold
bg(bg = "#e05297", part = "header") %>%
flextable::color(color = "white", part = "header") %>%
# Last row bold and highlight
bold(i = ~rowname == "Total", bold = TRUE) %>%
bg(i = ~rowname == "Total",
bg = "grey",
part = "body")
}
mtcars %>%
rownames_to_column() %>%
adorn_totals("row") %>%
my_table()
# This is a general purpose function which is not working
my_table <- function(x){
require(flextable)
require(rlang)
first_col_name <- colnames(x) %>% .[1]
x %>%
flextable() %>%
# Header colour and bold
bg(bg = "#e05297", part = "header") %>%
flextable::color(color = "white", part = "header") #%>%
# Last row bold and highlight
bold(i = ~eval(rlang::sym(first_col_name)) == "Total", bold = TRUE) %>%
bg(i = ~eval(rlang::sym(first_col_name)) == "Total",
bg = "grey",
part = "body")
}
Any ideas how to make the general purpose my_table function to work
i argument also accepts position (row number) of the dataframe to highlight so you may use nrow to get the last row in the dataframe.
library(flextable)
library(janitor)
my_table <- function(x){
x %>%
flextable() %>%
# Header colour and bold
bg(bg = "#e05297", part = "header") %>%
flextable::color(color = "white", part = "header") %>%
bold(i = nrow(x), bold = TRUE) %>%
bg(i = nrow(x),bg = "grey",part = "body")
}
mtcars %>%
rownames_to_column() %>%
adorn_totals("row") %>%
my_table()
Related
I've finally made my dream table with kableExtra, but it's doing very weird things with kable_styling(latex_options=c("repeat_header")), where it's writing the headings over my column labels. Here I'm using the example dataset diamonds. It is also moving the first column below where it should be (red arrows in picture).
(Also can't download LaTex because of work authorization issues, so that's not an option)
Thanks for all the help!
library(knitr)
library(kableExtra)
library(dplyr)
options(
knitr.table.toprule = '\\toprule',
knitr.table.midrule = '\\midrule',
knitr.table.bottomrule = '\\bottomrule'
)
df1 <- read.csv("diamonds.csv")
a11<-df1%>%
group_by(cut, color, clarity)%>%
summarize_at( .vars=c("price"),
.funs=~mean(.,na.rm=TRUE)) %>%
mutate(sort = 3)
b11<-df1%>%
group_by(cut, color) %>%
summarize_at( .vars=c("price"),
.funs=~mean(.,na.rm=TRUE)) %>%
mutate(clarity="", sort = 2) %>%
select(cut, color, clarity,everything())
c11<-df1 %>%
group_by(cut) %>%
summarize_at( .vars=c("price"),
.funs=~mean(.,na.rm=TRUE)) %>%
mutate(color="", clarity= "", sort = 1) %>%
select(cut, color,everything())
table3<-rbind(a11,b11,c11)
table3%>%
arrange(cut, color, clarity) %>%
select(-sort)%>%
filter(price>=3000)%>%
kbl(
caption = "Table",
longtable=T, booktabs=T) %>%
add_header_above(header = c("Table 1." = 4))%>%
kable_styling(latex_options=c("repeat_header"))%>%
kable_paper(full_width = F) %>%
column_spec(1, bold = T) %>%
column_spec(3, italic = T) %>%
collapse_rows(columns = 1:3, valign = "top")
Is there any way to set a {gt} table header to a specific height?
I have a collection of tables, all with same width. Depending on how long is the text on the title, it breaks a line and the header height increases. It is great for a single table, but I need each table in the collection to match their heights.
At the moment, I am able to add the option heading.padding = 20, but this is added also when the line is broken. I can set it to be applied only when the title has more than n characters, but it won't work to a generic case - besides, it's not elegant. I took some shots using gt::html() but no success yet.
Here's an example:
require(dplyr)
require(gt)
iris %>%
select(1,2) %>%
gt() %>%
tab_header(title = "Test") %>%
tab_options(heading.padding = 20,
table.width = 10)
iris %>%
select(1,2) %>%
gt() %>%
tab_header(title = "Testing a longer title to set the height") %>%
tab_options(heading.padding = 20,
table.width = 10)
Both tables above should have the same height. Any tips to achieve that will be appreciated.
Thanks in advance!
EDIT:Added option 2
Try using this function that will change the heading.padding
Option 1: according to the number of characters in your title:
require(dplyr)
require(gt)
Create.table <- function(title) {
if (nchar(title) > 22) {
my.table <- iris %>%
select(1, 2) %>%
gt() %>%
tab_header(title = title) %>%
tab_options(heading.padding = "inherit",
table.width = 10)
} else {
my.table <- iris %>%
select(1, 2) %>%
gt() %>%
tab_header(title = title) %>%
tab_options(heading.padding = 14.46,
table.width = 10)
return(my.table)
}
}
tbl1 <- Create.table(title = "Testing a longer title to set the height")
tbl2 <- Create.table(title = "Test")
Option 2: Add line breaks to your title (from #Rodrigo Salvador's comment).
In this case we need the package stringr to look for line breaks:
require(dplyr)
require(gt)
require(stringr)
Create.table <- function(title) {
if (str_count(title, '<br>') > 0) {
my.table <- iris %>%
select(1, 2) %>%
slice_head() %>%
gt() %>%
tab_header(title = md(title)) %>% # markdown title
tab_options(heading.padding = "inherit",
table.width = 10)
} else {
my.table <- iris %>%
select(1, 2) %>%
slice_head() %>%
gt() %>%
tab_header(title = md(title)) %>%
tab_options(heading.padding = 14.46,
table.width = 10)
return(my.table)
}
}
tbl1 <- Create.table(title = "Testing a longer title <br>to set the height")
tbl2 <- Create.table(title = "Test")
tbl3 <- Create.table(title = "Loooooooooooooooooooooooooooooooooooooooooong")
I am using flextable and officer in my shiny app to allow users to create powerpoint slides from the app. I am having a bit of a problem with flextable adjusting itself to the dimensions of the placeholder specified in the slide master of my ppt template.
Also I am aware that autofit in flextable does not work for pptx.
Below are two examples, in the first example (with the mtcars data) the table seems to be fine in terms of automatically adjusting the font sizes to match the width and height given.
df <- as_tibble(mtcars, rownames = "cars") %>%
mutate(Date = as.Date("2020-01-01"))
select(-4,5)
flextable::flextable(df) %>%
fit_to_width(max_width = 5.928819) %>%
height(height = 4.6319444/nrow(df)) %>%
color(i=~str_detect(cars,"Merc"), j=~cars, color = "red", part = "body") %>%
bg(i = ~str_detect(cars,"Merc"), j=~cars, bg="black", part = "body") %>%
color(i=~str_detect(cars,"Hornet"), j=~cars, color = "blue", part = "body") %>%
color(i=~mpg < 20, j=~mpg, color = "green", part = "body") %>%
#my_theme() %>%
print(preview = "pptx")
However in the second example with the air quality data the table is always longer that the height specified and the font size does not automatically adjust. Can anyone shed light on why one table works but the other doesnt?
df4 <- mutate(airquality, Ozone = 1000*Ozone) %>%
head(30) %>%
mutate(word = "ABCDEF")
flextable::flextable(df4) %>%
fit_to_width(max_width = 5.9288199) %>%
height(height =4.6319444/(nrow(df4))) %>%
add_header_row(top = TRUE, values = c("quality", "time", "rand"), colwidths = c(4,2,1)) %>%
add_footer_lines("some text can go here") %>%
colformat_num(j=~Ozone, big.mark = ",") %>%
colformat_double(j=~Wind, suffix = " $") %>%
vline_left(border = fp_border(color = "red", style="solid", width = 1)) %>%
vline_right(border = fp_border(color = "red", style="solid", width = 1)) %>%
vline(j=~Temp, border = fp_border()) %>%
set_header_labels(Temp = "Temperature") %>%
#hrule(rule = "exact", part = "body") %>%
print(preview = "pptx")
How can you control line thickness in html outputs using flextable? It looks fine in the RStudio viewer. I think this might not have to do with flextable and might just be a problem with however flextable gets turned to HTML, but not sure where that occurs.
library(dplyr)
library(flextable)
library(officer)
iris %>% head(n=4) %>% flextable() %>%
bg(bg = "#00557F", part = "header") %>%
bold(part = "header") %>%
color( color = "white", part = "header") %>%
border_outer(border = big_border, part = "all" ) %>%
border_inner_h( border = std_border, part = "all" ) %>%
border_inner_v( border = std_border, part = "all" ) %>%
autofit() %>% save_as_html(path = 'ex.html')
I need to create table with same footnote being placed in both header and body of the table, I cannot figure out how to make it happen using flextable, what I can create is something as below:
library(flextable)
library(dplyr)
library(tidyr)
data(iris)
iris %>%
as_tibble %>%
gather(.,key = variable,value = value,-Species) %>%
group_by(Species,variable) %>%
summarise(value=formatC(mean(value),digits = 2,format = 'f')) %>%
ungroup %>%
spread(.,key = variable,value = value) %>%
flextable %>%
footnote(.,part = 'header',i = 1,j = c(2:5),
value = as_paragraph(c('Rounded to two decimal places')),
ref_symbols = c('*'),
inline=FALSE) %>%
footnote(.,part = 'body',i = c(1:3),j = 1,
value = as_paragraph(c('Rounded to two decimal places')),
ref_symbols = c('*'),
inline=FALSE)
Currently I created two footnotes with the same statement for header and body, I wonder if I can merge the two statements into one.
Thanks!
(I did not imagine footnotes would be repeated when this function has been implemented but) by using merge_v, you can merge them if identical:
library(flextable)
library(dplyr)
library(tidyr)
data(iris)
iris %>%
as_tibble %>%
gather(.,key = variable,value = value,-Species) %>%
group_by(Species,variable) %>%
summarise(value=formatC(mean(value),digits = 2,format = 'f')) %>%
ungroup %>%
spread(.,key = variable,value = value) %>%
flextable %>%
footnote(.,part = 'header',i = 1,j = c(2:5),
value = as_paragraph(c('Rounded to two decimal places')),
ref_symbols = c('*'),
inline=FALSE) %>%
footnote(.,part = 'body',i = c(1:3),j = 1,
value = as_paragraph(c('Rounded to two decimal places')),
ref_symbols = c('*'),
inline=FALSE) %>%
merge_v(part = "footer")