I have a new computer (read: new versions of everything, including Office 2016)
I created the following code on my previous computer, and all worked fine:
...
control_table <- regulartable(data = data) %>%
theme_box() %>%
rotate(rotation = "btlr", part = "header") %>%
align(align = "left", part = "body") %>%
set_header_labels(Var1 = " " ) %>%
align(align = "left", part = "header") %>%
height(height = 3, part = "header") %>%
width(width = 0.3) %>%
width(j = 1, width = 3.5)
doc <- doc %>%
cursor_reach("The following table indicates the reports") %>%
body_add_flextable(control_table, align = "left")
...
now with my new computer the row height of the header is not being translated into the Word document. dim(control_table) gives the correct row height, but the header row height is not displaying in the word document.
What am I missing?
Word don't handle auto height with rotated headers, then it is necessary to specify rule for row height with function hrule.
library(flextable)
library(officer)
library(magrittr)
control_table <- flextable(data = head(iris)) %>%
theme_box() %>%
rotate(rotation = "btlr", part = "header") %>%
align(align = "left", part = "body") %>%
set_header_labels(Var1 = " " ) %>%
align(align = "left", part = "header") %>%
height(height = 2, part = "header") %>%
hrule(i = 1, rule = "exact", part = "header")
doc <- read_docx() %>%
body_add_flextable(control_table, align = "left") %>%
print(target = "example.docx")
Related
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")
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()
Below I have a script that contains a 5th text column that had so much written it exceeded the size of the page. Though I added longtable = T and latex_options= "repeat_header" it only continues the table through multiple pages but if the row exceeds the page it gets cut off. How can I keep the table moving along while not losing text.
df %>%
kableExtra::kbl(.,booktabs = T,longtable = T)%>%
row_spec(0,background = "#F6F6F6",color="black")%>%
kable_styling(bootstrap_options = "striped", font_size = 9,latex_options =
c("hold_position","repeat_header"),position = "left") %>%
column_spec(1,width = "2.0cm") %>%
column_spec(2,width = "2.5cm") %>%
column_spec(3,width = "2.5cm") %>%
column_spec(4,width = "4.5cm")%>%
column_spec(5,width="10.0cm")
Here's a workaround by splitting the cell with long text. It works by splitting the text into two chunks based on word count so could easily be adjusted by trial and error.
```{r setup, include=FALSE}
knitr::opts_chunk$set(echo = FALSE)
library(kableExtra)
library(wakefield) # for generating long text
library(dplyr)
library(tidyr)
library(stringr)
```
```{r df, include=FALSE}
set.seed(123)
#sample dataset
df <- data.frame(a = 1:6,
b = month.name[1:6],
c = names(mtcars)[1:6],
d = names(islands)[1:6],
e = c(paragraph(2), paste(paragraph(6), collapse = "; "), paragraph(3)))
#create new data frame, cells with long text split into to
df_new <-
df %>%
mutate(f = ifelse(str_length(e)>2000, word(e, 301, -1), NA_character_),
e = ifelse(str_length(e)>2000, word(e, 1, 300), e)) %>%
pivot_longer(cols = c(f, e), values_to = "e") %>%
na.omit() %>%
arrange(a, name) %>%
select(-name)
```
```{r long-table, results='asis'}
df_new %>%
kbl(booktabs = TRUE,
longtable = TRUE) %>%
row_spec(0, background = "#F6F6F6", color = "black") %>%
landscape() %>%
kable_styling(bootstrap_options = "striped",
font_size = 9,
latex_options = c("hold_position","repeat_header"),position = "left") %>%
column_spec(1, width = "2.0cm") %>%
column_spec(2, width = "2.5cm") %>%
column_spec(3, width = "2.5cm") %>%
column_spec(4, width = "4.5cm") %>%
column_spec(5, width = "10.0cm")
```
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")
I need to create a latex table in RStudio for pdf output with the following structure:
This table was created for html output with the following code:
mat <- data.frame(a = c("column header","column header"),
rowx=c("row1","row2"),b = c("a","b"),
c = c("x","y"))
kable(mat, align = "c",col.names = c("","","v1","v2")) %>%
kable_styling(bootstrap_options = "striped", full_width = F,
position = "left",font_size = 12) %>%
column_spec(1, bold = T,width="2em",extra_css="transform: rotate(-90deg);") %>%
collapse_rows(columns = 1, valign = "middle") %>%
add_header_above(c(" " = 2, "row header" = 2))
I need to create a similar structure with LaTeX tables.
His is how far I got:
mat <- data.frame(a = c("column header","column header"),
rowx=c("row1","row2"),b = c("a","b"),c = c("x","y"))
kable(mat, align = "c",col.names = c("","","v1","v2")) %>%
kable_styling(bootstrap_options = "striped", full_width = F, position = "left",font_size = 12) %>%
collapse_rows(columns = 1, latex_hline = "none") %>%
add_header_above(c(" " = 2, "rows" = 2))
So I still need at least 2 more things:
rotate the label in the very first column
remove the spurious leftmost column separator in the second row.
Can this be achieved with kableExtra commands and parameters?
Here's a shot with huxtable (my package):
as_hux(mat, add_colnames = TRUE) %>%
insert_row(c("", "", "rows", "")) %>%
merge_cells(3:4, 1) %>%
merge_cells(1, 3:4) %>%
merge_cells(1:2, 1:2) %>%
set_rotation(3, 1, 90) %>%
set_bottom_border(0.4) %>%
set_bold(1:2, everywhere, TRUE) %>%
set_wrap(3, 1, TRUE) %>%
set_bottom_padding(4, -1, 48) %>%
set_bottom_padding(3, -1, 30) %>%
set_row_height(c("1em", "1em", "1.5em", "1.5em")) %>%
quick_pdf()
I have to admit, this took a lot of tweaking. TeX tables are hard to understand....