R: Converting ggplot objects to interactive graphs - html

I am using the R programming language. I am trying to take different types of graphs (bar graphs, pie charts) and put them on the same page. I generated some fake data and made several graphs - then I put them together (see : Combining Different Types of Graphs Together (R))
library(dplyr)
library(ggplot2)
library(cowplot)
library(gridExtra)
library(plotly)
date= seq(as.Date("2014/1/1"), as.Date("2016/1/1"),by="day")
var <- rnorm(731,10,10)
group <- sample( LETTERS[1:4], 731, replace=TRUE, prob=c(0.25, 0.22, 0.25, 0.25) )
data = data.frame(date, var, group)
data$year = as.numeric(format(data$date,'%Y'))
data$year = as.factor(data$year)
###Pie
Pie_2014 <- data %>%
filter((data$year == "2014")) %>%
group_by(group) %>%
summarise(n = n())
Pie_2014_graph = ggplot(Pie_2014, aes(x="", y=n, fill=group)) +
geom_bar(stat="identity", width=1) +
coord_polar("y", start=0) +ggtitle( "Pie Chart 2014")
Pie_2015 <- data %>%
filter((data$year == "2015")) %>%
group_by(group) %>%
summarise(n = n())
Pie_2015_graph = ggplot(Pie_2015, aes(x="", y=n, fill=group)) +
geom_bar(stat="identity", width=1) +
coord_polar("y", start=0) +ggtitle( "Pie Chart 2015")
Pie_total = data %>%
group_by(group) %>%
summarise(n = n())
Pie_total_graph = ggplot(Pie_total, aes(x="", y=n, fill=group)) +
geom_bar(stat="identity", width=1) +
coord_polar("y", start=0) +ggtitle( "Pie Chart Average")
###bars
Bar_years = data %>%
group_by(year, group) %>%
summarise(mean = mean(var))
Bar_years_plot = ggplot(Bar_years, aes(fill=group, y=mean, x=year)) +
geom_bar(position="dodge", stat="identity") + ggtitle("Bar Plot All Years")
Bar_total = data %>%
group_by(group) %>%
summarise(mean = n())
Bar_total_plot = ggplot(Bar_total, aes(x=group, y=mean, fill=group)) +
geom_bar(stat="identity")+theme_minimal() + ggtitle("Bar Plot Average")
#assembling the graphs can be done two different ways
#first way
g1 <- grid.arrange(Pie_2014_graph, Pie_2015_graph , Pie_total_graph, nrow = 1)
g2 <- grid.arrange(Bar_total_plot, Bar_years_plot, nrow = 1)
g = grid.arrange(g1, g2, ncol = 1)
#second way
# arrange subplots in rows
top_row <- plot_grid(Pie_2014_graph, Pie_2015_graph, Pie_total_graph)
middle_row <- plot_grid(Bar_years_plot, Bar_total_plot)
# arrange our new rows into combined plot
p <- plot_grid(top_row, middle_row, nrow = 2)
p
From here, I am trying to use the plotly::ggplotly() command to make the above output "interactive" (move the mouse over the graphs and see labels). I know that this works for individual plots:
ggplotly(Bar_years_plot)
However, this command does not seem to work with the "cowplot" and the "gridExtra" outputs:
#gridExtra version:
ggplotly(g)
Error in UseMethod("ggplotly", p) :
no applicable method for 'ggplotly' applied to an object of class "c('gtable', 'gTree', 'grob', 'gDesc')"
#cowplot version: (produces empty plot)
ggplotly(p)
Warning messages:
1: In geom2trace.default(dots[[1L]][[1L]], dots[[2L]][[1L]], dots[[3L]][[1L]]) :
geom_GeomDrawGrob() has yet to be implemented in plotly.
If you'd like to see this geom implemented,
Please open an issue with your example code at
https://github.com/ropensci/plotly/issues
2: In geom2trace.default(dots[[1L]][[1L]], dots[[2L]][[1L]], dots[[3L]][[1L]]) :
geom_GeomDrawGrob() has yet to be implemented in plotly.
If you'd like to see this geom implemented,
Please open an issue with your example code at
https://github.com/ropensci/plotly/issues
Does anyone know if there is a quick way to use the ggplotly() function for objects created with "gridExtra" or "cowplot"?
I know that with a bit of work, it might be possible using "htmltools":
library(htmltools)
doc <- htmltools::tagList(
div(Pie_2014_graph, style = "float:left;width:50%;"),
div(Pie_2015_graph,style = "float:left;width:50%;"),
div(Pie_total_graph, style = "float:left;width:50%;"),
div(Bar_years_plot, style = "float:left;width:50%;"),
div(Bar_total_plot, style = "float:left;width:50%;"))
save_html(html = doc, file = "out.html")
But I am not sure how to do this.
Can someone please show me how to make the collections of graphs interactive either using ggplotly() or with htmltools()?
Thanks.

