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()
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")
I want to add data labels for a treemap I have created. I am using this treemap for an image so having the pts and fgpct for each box would be helpful. I want what's listed in the tooltip and the legend to appear in each box.
My code:
library(highcharter)
gamelogs %>%
filter(slugTeam == "MEM") %>%
group_by(namePlayer) %>%
summarise(pts = sum(pts), fgpct = sum(fgm) / sum(fga)) %>%
hchart("treemap", hcaes(name = namePlayer, value = pts, color = fgpct)) %>%
hc_title(text = "Grizzlies Scoring") %>%
hc_subtitle(text = "Shaded by Field Goal %") %>%
hc_chart(
backgroundColor = '#FFFFFF' # Chart Background Color
) %>%
hc_exporting(enabled = TRUE,
filename = "Grizzlies Scoring")
My Output:
The output I would like:
This output would have the points 1,041 in the box and also the fgpct of 49% that is shown in the legend. Anyway to add the data labels using highcharter treemap?
Try this
gamelogs %>%
filter(slugTeam == "MEM") %>%
group_by(namePlayer) %>%
summarise(pts = sum(pts), fgpct = round(sum(fgm) / sum(fga),digits=2)) %>%
hchart("treemap", hcaes(name = namePlayer, value = pts, color = fgpct),
dataLabels = list(enabled = TRUE, format='{point.namePlayer}<br/>{point.pts} pts<br/>{point.fgpct} fgpct'),
tooltip = list(pointFormat = "{point.namePlayer}: {point.pts}, {point.fgpct}%")) %>%
hc_title(text = "Grizzlies Scoring") %>%
hc_subtitle(text = "Shaded by Field Goal %") %>%
hc_chart(
backgroundColor = '#FFFFFF' # Chart Background Color
) %>%
hc_exporting(enabled = TRUE,
filename = "Grizzlies Scoring") %>%
hc_tooltip(crosshairs = TRUE)
you will get this output
Is it possible to populate a formattable color_bar with an alternative display value (i.e. a value other than the value used to determine the size of the color_bar)
In the table below I want to override the values with the following display values for ttl to:
c(1000,1230,1239,1222,1300,1323,1221)
library(tidyverse)
library(knitr)
library(kableExtra)
library(formattable)
tchart <- data.frame(id = 1:7,
Student = c("Billy", "Jane", "Lawrence", "Thomas", "Clyde", "Elizabeth", "Billy Jean"),
grade3 = c(55,70,75,64,62,55,76),
ttl = c(105,120,125,114,112,105,126),
avg =c(52.31,53.0,54.2,51.9,52.0,52.7,53.0))
tchart %>%
mutate(id = cell_spec(id, "html", background = "red", color = "white", align = "center")) %>%
mutate(grade3 = color_bar("lightgreen")(grade3)) %>%
mutate(ttl = color_bar("lightgray")(ttl)) %>%
mutate(avg = color_tile("white","red")(avg)) %>%
kable("html", escape = F) %>%
kable_styling("hover", full_width = F) %>%
column_spec(4, width = "4cm")
I checked the documentation and didn't see this as a possibility, but I was hoping there was a workaround or custom function solution.
I don't think you can quite pass it another set of values, but there are a couple of options that you might find workable.
One thing to note first is that color_bar() can accept two values - a color, and a function that will take the vector of values and transform them to numbers between 0 and 1. By default, that function is formattable::proportion(), which compares everything against the max value. But if you used your display values for ttl, you could conceivably transform the bars to be whatever length you wanted by writing your own function. (See: https://rdrr.io/cran/formattable/man/color_bar.html)
Another possibility would be to make your own formatter. Some examples here:
https://www.littlemissdata.com/blog/prettytables
So, I think you can put the numbers you want in the display, and hopefully can use a function to transform or map those values to get the bar lengths between 0 and 1 that you're looking for.
Add a new variable ttl_bar to determine the size of the bar, and let variable ttl display the value. I use gsub() to replace the ttl_bar to ttl.
tchart <- data.frame(id = 1:7,
Student = c("Billy", "Jane", "Lawrence", "Thomas", "Clyde", "Elizabeth", "Billy Jean"),
grade3 = c(55,70,75,64,62,55,76),
ttl = c(1000,1230,1239,1222,1300,1323,1221),
avg =c(52.31,53.0,54.2,51.9,52.0,52.7,53.0),
ttl_bar = c(105,120,125,114,112,105,126))
tchart %>%
mutate(id = cell_spec(id, "html", background = "red", color = "white", align = "center")) %>%
mutate(grade3 = color_bar("lightgreen")(grade3)) %>%
mutate(avg = color_tile("white","red")(avg)) %>%
mutate(ttl = pmap(list(ttl_bar, ttl, color_bar("lightgray")(ttl_bar)), gsub)) %>%
select(-ttl_bar) %>%
kable("html", escape = F) %>%
kable_styling("hover", full_width = F) %>%
column_spec(4, width = "4cm")
In a more careful way, rewrite gsub() as this mutate(ttl = pmap(list(ttl_bar, ttl, color_bar("lightgray")(ttl_bar)), ~ gsub(paste0(">", ..1, "<"), paste0(">", ..2, "<"), ..3))).
I come up with a better way to use function in color_bar() as the following code.
override = function(x, y) y / 200
tchart <- data.frame(id = 1:7,
Student = c("Billy", "Jane", "Lawrence", "Thomas", "Clyde", "Elizabeth", "Billy Jean"),
grade3 = c(55,70,75,64,62,55,76),
ttl = c(105,120,125,114,112,105,126),
avg =c(52.31,53.0,54.2,51.9,52.0,52.7,53.0),
ttl_bar = c(1000,1230,1239,1222,1300,1323,1221))
tchart %>%
mutate(id = cell_spec(id, "html", background = "red", color = "white", align = "center")) %>%
mutate(grade3 = color_bar("lightgreen")(grade3)) %>%
mutate(avg = color_tile("white","red")(avg)) %>%
mutate(ttl = color_bar("lightgray", fun = override, ttl)(ttl_bar)) %>%
select(-ttl_bar) %>%
kable("html", escape = F) %>%
kable_styling("hover", full_width = F) %>%
column_spec(4, width = "4cm")