need some help and would be grateful for any advice. I want to create an interactive treemap in R. So far, so good, so bad. I managed that and was able to create an HTML widget, but when I open it, the legend isn't there anymore. In the original plot it is still there, but not as a saved file. I would be grateful for tips! this is my code:
library(tidyverse) library(readr) library(lubridate) library(ggthemes) library(treemap) library(d3treeR) library(readxl) library(htmlwidgets) df <- read_excel("df.xlsx")
Tidydata <- df %>% group_by(Level1, Level2, Level3) %>% summarise(Count = n())
tree <- treemap(Tidydata, index=c("Level1", "Level2", "Level3") ,vSize="Count" ,vColor="Count", type="value", border.col=c("black","white"), palette = "Greens", title="Treemap",
fontsize.title=16, fontsize.labels = 7, title.legend = "Counts" )
int <- d3tree(tree,width = "200%", height ="600px", rootname = "Level1")
saveWidget(int, file="TreePlot.html", selfcontained = T)
Update: I found out how to resolve the Problem with the missing legend and the overlapping issues.
If you are struggeling with the same issue, please use
int <- **d3tree2**(tree,width = "200%", height ="600px", rootname = "Level1")
instead of
int <- d3tree(tree,width = "200%", height ="600px", rootname = "Level1")
and you can create very nice interactive treemaps.
I want to create png icons with single bar (from standard barplot or ggplot2 geom_col). Icons will be presented on leaflet map. There is data.frame: lat,lon,val. Parameter "val" is used to set height of bar (only one bar on one icon). Icons must have the same size, bars must have the same width, each bar with label above (val). Height of bar is restricted with maximum value (icon height).
Example image - map with icons to be reconstructed
Sample code is below. I used hints from here:
R Barplot with one bar - how to plot correctly
Result with my code - all have the same height
lats = c(69.5, 70.0, 69.0)
lons = c(33.0,33.5,34.3)
vals = c(7,19,5)
df = data.frame(lats, lons, vals)
for (i in 1:3) {
png(file=paste0(i,".png"), width=100, height=200, res=72)
bp <- barplot(df$vals[i], height =df$vals[i],
width=0.2, xlim=c(0,1.2), col="brown4", axes=FALSE);
text(bp, 10*df$vals[i]+10, labels=df$vals[i]);
dev.off()
}
I used advice from #Axeman and carried out a few experiments with png/barplot parameters.
Problem is solved. The result is as following.
library(shiny)
library(leaflet)
ui <- fluidPage(leafletOutput("map"))
myicon=function(condition){
makeIcon(
iconUrl = paste0(condition,".png"),
iconWidth = 30, iconHeight = 80
)}
server <- function(input, output, session) {
lats = c(69.5, 70.0, 69.0)
lons = c(33.0,33.5,34.3)
vals = c(7,12,5)
df = data.frame(lats, lons, vals)
for (i in 1:nrow(df)) {
png(file=paste0(i,".png"), bg="transparent",width=3, height=10, units="in", res=72)
bp <- barplot(df$vals[i], height =10*df$vals[i],
width=1, ylim=c(0,max(10*df$vals)+30),col="brown4", axes=FALSE);
text(bp,10*df$vals[i]+20,labels=df$vals[i],cex=10,font=2);
dev.off()
}
output$map <- renderLeaflet({
top=70.4;
bottom=66.05;
right=42.05;
left=27.5;
leaflet(data = df,
options = leafletOptions(minZoom = 3,maxZoom = 10))%>%
fitBounds(right,bottom,left,top)%>%
addTiles()%>%
addProviderTiles("Esri.OceanBasemap") %>%
addMarkers(
icon = myicon(index(df)),
lng = lons, lat = lats,
options = markerOptions(draggable = TRUE))
})
}
shinyApp(ui, server)
I am looking to plot a stop-motion animation of a sequence of plots in R. These will show dots moving around on a trajectory. I would like to show a map in the background so that the locations of the moving points correspond to the map coordinates. The way I have been doing this is through RgoogleMaps, where I created a map object and then stored it as a png file, then I set it as the background of the plot using the rasterImage function. Ultimately I am trying to have this be a shiny app (code below).
The problem is that the animation speed I have in shiny is too fast (I can slow it down but it doesn't look as good), so the plot goes opaque because it can't process it fast enough.
Basically I want to show one set of points per iteration with the same background. Is there a more efficient way to do this? Is there a way to, say, set the background image permanently without having to plot it each time. I save some time by using recordPlot() and then replaying it, but it still doesn't completely solve the problem. I have also tried seeing if I can make the raster lower resolution but the maxpixels and col arguments in as.raster don't seem to be doing anything for me.
I am not 100% sold on having to use GoogleMaps if there is a similar alternative that is much more efficient and will achieve roughly the same thing.
BC_googlemaps_point
library(shiny)
library(colorspace)
library(raster)
library(grDevices)
library(png)
#a png from Google Maps of the area above
bc_longlat_map_img <- png::readPNG("BC_googlemaps_point.png")
bc_longlat_map_img_ras <- grDevices::as.raster(bc_longlat_map_img, maxpixels=100)
bbox <- matrix(c(33.68208, -118.0554, 33.70493, -118.0279), byrow=TRUE, ncol=2)
rownames(bbox) <- c("lon","lat")
colnames(bbox) <- c("min","max")
#make some fake data
pt_data <- matrix(NA,nrow=1000, ncol=2)
colnames(pt_data) <- c("lon","lat")
#length of each side
plot_dims <- apply(bbox,1,diff)
pt_data[1:250,"lon"] <- bbox["lon","min"] + 0.2*plot_dims["lon"]
pt_data[1:250,"lat"] <- seq(bbox["lat","min"]+0.2*plot_dims["lat"], bbox["lat","max"]-0.2*plot_dims["lat"], length.out=250)
pt_data[251:500,"lon"] <- seq(bbox["lon","min"]+0.2*plot_dims["lon"], bbox["lon","max"]-0.2*plot_dims["lon"], length.out=250)
pt_data[251:500,"lat"] <- bbox["lat","max"] - 0.2*plot_dims["lat"]
pt_data[501:750,"lon"] <- bbox["lon","max"] - 0.2*plot_dims["lon"]
pt_data[501:750,"lat"] <- seq(bbox["lat","max"]-0.2*plot_dims["lat"], bbox["lat","min"]+0.2*plot_dims["lat"], length.out=250)
pt_data[751:1000,"lon"] <- seq(bbox["lon","max"]-0.2*plot_dims["lon"], bbox["lon","min"]+0.2*plot_dims["lon"], length.out=250)
pt_data[751:1000,"lat"] <- bbox["lat","min"] + 0.2*plot_dims["lat"]
#this is the slowest, have to replot the whole thing each time
for (ii in 1:1000) {
plot(bbox["lon",1]-1000, bbox["lat",1]-1000, xlim=bbox["lon",], ylim=bbox["lat",], xlab="Longitude", ylab="Latitude", las=1)
#read in current plots limits to fit Raster Image to
lims <- par()$usr
rasterImage(bc_longlat_map_img_ras, xleft=lims[1], ybottom=lims[3], xright=lims[2], ytop=lims[4])
points(x=pt_data[ii,"lon"], y=pt_data[ii,"lat"], pch=19, cex=3)
}
#plot first, then record, and only replay each time
#seems to be a bit faster
plot(bbox["lon",1]-1000, bbox["lat",1]-1000, xlim=bbox["lon",], ylim=bbox["lat",], xlab="Longitude", ylab="Latitude", las=1)
#read in current plots limits to fit Raster Image to
lims <- par()$usr
rasterImage(bc_longlat_map_img_ras, xleft=lims[1], ybottom=lims[3], xright=lims[2], ytop=lims[4])
plot_back <- recordPlot()
for (ii in 1:1000) {
replayPlot(plot_back)
points(x=pt_data[ii,"lon"], y=pt_data[ii,"lat"], pch=19, cex=3)
}
#example without the map background. very fast.
for (ii in 1:1000) {
plot(bbox["lon",1]-1000, bbox["lat",1]-1000, xlim=bbox["lon",], ylim=bbox["lat",], xlab="Longitude", ylab="Latitude", las=1)
points(x=pt_data[ii,"lon"], y=pt_data[ii,"lat"], pch=19, cex=3)
}
The shiny app I am trying to implement looks like this (code is repetitive):
shark_vis <- shinyApp(
ui= shinyUI(
fluidPage(
sidebarLayout(
sidebarPanel("Inputs",
sliderInput("iter","Progress of simulation",value=1, min=1, max=1000, round=TRUE, step=1,
animate=animationOptions(interval=100, loop=FALSE))),
mainPanel(plotOutput("plot"))
)
)
),
server=shinyServer(
function(input, output) {
#current image dimensions
bbox <- matrix(c(33.68208, -118.0554, 33.70493, -118.0279), byrow=TRUE, ncol=2)
rownames(bbox) <- c("lon","lat")
colnames(bbox) <- c("min","max")
#make some fake data
pt_data <- matrix(NA,nrow=1000, ncol=2)
colnames(pt_data) <- c("lon","lat")
#length of each side
plot_dims <- apply(bbox,1,diff)
pt_data[1:250,"lon"] <- bbox["lon","min"] + 0.2*plot_dims["lon"]
pt_data[1:250,"lat"] <- seq(bbox["lat","min"]+0.2*plot_dims["lat"], bbox["lat","max"]-0.2*plot_dims["lat"], length.out=250)
pt_data[251:500,"lon"] <- seq(bbox["lon","min"]+0.2*plot_dims["lon"], bbox["lon","max"]-0.2*plot_dims["lon"], length.out=250)
pt_data[251:500,"lat"] <- bbox["lat","max"] - 0.2*plot_dims["lat"]
pt_data[501:750,"lon"] <- bbox["lon","max"] - 0.2*plot_dims["lon"]
pt_data[501:750,"lat"] <- seq(bbox["lat","max"]-0.2*plot_dims["lat"], bbox["lat","min"]+0.2*plot_dims["lat"], length.out=250)
pt_data[751:1000,"lon"] <- seq(bbox["lon","max"]-0.2*plot_dims["lon"], bbox["lon","min"]+0.2*plot_dims["lon"], length.out=250)
pt_data[751:1000,"lat"] <- bbox["lat","min"] + 0.2*plot_dims["lat"]
#plot and store
plot(bbox["lon",1]-1000, bbox["lat",1]-1000, xlim=bbox["lon",], ylim=bbox["lat",], xlab="Longitude", ylab="Latitude", las=1)
#read in current plots limits to fit Raster Image to
lims <- par()$usr
rasterImage(bc_longlat_map_img_ras, xleft=lims[1], ybottom=lims[3], xright=lims[2], ytop=lims[4])
plot_back <- recordPlot()
output$plot <- renderPlot({
replayPlot(plot_back)
points(x=pt_data[input$iter,"lon"], y=pt_data[input$iter,"lat"], pch=19, cex=3, col=1:2)
})
}
)
)
runApp(shark_vis)
You can use my googleway package to 'simulate' an animation onto an actual Google Map.
I've simplified your example so I could get it to work, but the idea should translate to your example too.
Here I'm animating the route between Melbourne and Sydney
To do the animation you load a series of circles onto the map, then set the opacity to either 0 or 1 depending on which ones you want shown.
In this instance the ones you want shown are dependant on the value of the input slider.
The trick to avoid re-drawing the map and shapes each time is to load all the circles at the start, then use the update_circles() function to change the attributes (i.e., opacity) of the circles.
Notes:
You need a valid Google Maps Javascript API key
The input data must be a data.frame, not a matrix
I haven't found the 'break' point yet - i.e., the point at which there are too many circles that they can't update quick enough
library(shiny)
library(googleway)
ui <- fluidPage(
sliderInput(inputId = "mySlider", label = "slider", min = 0, max = 222, value = 0, step = 1,
animate = animationOptions(interval=100, loop=FALSE)),
google_mapOutput("myMap", height = 800)
)
server <- function(input, output){
polyline <- "rqxeF_cxsZgr#xmCekBhMunGnWc_Ank#vBpyCqjAfbAqmBjXydAe{AoF{oEgTqjGur#ch#qfAhUuiCww#}kEtOepAtdD{dDf~BsgIuj#}tHi{C{bGg{#{rGsmG_bDbW{wCuTyiBajBytF_oAyaI}K}bEkqA{jDg^epJmbB{gC}v#i~D`#gkGmJ_kEojD_O{`FqvCetE}bGgbDm_BqpD}pEqdGiaBo{FglEg_Su~CegHw`Cm`Hv[mxFwaAisAklCuUgzAqmCalJajLqfDedHgyC_yHibCizK~Xo_DuqAojDshAeaEpg#g`Dy|DgtNswBcgDiaAgEqgBozB{jEejQ}p#ckIc~HmvFkgAsfGmjCcaJwwD}~AycCrx#skCwUqwN{yKygH}nF_qAgyOep#slIehDcmDieDkoEiuCg|LrKo~Eb}Bw{Ef^klG_AgdFqvAaxBgoDeqBwoDypEeiFkjBa|Ks}#gr#c}IkE_qEqo#syCgG{iEazAmeBmeCqvA}rCq_AixEemHszB_SisB}mEgeEenCqeDab#iwAmZg^guB}cCk_F_iAmkGsu#abDsoBylBk`Bm_CsfD{jFgrAerB{gDkw#{|EacB_jDmmAsjC{yBsyFaqFqfEi_Ei~C{yAmwFt{B{fBwKql#onBmtCq`IomFmdGueD_kDssAwsCyqDkx#e\\kwEyUstC}uAe|Ac|BakGpGkfGuc#qnDguBatBot#}kD_pBmmCkdAgkB}jBaIyoC}xAexHka#cz#ahCcfCayBqvBgtBsuDxb#yiDe{Ikt#c{DwhBydEynDojCapAq}AuAksBxPk{EgPgkJ{gA}tGsJezKbcAcdK__#uuBn_AcuGsjDwvC_|AwbE}~#wnErZ{nGr_#stEjbDakFf_#clDmKkwBbpAi_DlgA{lArLukCBukJol#w~DfCcpBwnAghCweA}{EmyAgaEbNybGeV}kCtjAq{EveBwuHlb#gyIg\\gmEhBw{G{dAmpHp_#a|MsnCcuGy~#agIe#e`KkoA}lBspBs^}sAmgIdpAumE{Y_|Oe|CioKouFwuIqnCmlDoHamBiuAgnDqp#yqIkmEqaIozAohAykDymA{uEgiE}fFehBgnCgrGmwCkiLurBkhL{jHcrGs}GkhFwpDezGgjEe_EsoBmm#g}KimLizEgbA{~DwfCwvFmhBuvBy~DsqCicBatC{z#mlCkkDoaDw_BagA}|Bii#kgCpj#}{E}b#cuJxQwkK}j#exF`UanFzM{fFumB}fCirHoTml#CoAh`A"
df <- decode_pl(polyline)
df$opacity <- 1
df$id <- 1:nrow(df)
rv <- reactiveValues()
rv$df <- df
map_key <- "your_api_key"
output$myMap <- renderGoogle_map({
google_map(key = map_key, data = df) %>%
add_circles(radius = 1000, id = "id", lat = "lat", lon = "lon",
fill_opacity = "opacity", stroke_opacity = "opacity")
})
observeEvent({
input$mySlider
},{
r <- input$mySlider
rv$df[r, "opacity"] <- 1
rv$df[-r, "opacity"] <- 0
google_map_update(map_id = "myMap") %>%
update_circles(data = rv$df, radius = 1000, id = "id",
fill_opacity = "opacity", stroke_opacity = "opacity")
})
}
shinyApp(ui, server)
Screenshots
Starting state: showing everything
step 34 on the slider
step 44 on the slider
step 82 on the slider
I'm using the following code to create a Sankey Diagram using rCharts. I wish to increase the font size of the text printed on the Sankey Diagram. I can't find a manual to show me how to do this. Thoughts?
rm(list = ls())
require(reshape)
require(rCharts)
require(rjson)
target <- c('TMF', 'TMF', 'TMF','Evaporation','Mill Reclaim','Void Losses','Seepage')
source <- c('Precipitation & Run Off','Slurry','Other','TMF','TMF','TMF','TMF')
value <- c(638,1610,755,118,1430,466,2)
x <- data.frame(target,source,value)
sankeyPlot <- rCharts$new()
sankeyPlot$set(
data = x,
nodeWidth = 10,
nodePadding = 10,
layout = 32,
width = 1100,
height = 675,
units = "cubic metres",
title = "Sankey Diagram"
)
sankeyPlot$setLib('http://timelyportfolio.github.io/rCharts_d3_sankey')
sankeyPlot
Based on this answer you can add scripts to customize your plots. To change the text-size, you could add:
sankeyPlot$setTemplate(
afterScript = "
<script>
d3.selectAll('#{{ chartId }} svg text')
.style('font-size', '55')
</script>
")
I was able to change the font size after creating the sankey diagram by setting the fontSize option:
#create sankey diagram
p<-sankeyNetwork(...)
#the default font size
> p$x$options$fontSize
[1] 7
#set desired font size
p$x$options$fontSize<-10