You should apply ggplotly() to the individual graphs, not the collection graphs.
For example:
Pie_2014_graph = ggplotly(ggplot(Pie_2014, aes(x="", y=n, fill=group)) +
geom_bar(stat="identity", width=1) +
coord_polar("y", start=0) +ggtitle( "Pie Chart 2014") )

Related

Group by multiple columns in a function in dplyr

I want to create a function that takes an externally defined variable and uses it in a group by using dplyr. Here is what I have so far:
data(mtcars)
my_grp_col <- 'gear'
calculate_mean <- function(data, grouping_column, target){
data %>%
group_by(cyl, am, {{my_grp_col}}, target) %>%
summarize(mean(target, na.rm = T))
}
calculate_mean(data = mtcars, grouping_column = my_grp_col, target = mpg)
Essentially, I want to group by cyl, am, gear (which I have defined externally) and then calculate the mean of target (mpg).
The following would work (note that you need also {{...}} around target in this case):
data(mtcars)
my_grp_col <- 'gear'
calculate_mean <- function(data, grouping_column, target){
data %>%
group_by(cyl, am, !!sym(grouping_column), {{target}}) %>%
summarize(mean(target, na.rm = T))
}
calculate_mean(data = mtcars, grouping_column = my_grp_col, target = mpg)
However, it would look much nicer if you also directly give grouping_column without defining it as string before:
calculate_mean <- function(data, grouping_column, target){
data %>%
group_by(cyl, am, {{grouping_column}}, {{target}}) %>%
summarize(mean(target, na.rm = T))
}
calculate_mean(data = mtcars, grouping_column = gear, target = mpg)

Several lines with different style in Caption in both html and docx - flextable

I need to show data caption, computer name and period in the header of table.
I have also requirements: zebra theme, merging cells if needed. That's why I chose flextable.
Here is my code:
library(officer) # border settings library
library(flextable) # drawing tables library
library(dplyr)
Caption <- "<b><big>Computer01.domain.com</big></b><br>Network Interface<br>Gbit Total/sec<br><small>2021-05-14 18:04 to 2021-05-25 13:29</small>"
bold_border <- fp_border(color="gray", width =2)
std_border <- fp_border(color="gray")
stub <- "2021-05-14 01:40 to 2021-05-17 08:26"
table_data <- data.frame (
Instance = c("Intel[R] Ethernet 10G",
"Intel[R] Ethernet Converged Network Adapter _1",
"Intel[R] Ethernet Converged Network Adapter _2",
"Intel[R] Ethernet 10G",
"Intel[R] Gigabit"),
Max = c(2.45, 2.41, 2.29, 2.17, 0),
Avg = c(0.15, 0.15, 0.15, 0.17, 0)
)
table <- table_data %>% flextable() %>%
set_caption(caption = Caption , html_escape = F) %>%
bg(bg = "#579FAD", part = "header") %>%
color(color = "white", part = "header") %>%
theme_zebra(
odd_header = "#579FAD",
odd_body = "#E0EFF4",
even_header = "transparent",
even_body = "transparent"
) %>%
set_table_properties(width = 1, layout = "autofit") %>%
hline(part="all", border = std_border ) %>%
vline(part="all", border = std_border ) %>%
border_outer( border = bold_border, part = "all" ) %>%
fix_border_issues() %>%
set_header_labels(
values = list(Instance = InstanceName ) ) %>%
flextable::font (part = "all" , fontname = "Calibri")
save_as_docx( table, path = file.path("c:\\temp", "test01.docx") )
save_as_html (table, path = file.path("c:\\temp", "test01.html"))
Here is what I got in html which is okay for me:
But in docx format my header style is not applied:
How can I create header like I did for html that can be saved to both html and docx?
If I have to create separate tables - one for html, other for docx - it's not so good but acceptable options. That case my question how to create header I made in html but for docx format?

