I'm trying to render some highcharter charts in jupyterlab
data(diamonds, economics_long, mpg, package = "ggplot2")
library(dplyr)
library(highcharter)
hchart(mpg, "scatter", hcaes(x = displ, y = hwy, group = class))
to get plotlywrapper working you need to install an extension. I can imagine something similar has to be built for highcharter?
error message:
HTML widgets cannot be represented in plain text (need html)
https://blog.ouseful.info/2018/04/26/r-htmlwidgets-in-jupyter-notebooks/
data(diamonds, economics_long, mpg, package = "ggplot2")
library(dplyr)
library(highcharter)
x=hchart(mpg, "scatter", hcaes(x = displ, y = hwy, group = class)) %>%
hc_size(width=800, height = 400)
saveWidget(x, 'demox.html', selfcontained = FALSE)
display_html('<iframe src="demox.html", width = 900, height = 500 ></iframe>')
Related
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?
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") )
Creating a leaflet map. First step, specify the label. The code used on leaflet github puts
%>% lapply(htmltool::HTML)
after the sprintf() function. However, making it is creating the label as a type:"list" resulting in the error: "Error in sum(sapply(label, function(x) { : invalid 'type' (list) of argument"
So to try and get around this I just load the htmltools library and use the code
HTML(sprintf(...))
Doing this works and runs the map, however, the labels show up as small boxes with no information (see picture link below)
I can't tell if this is something to do with the code inside sprintf() or if this has to do with HTML().
The weird thing is that the %>% lapply method was working just fine, but something happened and now its giving the error mentioned above
Image with the small label shown as little white box
labels.dest2 <- sprintf("<div style = 'overflow-wrap: anywhere;'><strong>%s <br/>%s Destinations</div><br/>%s Euclidean Miles from LAX on average<br/>%s minutes between OD tweets </div><br/>%s Miles from LAX on average</div><br/>%s minutes from LAX on average</div>",
puma.spdf$NAME,
puma.spdf$Dest_pt_count,
puma.spdf$Avg_Euc_Dist_Mi,
puma.spdf$Avg_tweetTime,
puma.spdf$Avg_RtDist_Mi,
puma.spdf$Avg_RtTime_min) %>% lapply(htmltools::HTML)
leaflet() %>% addTiles() %>% etc...
FULL CODE HERE
## Map with OD data and travel stats ##
labels.dest2 <- HTML(sprintf("<div style = 'overflow-wrap: anywhere;'> <strong>%s <br/>%g Destinations</div><br/>%s Euclidean Miles from LAX on average<br/>%s minutes between OD tweets </div><br/>%s Miles from LAX on average</div><br/>%s minutes from LAX on average</div>",
puma.spdf$NAME,
puma.spdf$Dest_pt_count,
puma.spdf$Avg_Euc_Dist_Mi,
puma.spdf$Avg_tweetTime,
puma.spdf$Avg_RtDist_Mi,
puma.spdf$Avg_RtTime_min))
leaflet() %>% addTiles() %>%
setView(lng=-118.243683, lat=34.1, zoom = 9.35) %>%
addEasyButton(easyButton(
icon="fa-crosshairs", title = "Default View",
onClick=JS("function(btn, map) {var groupLayer = map.layerManager.getLayerGroup('Destinations (red)'); map.fitBounds(groupLayer.getBounds());}"))) %>%
addProviderTiles(providers$CartoDB.Positron,
group = "Grey") %>%
addProviderTiles(providers$OpenStreetMap.BlackAndWhite,
group = "OSM") %>%
# Add Polygons
# Destination data
addPolygons(data = puma.spdf,
group = "Destination Density",
fillColor = ~pal.dest(Dest_pt_count),
weight = 1,
opacity = 90,
color = "white",
dashArray = "3",
fillOpacity = 0.5,
highlight = highlightOptions(weight = 2,
color = "#666",
dashArray = "",
fillOpacity = 0.7,
bringToFront = TRUE,
sendToBack = TRUE),
label = labels.dest2,
labelOptions = labelOptions(style = list("font-weight" = "normal", padding = "3px 8px"),
textsize = "15px",
direction = "auto")) %>%
addLegend(values=puma.spdf$Dest_pt_count,
group = "Destination Density",
pal=pal.dest,
title="Destination Density (Dest per PUMA)",
position = "bottomright") %>%
# Add Points
addCircleMarkers(data = D.spdf,
radius = 2,
color = "red",
group = "Destinations (red)",
fillOpacity = 0.5) %>%
addCircleMarkers(data = O.spdf,
radius = 2,
color = "green",
group = "Origins (green)") %>%
# Add Layer Controls
addLayersControl(
baseGroups = c("OSM (default)", "Grey"),
overlayGroups = c("Destinations (red)", "Origins (green)","Destination Density"),
options = layersControlOptions(collapsed = FALSE)
)
The problem was that the first column puma.spdf$NAME was not part of the dataset and was throwing off the string.. check to make sure all the variables you want to show are actually part of the dataset.
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"))
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
)
))
)