I can print my data with gt table and create hyperlinks for different cells, as shown below by knitting an HTML file:
library(dplyr)
library(gt)
raw_dat <- mtcars[1:15, ] %>% rownames_to_column(var = "id") %>% select(id, mpg)
df <- tibble(
name = raw_dat$id,
link = 'https://www.cars.com//')
df %>%
mutate(link = sprintf('<p>%s', link, raw_dat$mpg),
link = map(link, gt::html)) %>%
gt
I want to print the same output to a powerpoint slide and preserve the links. I understand that I cannot use 'ph_with' with an object of class "c('gt_tbl', 'list')". So I was wondering what else I can do to print a table with hyperlinks in powerpoint.
NEW <- read_pptx("Presentation1.pptx") %>%
add_slide(., layout = "Blank", master = "Office Theme") %>%
ph_with(raw_dat,
location = ph_location(left = 0, top = 0, width = 13.33, height = 7.5))
This is a solution with flextable that is supported by officer.
library(tibble)
library(dplyr)
library(flextable)
library(officer)
raw_dat <- mtcars[1:15, ] %>% rownames_to_column(var = "id") %>% select(id, mpg)
df <- tibble(name = raw_dat$id, link = 'https://www.cars.com//')
ft <- flextable(df) %>%
mk_par(j = "link", value = as_paragraph(hyperlink_text(x = name, url = link))) %>%
autofit()
read_pptx() %>%
add_slide() %>%
ph_with(ft, location = ph_location_type()) %>%
print(target = "toto.pptx")
PS: I am not sure that I answer the question as it is generated with officer, not officedown, but your example is not a R Markdown example. I assumed you wanted to use officer.
Related
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)
I want to create on the same word landscape document both a table and text formatted in column.
The problem is that whenever I add body_end_section_columns_landscape() it creates a new page.
Example of working code in portrait format:
library(officer)
library(flextable)
ft <- qflextable(head(iris))
read_docx() %>%
body_add_flextable(value = ft ) %>%
body_end_section_continuous() %>%
body_add_par(value = paste(rep(letters,50), collapse = ' ')) %>%
body_end_section_columns() %>%
print(target = "test.docx")
If I try to create similar in landscape
ft <- qflextable(head(iris))
read_docx() %>%
body_add_flextable(value = ft ) %>%
body_end_section_landscape() %>%
body_add_par(value = paste(rep(letters,50), collapse = ' ')) %>%
body_end_section_columns_landscape() %>%
print(target = "test.docx")
It adds a second page for the text.
Is there a possibility to have both on same page as landscape same as in the portrait one?
Thank you
Yes, functions body_end_section_* are adding a break page between sections. You need to add specific section settings (type = "continuous") and use body_end_block_section() to achieve what you want to do:
library(officer)
library(magrittr)
library(flextable)
landscape_one_column <- block_section(
prop_section(
page_size = page_size(orient = "landscape"), type = "continuous"
)
)
landscape_two_columns <- block_section(
prop_section(
page_size = page_size(orient = "landscape"), type = "continuous",
section_columns = section_columns(widths = c(4, 4))
)
)
ft <- qflextable(head(iris))
read_docx() %>%
# there starts section with landscape_one_column
body_add_flextable(value = ft) %>%
body_end_block_section(value = landscape_one_column) %>% # there stops section with landscape_one_column
# there starts section with landscape_two_columns
body_add_par(value = paste(rep(letters, 50), collapse = " ")) %>%
body_end_block_section(value = landscape_two_columns) %>% # there stops section with landscape_two_columns
print(target = "test.docx")
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")
The R officer package is very good at letting you insert text into existing placeholders in a powerpoint deck. For instance, this code:
library(tidyverse)
library(officer)
pres <- (read_pptx()
%>% add_slide(layout = "Title and Content", master = "Office Theme")
%>% ph_with_text(type="body", str="placeholder")
%>% ph_add_par(level=2)
%>% ph_add_text("Foo")
%>% ph_add_par(level=3)
%>% ph_add_text("Bar")
%>% ph_add_par(level=4)
%>% ph_add_text("Baz")
%>% print(target="bullet_example1.pptx"))
produces a powerpoint with bullets that look
like this. However, it seems to insert text at an arbitrary location, I have to use the ph_empty_at() function like this:
pres <- (read_pptx()
%>% add_slide(layout = "Title and Content", master = "Office Theme")
%>% ph_empty_at(left=2, top=2, width=5, height=5)
%>% ph_add_par(level=1)
%>% ph_add_text("Placeholder")
%>% ph_add_par(level=2)
%>% ph_add_text("Foo")
%>% ph_add_par(level=3)
%>% ph_add_text("Bar")
%>% ph_add_par(level=4)
%>% ph_add_text("Baz")
%>% print(target="bullet_example2.pptx"))
However, this results in text that looks very different and doesn't respect the levels argument. It seems the text is not inheriting the style from the slide.
I'm asking because I need to use a pre-specified PPT template. I can do this with an existing placeholder, and I get the desired output. How can I insert formatted text like this at an arbitrary location on the slide?
Hi Using layout = "Blank" seems to work
pres <- (read_pptx()
%>% add_slide(layout = "Blank", master = "Office Theme")
%>% ph_empty_at(left=0, top=0, width=5, height=5)
%>% ph_add_par(level=1)
%>% ph_add_text("Placeholder")
%>% ph_add_par(level=2)
%>% ph_add_text("Foo")
%>% ph_add_par(level=3)
%>% ph_add_text("Bar")
%>% ph_add_par(level=4)
%>% ph_add_text("Baz")
%>% ph_empty_at(left=5, top=5, width=5, height=5)
%>% ph_add_par(level=1, id_chr = 3)
%>% ph_add_text("Placeholder", id_chr = 3)
%>% ph_add_par(level=2, id_chr = 3)
%>% ph_add_text("Foo", id_chr = 3)
%>% ph_add_par(level=3, id_chr = 3)
%>% ph_add_text("Bar", id_chr = 3)
%>% ph_add_par(level=4, id_chr = 3)
%>% ph_add_text("Baz", id_chr = 3)
%>% print(target="bullet_example2.pptx")
)