somehow I am not able to properly export a plot containing three subplots into my PowerPoint with the officer package. I will most an MWE with the same but different data that produces the plot that I want to export
library(fpp3)
library(officer)
library(rvg)
p1 <- global_economy %>%
filter(Code == "CAF") %>%
gg_tsdisplay(difference(Exports), plot_type='partial')
#PPT
p_dml <- rvg::dml(ggobj = p1, editable = F)
my_pres <- read_pptx("...path/presentation.pptx")
my_pres <- add_slide(my_pres,layout = "Headline 1-zeilig", master = "Master-Design") #should be adjusted
my_pres<- ph_with(my_pres, value = p_dml , location = ph_location_fullsize())
print(my_pres, target = "...path/presentation.pptx")
This is the graph that I am producing inside R:
But in the final PowerPoint only the lower right figure is displayed and not all three graphs.
The issue is that the object returned by gg_tsdisplay is not a ggplot object but a list of ggplot objects instead. As a consequence only the last element of this list is exported to the pptx or you get an error in the case where your first convert to a dml object.
One possible fix would be to build your multi plot using the patchwork package which as a side effect will "convert" the list of plots to a ggplot object. After doing so you could easily export to pptx whether as a ggplot object or as an dml object. In my code below I use patchwork::wrap_plots and use the design argument to mimic the layout of your multi plot:
library(fpp3)
library(officer)
library(rvg)
p1 <- global_economy %>%
filter(Code == "CAF") %>%
gg_tsdisplay(difference(Exports), plot_type='partial')
library(patchwork)
p1 <- p1 |>
wrap_plots(design = "AA\nBC")
p_dml <- rvg::dml(ggobj = p1, editable = F)
my_pres <- read_pptx()
my_pres <- add_slide(my_pres,layout = "Title and Content", master = "Office Theme")
my_pres<- ph_with(my_pres, value = p_dml, location = ph_location_fullsize())
print(my_pres, target = "presentation.pptx")
Related
A complete ggplot2/Shiny beginner here. I have been searching on Stack and Google for days and could not come up with a decent solution.
Task: to create an interactive leaflet map showing a user-selected column in a long data format (Covid vaccine doses - first, second, and third dose; need shiny to feed this into ggplot2's "data"), which are pre-filtered based on additional user choices (month of the year, age group, type of vaccine administered; these cannot be fed into ggplot2 directly so I need to filter out the data). I am therefore interested in subsetting selected columns (time, age_group, vaccine) based on the values the users select in the input.
I am importing a data frame in .csv which needs to be merged with a sf object later on to match the data with the sf coordinates (supplied by RCzechia).
# Load packages
library(shiny)
library(here)
library(tidyverse)
library(ggplot2)
library(RCzechia)
library(sf)
# Load data
df <- read.csv("data", encoding = "UTF-8")
# load geo-spatial sf data for ggplot
czrep <- republika()
regions <- kraje(resolution = "low")
# Defining UI for the ggplot application
ui <- fluidPage(
titlePanel(),
# Sidebar
sidebarLayout(
sidebarPanel(width = 3,
selectInput("box_time", label = "Month & Year",
choices = sort(unique(df$time)), selected = "",
width = "100%", selectize=FALSE),
selectInput("box_age", label = "Age group",
choices = sort(unique(df$age_group)), selected = "",
width = "100%", selectize=FALSE),
selectInput("box_vax", label = "Type of vaccine",
choices = sort(unique(df$vaccine)), selected = "",
width = "100%", selectize=FALSE),
radioButtons("button_dose", label = "Vaccine dose",
choices = c("First dose" = "first_dose",
"Second dose" = "second_dose",
"Booster" = "booster"))
),
# Displaying the user-defined ggplot
mainPanel(
plotOutput("map")
)))
# Server
server <- function(input, output) {
# select column for ggplot
r_button_dose <- reactive({input$button_dose})
### Subset based on user choices - this is where I tried to create a new data frame (new_df) as a result of subsetting by - see below. ###
# merge the df with the sf object
new_df <- merge(regions, new_df, by.x = "region_id", by.y="region_id")
# transform data set into an sf object (readable by ggplot)
new_df <- st_as_sf(new_df)
})
# Generating the plot based on user choices
output$map <- renderPlot({
ggplot(data = new_df) +
geom_sf(aes_string(fill = r_button_dose(), colour = NA, lwd = 2)) +
geom_sf(data = czrep, color = "grey27", fill = NA) +
scale_fill_viridis_c(trans = "log", labels = scales::comma) +
labs(fill = "log scale") +
theme_bw() +
theme(legend.text.align = 1,
legend.title.align = 0.5)
})
}
# Starting the Shiny application
shinyApp(ui = ui, server = server)
I cannot figure out how to subset the data - I have tried many different things that I found here and on the RStudio community forms.
Here are a couple of things I have already tried:
# used both filter() and subset(); also tried both '==' and '%in%'
new_df %>%
filter(time %in% box_time() &
age_group %in% input$box_age() &
vaccine %in% input$box_vax())
})
#OR#
new_df <- reactive({
df <- df %>%
filter(time %in% box_time() &
age_group %in% input$box_age() &
vaccine %in% input$box_vax())
})
#OR#
new_df <- df
new_df$time <- df[df$time==box_time(),]
new_df$age_group <- df[df$age_group==input$box_age(),]
new_df$vaccine <- df[df$vaccine ==input$box_vax(),]
# I also tried passing them the same way as this example:
r_button_dose <- reactive({input$button_dose})
#OR EVEN#
new_df <- reactive({
new_df <- df
new_df$time <- df[df$X.U.FEFF.year_mo==box_time(),]
new_df$age_group <- df[df$age_group==input$box_age(),]
new_df$vaccine <- df[df$vaccine ==input$box_vax(),]
})
With the latest option, I get the following error - even though they are similar:
Listening on http://127.0.0.1:4092
Warning: Error in $: object of type 'closure' is not subsettable
1: runApp
Warning: Error in $: object of type 'closure' is not subsettable
1: runApp
Warning: Error in as.data.frame.default: cannot coerce class ‘c("reactiveExpr", "reactive", "function")’ to a data.frame
176: stop
175: as.data.frame.default
172: merge.data.frame
168: renderPlot [C:/Users/xyz/Documents/R/example/gg_app.R#78]
166: func
126: drawPlot
112: <reactive:plotObj>
96: drawReactive
83: renderFunc
82: output$map
1: runApp
I don't know what to do - looking for more examples online has not worked. I know that I cannot pass a reactive value directly (even though I am not sure if it is because it returns a logical value). I would be extremely grateful for any tips regarding how to resolve this - thank you!
You can define your reactive dataframe as a reactiveVal:
df_filtered <- reactiveVal(df) ## df being your initial static dataframe
The tricky bit is to treat your reactive dataframe as a function, not an static object:
## works:
df_filtered(df %>% filter(age_group == input$box_age))
renderDataTable(df_filtered()) ## note the parentheses
instead of:
## won't work:
df_filtered <- df %>% filter(age_group %in% input$box_age)
renderDataTable(df_filtered)
finally, wrap it into a reactive expression:
observe({df_filtered(df %>% filter(age_group == input$box_age))
## note: function argument, not assignment operator
output$map <- renderPlot({
df_filtered() %>% ## again: note function (parentheses)
ggplot() # etc.
})
}) %>% bindEvent(input$box_age, input$some_other_picker)
I think you are almost there, slight syntax issue. Note I return the new_df as part of reactive block (essentially a function), and, in renderPlot, I tell 'data' is in essence invocation result of function r_button_dose. You need to modify the fill attribute as I'm not sure what you want it to be filled with
# select column for ggplot
r_button_dose <- reactive({input$button_dose})
### Subset based on user choices - this is where I tried to create a new data frame (new_df) as a result of subsetting by - see below. ###
# merge the df with the sf object
new_df <- merge(regions, new_df, by.x = "region_id", by.y="region_id")
# transform data set into an sf object (readable by ggplot)
new_df <- st_as_sf(new_df)
new_df
})
# Generating the plot based on user choices
output$map <- renderPlot({
ggplot(data = r_button_dose()) +
geom_sf(aes_string(fill = r_button_dose()$region_id, colour = NA, lwd = 2)) +
geom_sf(data = czrep, color = "grey27", fill = NA) +
scale_fill_viridis_c(trans = "log", labels = scales::comma) +
labs(fill = "log scale") +
theme_bw() +
theme(legend.text.align = 1,
legend.title.align = 0.5)
})
I'm trying to export a ggsurvplot-object to powerpoint with officer-package with no success. I was able to find a lot of instructions on how to use now obsolute ReporterS-package for this and a few mentions that officer should work as well. There seems to be nothing in the documentation mentioning this. So should this work at all? Is it possible to get a vectorized survival plot to a pptx-slide with these tools?
totsur <- ggsurvplot(yhd1,
data = sappivertailu,
combine=TRUE,
xlab = "Time, months",
ylab="Survival",
title="Overall survival",
lwd=2,
palette="jco",
xscale = "d_m",
xlim = c(0,730.5),
break.x.by = 91.3,
risk.table = TRUE,
pval = TRUE,
fontsize = 3)
totsur
my_vec_graph <- dml(code = totsur)
doc <- read_pptx()
doc <- add_slide(doc, layout = "Overall survival", master = "Office Theme")
doc <- ph_with(doc, my_vec_graph, location = ph_location_fullsize() )
print(doc, target = "Sappitutkimus/Charts/survi1.pptx")
Changing the dml(ggobj = totsur) neither works. What am I doing wrong?
Edit: Thanks for all the comments below! And another update. There was nothing wrong with the data. After a little debugging, my original data produces the intended result.
One problem remains. Package does not seem to able to add risk table and survival curve in the same slide. Yes, you can pass this by making two separate plots on separate slides but I don't think that's good practice.
If I'm not totally mistaken, officer and ReporteRs have some code in common and this issue was present there as well. https://github.com/kassambara/survminer/issues/314
Does anyone know a way around this? Here's a bit more compact chunk I'm currently using. This works fine otherwise.
yhd1 <- survfit(Surv(sappivertailu$Survi, sappivertailu$Kuolema) ~ Arm, data=koe)
totsur <-
ggsurvplot(yhd1,
combine = TRUE,
data = sappivertailu,
# risk.table = TRUE,
pval = TRUE,
fontsize = 3
)
totsur
my_vec_graph <- rvg::dml(ggobj = last_plot())
doc <- read_pptx()
doc <- add_slide(doc, layout = "Title and Content", master = "Office Theme")
doc <- ph_with(doc, my_vec_graph, location = ph_location_fullsize() )
print(doc, target = "Sappitutkimus/Charts/survi1.pptx")
Edit n:o 2: And a tip about the desired result.
Sure could you export ggsurvplots. to pptx via officer. There are two issues with your code. First you have to make use of rvg::dml(ggobj = ...) . Second you set layout = "Overall survival". But there is no layout with this name in the default pptx shipped with officer, i.e. you could only use layouts which are present in the pptx template. Fixing both issues and making use of the basic example from the docs of ggsurvplot:
require("survival")
#> Loading required package: survival
library(survminer)
#> Loading required package: ggplot2
#> Loading required package: ggpubr
library(officer)
fit<- survfit(Surv(time, status) ~ sex, data = lung)
# Basic survival curves
ggsurvplot(fit, data = lung)
my_vec_graph <- rvg::dml(ggobj = last_plot())
doc <- read_pptx()
doc <- add_slide(doc, layout = "Title and Content", master = "Office Theme")
doc <- ph_with(doc, my_vec_graph, location = ph_location_fullsize() )
print(doc, target = "survi2.pptx")
EDIT If you want to have multiple contents on the same slide you could change the layout to Two Content and make use of ph_location_left/right:
doc <- read_pptx()
doc <- add_slide(doc, layout = "Two Content", master = "Office Theme")
doc <- ph_with(doc, my_vec_graph, location = ph_location_left() )
doc <- ph_with(doc, my_vec_graph, location = ph_location_right() )
print(doc, target = "survi2.pptx")
Somewhat to my amazement, you can use the code = argument within dml() if you embed your suvival plot in a print() statement. Be sure to include newpage = FALSE:
require("survival")
# Loading required package: survival
library(survminer)
#> Loading required package: ggplot2
#> Loading required package: ggpubr
library(officer)
fit<- survfit(Surv(time, status) ~ sex, data = lung)
# Basic survival curves
p = ggsurvplot(fit, data = lung, risk.table = TRUE)
my_vec_graph <- rvg::dml(code = print(p, newpage = FALSE))
doc <- read_pptx()
doc <- add_slide(doc, layout = "Title and Content", master = "Office Theme")
doc <- ph_with(doc, my_vec_graph, location = ph_location_fullsize() )
print(doc, target = "survi2.pptx")
I am creating a custom visual for power bi using rcharts but when it goes for saving the widget it say returns me an error. This is my code:
source('./r_files/flatten_HTML.r')
libraryRequireInstall("plotly")
library(rCharts)
library(fmsb)
library(plyr)
library(dplyr)
library(reshape2)
library(RColorBrewer)
dataset = Values
dataset$Nome <- as.factor(dataset$Nome)
dataset$TesteExercise <- as.factor(dataset$TesteExercise)
dataset$PlayerPosition <- as.factor(dataset$PlayerPosition)
pospassmatrix1 <- dataset %>%
group_by(TesteExercise) %>%
summarise(ValueTotal1 = sum(Value))
pospassmatrix2 <- dataset %>%
group_by(PlayerPosition) %>%
summarise(ValueTotal2 = sum(Value))
plot <- Highcharts$new()
plot$chart(polar = TRUE, type = "line",height=500)
plot$xAxis(categories=pospassmatrix1$TesteExercise, tickmarkPlacement= 'on', lineWidth= 0)
plot$yAxis(gridLineInterpolation='circle', lineWidth= 0,endOnTick=T,tickInterval=10)
plot$series(data = pospassmatrix1$ValueTotal1,name = "sum1", pointPlacement="on")
plot$series(data = pospassmatrix2$ValueTotal2,name = "sum2", pointPlacement="on")
####################################################
p = plot
############# Create and save widget ###############
internalSaveWidget(p, 'out.html');
####################################################
Anyone has a clue of how I can use rchart graphs as a widget or transform this in a ggplot adaptation ?
pbi error
Quick question all.
I have some data in sql server which i have loaded into RStudio. I have made a barchart for the data and now i am using leaflet library with the use of latitude and longitude to plot a point on the map. I want to be able to use popup to show a barchart in it when the user clicks on the point.
BarChart code (maybe this is a problem because i am using googleVis library so not sure if i can use this in the popup. but again this is the most appropriate bar graph i can make and need- other suggestions could be helpful as i am not a professional in R libraries yet)
Switzerland <- sqlQuery(con, "sql query")
SwitzerlandChart <- gvisBarChart(Switzerland, options = list(height=200))
For the graph plot the code is:
m <- leaflet() %>%
addTiles() %>% # Add default OpenStreetMap map tiles
addCircles(lng=8.498868, lat=46.9221, popup=paste(plot(SwitzerlandChart)))
When i run this code it opens a webpage to view my barplot.
Then i run the following:
m #Prints the graph
This prints the graph with the point in the desired location but the popup shows me a webpage instead which also only i can open.
I want to be able to plot the bargraph inside the popup please.
Hope someone can help
Maybe a little late but here's a solution. The addPopups() function in library(leaflet) seems to be able to handle .svg files. Therefore, you could simply save your plot using svg() and then read it again using readLines(). Here's a reproducible example using library(mapview):
library(lattice)
library(mapview)
library(sp)
data(meuse)
coordinates(meuse) <- ~x+y
proj4string(meuse) <- CRS("+init=epsg:28992")
clr <- rep("grey", length(meuse))
fldr <- tempfile()
dir.create(fldr)
pop <- lapply(seq(length(meuse)), function(i) {
clr[i] <- "red"
p <- xyplot(meuse$cadmium ~ meuse$copper,
col = clr, pch = 20, alpha = 0.7)
svg(filename = paste(fldr, "test.svg", sep = "/"),
width = 250 * 0.01334, height = 250 * 0.01334)
print(p)
dev.off()
tst <- paste(readLines(paste(fldr, "test.svg", sep = "/")), collapse = "")
return(tst)
})
mapview(meuse, popup = pop, cex = "cadmium")
You will see that each popup is a scatterplot. As for a leaflet example, consider this:
content <- pop[[1]]
leaflet() %>% addTiles() %>%
addPopups(-122.327298, 47.597131, content,
options = popupOptions(closeButton = FALSE)
)
In case you need the plot to be interactive, you could have a look at library(gridSVG) which is able to produce interactive svg plots from e.g. lattice or ggplot2 plots.
UPDATE:
library(mapview) now has designated functionality for this:
popupGraph: to embed lattice, ggplot2 or interactive hatmlwidgets based plots.
popupImage: to embed local or remote (web) images
This is currently only available in the development version of mapview which can be installed with:
devtools::install_github("environmentalinformatics-marburg/mapview", ref = "develop"
This may be a little late too, but here is a full leaflet implementation. I first create the plot and then use the popupGraph function to add it in.
# make a plot of the two columns in the dataset
p <- xyplot(Home ~ Auto, data = Jun, col = "orange", pch = 20, cex = 2)
# make one for each data point
p <- mget(rep("p", length(Jun)))
# color code it so that the corresponding points are dark green
clr <- rep("orange", length(Jun))
p <- lapply(1:length(p), function(i) {
clr[i] <- "dark green"
update(p[[i]], col = clr)
})
# now make the leaflet map
m1 <- leaflet() %>%
addTiles() %>%
setView(lng = -72, lat = 41, zoom = 8) %>%
# add the markers for the Jun dataset
# use the popupGraph function
addCircleMarkers(data = Jun, lat = ~Lat, lng = ~Lon,
color = ~beatCol(BeatHomeLvl), popup = popupGraph(p),
radius = ~sqrt(BeatHome*50), group = 'Home - Jun') %>%
# layer control
addLayersControl(
overlayGroups = c('Home - Jun'
),
options = layersControlOptions(collapsed = F)
) %>%
# legend for compare to average
addLegend('bottomright', pal = beatCol, values = last$BeatTotalLvl,
title = 'Compare<br>Quote Count to<br>3Mos State Avg',
opacity = 1)
m1
Here is the output.
I'm working with the ggmap tutorial by Manuel Amunategui over at http://amunategui.github.io/ggmap-example/. It is a wonderful introduction to the ggmap package and thankfully I understand his tutorial.
However, I am also trying to make this material interactive through R markdown. When I run the below document, for some reason the rendering of the map is of very low quality. In my standard .R script the image produced is way better. Any thoughts as to what might cause the drastic difference in quality?
Also, in R Markdown, is it possible to have custom sizing of the images as well as placement? I am specifically interested in making the map larger and/or displaying another map with it side-by-side.
This first block of code is just to get your hands on the data if desired.
#install.packages("RCurl"); install.packages("xlsx"); install.packages("zipcode"); install.packages("ggmap")
library(RCurl)
library(xlsx)
# NOTE if you can't download the file automatically, download it manually at:
#'http://www.psc.isr.umich.edu/dis/census/Features/tract2zip/'
urlfile <-'http://www.psc.isr.umich.edu/dis/census/Features/tract2zip/MedianZIP-3.xlsx'
destfile <- "census20062010.xlsx"
download.file(urlfile, destfile, mode="wb")
census <- read.xlsx2(destfile, sheetName = "Median")
#census <- read.xlsx2(file = "census20062010.xlsx", sheetName = "Median")
head(census)
# clean up data
# census <- census[c('Zip','Median..', 'Pop')]
names(census) <- c('Zip','Median', 'Pop')
census$Median <- as.character(census$Median)
census$Median <- as.numeric(gsub(',','',census$Median))
census$Pop <- as.numeric(gsub(',','',census$Pop))
head(census)
# get geographical coordinates from zipcode
library(zipcode)
data(zipcode)
census$Zip <- clean.zipcodes(census$Zip)
census <- merge(census, zipcode, by.x='Zip', by.y='zip')
census$location <- paste0(census$city, ", ", census$state)
names(census) <- sapply(names(census), tolower)
# saved census to census.rdata at this point...
The next chunk of code below is what is in the markdown file.
```{r, message=FALSE, echo=FALSE}
library(ggmap)
library(ggplot2)
load("census.rdata")
inputPanel(
textInput("loc", label = "Location", value = "Orlando, FL"),
sliderInput("zoom", label = "Zoom Level",
min = 1, max = 12, value = 10, step = 1)
)
renderPlot({
census2 <- census[census$location == input$loc,]
map <- get_map(location = input$loc,
zoom = input$zoom,
maptype = 'roadmap',
source = 'google',
color = 'color',
filename = "ggmapTemp")
print(ggmap(map) +
geom_point(
aes(x=longitude, y=latitude,
show_guide = TRUE, size=Median),
data=census2, colour = I('red'), na.rm = T)
)
})
```
Thanks for your help!