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")
Related
I want to highlight all lines going to a node/marker on a map in mapview. In the example code here, the nodes represent capital cities. Upon hovering on one of the cities, I would like all 4 lines going to/from that city to become highlighted. The hover option inside mapview had no effect, when I tried it. Thanks.
library(dplyr)
library(readr)
library(janitor)
library(sp)
library(purrr)
cc = read_csv("http://techslides.com/demos/country-capitals.csv")
nodes =
cc %>%
clean_names() %>%
mutate(capital_latitude = as.numeric(capital_latitude)) %>%
select(capital_name, capital_longitude, capital_latitude) %>%
filter(capital_name %in% c("Warsaw", "El-Aaiún", "Jamestown", "Antananarivo", "Manama"))
edges =
full_join(
nodes %>% rename(from = capital_name, from_lon = capital_longitude, from_lat = capital_latitude) %>% mutate(index = 1),
nodes %>% rename(to = capital_name, to_lon = capital_longitude, to_lat = capital_latitude) %>% mutate(index = 1),
by = "index") %>%
mutate(from_to = paste(from, "_", to)) %>%
filter(from != to) %>%
select(-index) %>%
rowwise() %>%
mutate(capital_lines = pmap(list(from_lon = from_lon, from_lat = from_lat, to_lon = to_lon, to_lat = to_lat, from_to = from_to),
function(from_lon, from_lat, to_lon, to_lat, from_to) {
Line(cbind(c(from_lon, to_lon),
c(from_lat, to_lat))) %>%
Lines(., ID = from_to)}
)) %>%
mutate(capital_lines = list(SpatialLines(list(capital_lines))))
mapview(nodes, xcol = "capital_longitude", ycol = "capital_latitude") +
mapview(do.call(rbind, edges$capital_lines))
library(mapview)
mapviewOptions(fgb = FALSE)
mapview(shp, highlight = leaflet::highlightOptions(color = "red", weight = 2, sendToBack = TRUE))
This works for me.
See details in https://github.com/r-spatial/mapview/issues/392.
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 list of multiple data frames.
files_list <- list(data_04, data_05, data_06, data_07, data_08, data_09, data_010, data_011,
data_012, data_013, data_015, data_016, data_017, data_018)
How do i change the data types of each column so that they match through data frames. All of the data frames have the same columns and column names.
I have tried this but it doesn't work.
for (i in files_list) {
i %>%
mutate(ride_id = as.character(ride_id)) %>%
mutate(rideable_type = as.character(rideable_type)) %>%
mutate(started_at = as_datetime(started_at)) %>%
mutate(ended_at = as_datetime(ended_at)) %>%
mutate(start_station_name = as.character(start_station_name)) %>%
mutate(start_station_id = as.integer(start_station_id)) %>%
mutate(end_station_name = as.character(end_station_name)) %>%
mutate(end_station_id = as.integer(end_station_id)) %>%
mutate(start_lat = as.numeric(start_lat)) %>%
mutate(start_lng = as.numeric(start_lng)) %>%
mutate(end_lat = as.numeric(end_lat)) %>%
mutate(end_lng = as.numeric(end_lng)) %>%
mutate(member_casual = as.character(member_casual))
}
You can write a function and then use lapply() on the list.
The below should work but I can't be sure since I don't know what the data looks like.
EditDataFunction <- function(data){
clean_data <- data %>%
mutate(ride_id = as.character(ride_id)) %>%
mutate(rideable_type = as.character(rideable_type)) %>%
mutate(started_at = as_datetime(started_at)) %>%
mutate(ended_at = as_datetime(ended_at)) %>%
mutate(start_station_name = as.character(start_station_name)) %>%
mutate(start_station_id = as.integer(start_station_id)) %>%
mutate(end_station_name = as.character(end_station_name)) %>%
mutate(end_station_id = as.integer(end_station_id)) %>%
mutate(start_lat = as.numeric(start_lat)) %>%
mutate(start_lng = as.numeric(start_lng)) %>%
mutate(end_lat = as.numeric(end_lat)) %>%
mutate(end_lng = as.numeric(end_lng)) %>%
mutate(member_casual = as.character(member_casual))
return(clean_data)
}
clean_list <- lapply(files_list, EditDataFunction)
Then if you need to bind them all together you could use data.table::rbindlist
We may use type.convert(as.is = TRUE)
Try this shorter version of Tob's code: It will depend how date columns are saved in df!
EditDataFunction <- function(data){
clean_data <- data %>%
as_tibble() %>%
type.convert(as.is = TRUE)
return(clean_data)
}
clean_list <- lapply(files_list, EditDataFunction)
I am trying to use R sparkline with gt. My question is very similar to this one Is it possible to use sparkline with gt?, but on top of simply using sparkline with gt as in the referenced question, I am trying to use it as part of the summary row. Below is the picture of what I have achieved so far. Here are my two questions:
How can I remove the two grey lines that are printed as part of the sparkline chart in the summary row?
Is there a better way to add sparkline to the summary row of a gt table?
library(tidyverse)
library(sparkline)
library(gt)
# toy data
df <- tibble(
name = rep(c("A", "B"), each = 20),
value = runif(40, min = -10, max = 10) %>% cumsum()
) %>%
group_by(name) %>%
mutate(
index = row_number()
) %>% ungroup()
# preparing the data for the standard sparkline
regular_sparkline_df <- df %>%
group_by(name) %>%
summarise(
chart = spk_chr(
value,
type="line"
)
)
# here I try to prepare the data for the summary row by getting the whole gt table and then removing the header
summary_row_sparkline_df <- df %>%
group_by(index) %>%
summarise(value = sum(value)) %>% ungroup() %>%
summarise(
chart = spk_chr(
value,
type="line"
)
) %>%
gt() %>%
fmt_markdown(columns = vars(chart)) %>%
gt:::as.tags.gt_tbl() %>%
htmltools::attachDependencies(htmlwidgets::getDependency("sparkline")) %>%
as.character() %>%
gsub('<thead.+</thead>', "", .) # removing the header of the table
# building the html and adding dependencies
p_html <- regular_sparkline_df %>%
gt() %>%
fmt_markdown(columns = vars(chart)) %>%
grand_summary_rows(
columns = "chart",
fns = list(Total = ~as.character(summary_row_sparkline_df)),
formatter = fmt_markdown
) %>%
gt:::as.tags.gt_tbl() %>%
htmltools::attachDependencies(htmlwidgets::getDependency("sparkline"))
# seeing the table in the RStudio
print(p_html, browse = interactive())
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)