Post local image into a popup using leaflet and R

I've been trying like crazy to add local images (as in image files in my computer) into my leaflet map using R. I have plotted around 500 coordinates analyzing some images and I wish to show that specific image when clicking (popup).
leaflet(pics) %>%
addTiles() %>%
addCircleMarkers(
fillOpacity = 0.8, radius = 5,
lng = ~GPSLongitude, lat =~GPSLatitude,
color = ~pal(Married),
popup = ~SourceFile, # WISH TO ADD EMBEDDED LOCAL IMAGE IN HERE
label = mapply(function(x, y) {
HTML(sprintf("<em>%s</em></br> %s", htmlEscape(x), htmlEscape(y)))},
pics$Address, pics$DateTimeOriginal, SIMPLIFY = F),
labelOptions = lapply(1:nrow(pics), function(x) {
labelOptions(direction='auto')
}))
I am attaching 2 screenshots: one hovering the mouse and the other one clicking on a specific place. Ideally, I'd wish to show the image and the image file name when I click on each one. Is that possible?
I can also show you an RPub with the example: http://rpubs.com/laresbernardo/photomap
Hope you can help me. Thanks!
_________________________ UPDATE _________________________
All code used for this example. Basically I scan for all images with geotags, bring the address to add on a label and then plot all coordinates. When I click on a coordinate I wish to see that picture.
wd <- "/Users/bernardo/Dropbox (Personal)/Documentos/R/R Mapping/GPS Photos"
# ------------------------------------------- get the pics with geotags
library(exifr)
library(dplyr)
library(lubridate)
library(beepr)
library(maps)
time <- Sys.time(); print(time)
setwd("/Users/bernardo/Dropbox (Personal)/Imágenes")
files <- list.files(pattern = "*.jpg|*.JPG|*.png|*.PNG", recursive=T)
exif <- read_exif(files, tags = c("SourceFile", "DateTimeOriginal", "GPSLongitude", "GPSLatitude"))
pics <- exif %>% filter(!is.na(GPSLongitude)) %>%
mutate(DateTimeOriginal = ymd_hms(DateTimeOriginal))
pics$Owner <- ifelse(grepl("iPhone Maru", pics$SourceFile), "Maru", "Ber")
pics$Married <- ifelse(as.Date(pics$DateTimeOriginal) >= '2016-04-30', TRUE, FALSE)
pics$Country <- maps::map.where(database="world", pics$GPSLongitude, pics$GPSLatitude)
#lares::freqs(pics %>% filter(!is.na(Country)), Country)
# Save pics with geotags
setwd(wd)
write.csv(pics, "with_geotags.csv", row.names = F)
print(Sys.time() - time)
beepr::beep()
# ------------------------------------------- get the addresses from files
# GET ALL ADDRESSES
library(ggmap)
options(warn=-1)
setwd(wd)
pics <- read.csv("with_geotags.csv")
addresses <- read.csv("with_address.csv")
pics_to_search <- pics %>% filter(!SourceFile %in% addresses$SourceFile)
print(paste0("Without address: ",round(100 * nrow(pics_to_search)/nrow(pics), 2),"% | ", nrow(pics_to_search)))
out <- data.frame()
for (i in 1:nrow(pics_to_search)) {
Address <- revgeocode(cbind(pics_to_search$GPSLongitude, pics_to_search$GPSLatitude)[i,], output="address")[1]
if (!is.na(Address)) {
out <- rbind(out, cbind(SourceFile=as.character(pics_to_search$SourceFile[i]), Address))
print(paste(i, Address, sep=" - "))
}
}
# Save pics with geotags
pics_with_address <- rbind(out, addresses)
write.csv(pics_with_address, "with_address.csv", row.names = F)
# ------------------------------------------- Map all coordinates with leaflet
setwd(wd)
library(leaflet)
library(htmltools)
library(mapview)
pics <- read.csv("with_geotags.csv")
address <- read.csv("with_address.csv")
pal <- colorFactor(c("green4", "navy"), domain = c(FALSE, TRUE))
pics <- left_join(pics, address, by=c("SourceFile"))
pics$Content <- paste("Dirección:","<em>", pics$Address,"</em>", "<br/> Fecha:", as.Date(pics$DateTimeOriginal))
leaflet(pics) %>%
addTiles() %>%
addCircleMarkers(
fillOpacity = 0.8, radius = 5,
lng = ~GPSLongitude, lat =~GPSLatitude,
color = ~pal(Married),
popup = popupImage(as.character(pics$SourceFile), src = "local"),
label = mapply(function(x, y) {
HTML(sprintf("<em>%s</em></br> %s", htmlEscape(x), htmlEscape(y)))},
pics$Address, pics$DateTimeOriginal, SIMPLIFY = F),
labelOptions = lapply(1:nrow(pics), function(x) {
labelOptions(direction='auto')
}))
But...
I even installed the latest version with devtools::install_github("r-spatial/mapview#develop")
With no reproducible example it is hard, but takes this for instance:
library(leaflet)
library(mapview)
# make-up dataset
data_df <- data.frame(lat = as.numeric(c("35.68705", "35.88705")), long = as.numeric(c("51.38", "53.35")))
# Loaded random pictures on my laptop
images <- c("/PathToImage1/download.jpeg",
"/PathToImage2/download1.jpeg")
leaflet(data_df) %>%
addTiles() %>%
addCircleMarkers(
fillOpacity = 0.8, radius = 5,
lng = ~long, lat =~lat,
popup = popupImage(images)
)
Click on each point to see a different image. Make sure to load your images in the same order as your data frame.
Finally after lots of hours wasted in this problem, I managed to fix the issue. Thanks to #MLavoie and #TimSalabim3 (via Twitter) for the support.
This was it: if you are running macOS, you should have installed a driver called gdal. I literally just installed it, ran the original script and it worked. Don't know what that gdal does but it really did the job!

labels in leaflet r with HTML tags

All good souls, help needed. I am creating a leaflet map and cannot resolve a strange issue with labels. I created labels with few variables and the labels render ok if the first variable is numeric, but they fail if the first is a string - any idea what's the issue?
Let's start with a dummy spdf:
library(htmltools)
library(sp)
library(leaflet)
df <- new("SpatialPointsDataFrame", data = structure(list(PMID = c(184397, 184397), SPACEID = c("184397_1", "184397_2")), .Names = c("PMID", "SPACEID"), row.names = 1:2, class = "data.frame"), coords.nrs = numeric(0), coords = structure(c(-0.14463936, -0.14468822, 51.50726534, 51.50730171), .Dim = c(2L, 2L), .Dimnames = list(c("1", "2"), c("x", "y"))), bbox = structure(c(-0.14468822, 51.50726534, -0.14463936, 51.50730171), .Dim = c(2L, 2L), .Dimnames = list(c("x", "y"), c("min", "max"))), proj4string = new("CRS", projargs = "+proj=longlat +datum=WGS84 +no_defs +ellps=WGS84 +towgs84=0,0,0"))
now we (m)apply a simple HTML line (the original used the df rows but it is not needed and can be simplified to
df#data$HT<-mapply(function(x,y){htmltools::HTML(sprintf("<h2>%s</h2> %s",x,y))},1,"L", SIMPLIFY = F)
and this one will work fine. But if the order is reversed - instead of (1,"L") we change to ("L",1) - it fails:
df#data$HT<-mapply(function(x,y){htmltools::HTML(sprintf("<h2>%s</h2> %s",x,y))},"L",1, SIMPLIFY = F)
in the first case the map contains correct labels and in the other one it produces empty label
leaflet() %>%
addTiles() %>%
addMarkers(data = df, label = ~ HT)
if I use label = ~as.character(HT) it shall produce a verbatim HTML tag, but not the label. What's wrong with it?
After playing around the code, I found that replacing mapply() with map2() in the purrr package does the trick here. I am not totally sure why this is the case. Both Slav and I confirmed that this solution is working on our machines.
library(sp)
library(leaflet)
library(htmltools)
library(purrr)
df#data$HT1 <- map2(1, "L", ~htmltools::HTML(sprintf("<h2>%s</h2> %s",.x,.y)))
df#data$HT2 <- map2("L", 1, ~htmltools::HTML(sprintf("<h2>%s</h2> %s",.x,.y)))
leaflet()%>%
addProviderTiles("OpenStreetMap.Mapnik") %>%
addLabelOnlyMarkers(data = df, label = ~HT2,
labelOptions = labelOptions(noHide = TRUE, direction = 'center',
textOnly = FALSE, textsize = "15px"))

htmlwidgets side by side in html?

Say I have two htmlwidgets
# Load energy projection data
# Load energy projection data
library(networkD3)
URL <- paste0(
"https://cdn.rawgit.com/christophergandrud/networkD3/",
"master/JSONdata/energy.json")
Energy <- jsonlite::fromJSON(URL)
# Plot
sankeyNetwork(Links = Energy$links, Nodes = Energy$nodes, Source = "source",
Target = "target", Value = "value", NodeID = "name",
units = "TWh", fontSize = 12, nodeWidth = 30)
and
library(leaflet)
data(quakes)
# Show first 20 rows from the `quakes` dataset
leaflet(data = quakes[1:20,]) %>% addTiles() %>%
addMarkers(~long, ~lat, popup = ~as.character(mag))
And I want to put them side by side in an html page. How can I do this? Could I use an iframe? Other?
There are lots of ways to answer this. Often sizing and positioning will vary based on who authored the htmlwidget, so you might need to experiment a little. The easiest way if you don't plan to use a CSS framework with grid helpers will be to wrap each htmlwidget in tags$div() and use CSS. You also might be interested in the very nice new flexbox-based dashboard package from RStudio http://github.com/rstudio/flexdashboard.
# Load energy projection data
# Load energy projection data
library(networkD3)
URL <- paste0(
"https://cdn.rawgit.com/christophergandrud/networkD3/",
"master/JSONdata/energy.json")
Energy <- jsonlite::fromJSON(URL)
# Plot
sn <- sankeyNetwork(Links = Energy$links, Nodes = Energy$nodes, Source = "source",
Target = "target", Value = "value", NodeID = "name",
units = "TWh", fontSize = 12, nodeWidth = 30,
width = "100%")
library(leaflet)
data(quakes)
# Show first 20 rows from the `quakes` dataset
leaf <- leaflet(data = quakes[1:20,]) %>% addTiles() %>%
addMarkers(~long, ~lat, popup = ~as.character(mag))
library(htmltools)
browsable(
tagList(list(
tags$div(
style = 'width:50%;display:block;float:left;',
sn
),
tags$div(
style = 'width:50%;display:block;float:left;',
leaf
)
))
)