Closed paulyeno closed 10 years ago
@paulyeno A quick answer to your question is that the afterScript
stuff may not work with Shiny. I will have to take a closer look to figure out how best to make this work with Shiny. I know that @woobe had created applications using leaflet heatmap. Maybe he has some advice to offer on how to make this work with Shiny.
Yes Leaflet does work with Shiny (thanks to @ramnathv 's continuous effort on rCharts). Here is my Shiny app for the R user groups plot (https://blenditbayes.shinyapps.io/rugsmaps/). The trick is to use tag$style
and showOutput(...)
in ui.R
For example
tabPanel("All R User Groups (140)",
tags$style('.leaflet {height: 600px;}'),
showOutput('map_all', 'leaflet')),
I have just open-sourced the repo, please go to https://github.com/woobe/rugsmaps and check out the ui.R. If it still doesn't work, let us know.
Joe
Thanks for your quick responses!
@woobe I changed my code to include tag$style
as above, and changed chartOutput(...)
to showOutput(...)
. My issue, though, was not with the display of the map but with the display of the heat map over it in Shiny (works fine in RStudio). I set up my heat map in almost exactly the same way that you did, using Vladimir Agafonkin's jscript; do you know of another way to code it other than using the afterScript
chunk, which @ramnathv thinks Shiny does not like?
Having read through the code again, I finally noticed that you're working on crime data in UK! A few months ago, I did something very similar. Is this similar to what you see in RStudio (http://bl.ocks.org/woobe/9890c5897b864f9c32f3 also see https://github.com/woobe/rCrimemap)?
It's been a while since I last played with leaflet-heat.js
. I will do some tests later and see if I can find a work-around for you.
@woobe Thanks for sharing your project! Your package is a much cleaner version of almost exactly what I am trying to do, except that need to run mine in a browser using parameters from shiny inputs. I tried your package in RStudio and it works great, but unfortunately it has the same issue that my project does in shiny: it will display only the map, and not the heatmap overlay. Any other ideas? Thanks!
@paulyeno Here is what you need to do to make plugins work in Shiny. Take the following code in your server.R
.
HeatMap$addAssets(jshead = c("http://leaflet.github.io/Leaflet.heat/dist/leaflet-heat.js"))
HeatMap$setTemplate(afterScript = sprintf("<script>
var addressPoints = %s
var heat = L.heatLayer(addressPoints).addTo(map)
</script>",
rjson::toJSON(dt)))
This won't work in Shiny, because rCharts
does not pass along afterScript
and addAssets
in renderMap
. So, the solution is to inject these from the UI side.
mainPanel(
tags$head(tags$script(src = "http://leaflet.github.io/Leaflet.heat/dist/leaflet-heat.js")),
chartOutput("HeatMap",'leaflet'),
tags$script(sprintf("<script>
var addressPoints = %s
var heat = L.heatLayer(addressPoints).addTo(map)
</script>",
rjson::toJSON(dt)))
)
)
If dt
is dynamic, you will want to put this in a dynamic ui output on the server side. You can do that using renderUI
and uiOutput
.
Let me know if this helps.
@ramnathv For now, I am trying to simply get the map and heatmap overlay to display in a shiny app, and I will add controls to make this reactive later. I still cannot get the heatmap to be displayed. I inserted the code you wrote above, and get ERROR: object 'dataJSON' not found
in my browser.
I have reworked the code some since I first posted this; including your suggestions, I am now trying:
#server.R
library(shiny);library(plyr);library(rCharts)
maindata<-na.omit(read.csv("Heatmap Data.csv",header=T))
shinyServer(function(input, output){
output$HeatMap<-renderMap({
data<-ddply(maindata,.(lat, lon),summarise,count=length(street))
names(data)<-c("lon","lat","count")
dataJSON<-toJSONArray2(data,json=F,names=F)
HeatMap<-Leaflet$new()
HeatMap$setView(c(median(data[,1]),median(data[,2]),)14)
HeatMap$tileLayer(provider="OpenStreetMap")
HeatMap
})
}
)
and
#ui.R
library(shiny);library(rCharts);library(rjson)
shinyUI(fluidPage(mainPanel(
tags$head(tags$script(src="http://leaflet.github.io/Leaflet.heat/dist/leaflet-heat.js")),
chartOutput("HeatMap",'leaflet'),
tags$script(sprintf("<script>
var addressPoints = %s
var heat = L.heatLayer(addressPoints).addTo(map)
</script>",
rjson::toJSON(dataJSON)))
)))
Could this be an issue with server.R
and ui.R
communicating?
Oh i see that your data is dynamic. So you will need to include the last tags$script
line from the server side and use uiOutput
. I will try to post modified code to do this. Note that it will take me some time to get to this.
@ramnathv The start of a new semester is busy for all of us, and I appreciate that you take the time to help your users out! I understand that it may take a while; no worries.
I have implemented your thoughts above as best I can, and tried tweaking it a bit without success. Currently,
#server.R
library(shiny);library(plyr);library(rCharts);library(rjson)
shinyServer(function(input, output){
maindata<-na.omit(read.csv("Heatmap Data.csv",header=T))
maindata<-ddply(maindata,.(lat, lon),summarise,count=length(street))
dataJSON<-toJSONArray2(maindata,json=F,names=F)
output$HeatMap<-renderMap({
HeatMap<-Leaflet$new()
HeatMap$setView(c(median(maindata[,1]),median(maindata[,2])),14)
HeatMap$tileLayer(provider="OpenStreetMap")
HeatMap
})
output$datamap<-renderUI({
tags$body(tags$script(HTML(sprintf("
var addressPoints = %s
var heat = L.heatLayer(addressPoints).addTo(map)
</script>",
rjson::toJSON(dataJSON)
))))
})
})
and
#ui.R
library(shiny);library(rCharts);library(rjson)
shinyUI(fluidPage(
mainPanel(
tags$head(tags$script(src="leaflet-heat.js")),
chartOutput("HeatMap",'leaflet'),
uiOutput("datamap")
)
))
Any ideas would be appreciated! Thanks again-
The problem is the line rjson::toJSON(dataJSON)
. You need to make dataJSON
available inside of renderUI
.
@ramnathv I moved the line dataJSON<-toJSONArray2(maindata,json=F,names=F)
to within renderUI
, giving
#server.R
library(shiny);library(plyr);library(rCharts);library(rjson)
shinyServer(function(input, output){
maindata<-na.omit(read.csv("Heatmap Data 143 new.csv",header=T))
maindata<-ddply(maindata,.(lat, lon),summarise,count=length(street))
# dataJSON<-toJSONArray2(maindata,json=F,names=F)
output$HeatMap<-renderMap({
HeatMap<-Leaflet$new()
HeatMap$setView(c(median(maindata[,1]),median(maindata[,2])),14)
HeatMap$tileLayer(provider="OpenStreetMap")
HeatMap
})
output$datamap<-renderUI({
dataJSON<-toJSONArray2(maindata,json=F,names=F)
tags$body(tags$script(HTML(sprintf("
var addressPoints = %s
var heat = L.heatLayer(addressPoints).addTo(map)
</script>",
rjson::toJSON(dataJSON)
))))
})
})
which was still not functional.
In looking at the HTML that this generates, without the renderUI
chunk the HTML for the map is created fine. When renderUI
is included, though, the JSON data is generated and added to the HTML, but the map itself is not; the HTML for making the map is not generated if renderUI
is included. It seems like renderUI
surpresses renderMap
somehow... thoughts?
In the same example I put chartOutput("HeatMap",'leaflet'), as the first line in the mainPanel of ui.R
and it worked perfectly (with static maindata).
But if I make reactive filter on the data for heatmap then I will get every new heatmap layer on top of the other and finally rendering will hault.
May be there is a way to delete "var heat" before adding, but I didn't find it out :-(
This is working as I described above (every new raster heatmap overlays ontop of the previous)
# server.R
load('forleaf_saur.RData')
library(shiny);library(rCharts);library(rjson)
shinyServer(function(input, output){
output$choose_date <- renderUI({
dateInput("seldate", "Choose date",
value = "2014-09-01",
min = "2004-01-01",
max = "2014-09-11",
format = "yyyy-mm-dd",
startview = "month",
weekstart = 1, language = "ru")
})
output$choose_country <- renderUI({
selectInput("selcountry", "Select country of the owner",
choices = c("Russia", "Japan", "China", "etc."),
selected = "Russia")
})
output$choose_tves <- renderUI({
unitves <- unique(forleaf_saur$type_ves[forleaf_saur$country == input$selcountry & forleaf_saur$dates ==input$seldate])
checkboxGroupInput("vtype", "Select type of vessels", choices = unitves, selected = unitves)
})
output$baseMap<-renderMap({
baseMap <- Leaflet$new()
baseMap$setView(c(40,150),6)
baseMap$tileLayer(provider="Esri.OceanBasemap")
baseMap
})
output$datamap<-renderUI({
filt <- forleaf_saur$country == input$selcountry & forleaf_saur$dates ==input$seldate & forleaf_saur$type_ves %in% input$vtype
nowxyz <- na.omit(forleaf_saur[filt, c("lat", "lng", "value")])
nowmax <- max(nowxyz$value)
nowjar <- toJSONArray2(nowxyz, json=F, names=F)
s2ins <- rjson::toJSON(nowjar)
tags$body(tags$script(HTML(sprintf("
var addressPoints = %s
var maxval = %f
var heat = L.heatLayer(addressPoints, {max: maxval}).addTo(map)
</script>", s2ins, nowmax
))))
})
})
# ui.R
library(shiny);library(rCharts);library(rjson)
shinyUI(pageWithSidebar(
headerPanel("Catches"),
sidebarPanel(
uiOutput("choose_country"),
uiOutput("choose_date"),
uiOutput("choose_tves")
),
mainPanel(
chartOutput('baseMap','leaflet'),
tags$style('.leaflet {height: 800px;}'),
tags$head(tags$script(src="http://leaflet.github.io/Leaflet.heat/dist/leaflet-heat.js")),
uiOutput('datamap')
)
))
OK, now it works as expected. I've added centering of the view to the basemap as it was in the example of paulyeno.
output$baseMap<-renderMap({
baseMap <- Leaflet$new()
if (is.null(input$selcountry) | is.null(input$seldate) | is.null(input$vtype)) {
filt <- forleaf_saur$country == "Russia" & forleaf_saur$dates == "2014-09-01"
} else {
filt <- forleaf_saur$country == input$selcountry & forleaf_saur$dates ==input$seldate & forleaf_saur$type_ves %in% input$vtype
}
mux <- mean(forleaf_saur$lng[filt])
muy <- mean(forleaf_saur$lat[filt])
baseMap$setView(c(muy,mux),6)
baseMap$tileLayer(provider="Esri.OceanBasemap")
baseMap
})
@Vladicon Great, thanks for your help! Could you post a couple of lines of your forleaf_saur.Rdata
file to allow me to tweak mine easier? Thanks again!
Yes, I can (see below). By the way I had to change options of the heatLayer a little bit from
var heat = L.heatLayer(addressPoints, {max: maxval}).addTo(map)
to
var heat = L.heatLayer(addressPoints, {maxZoom: 9, radius: 20, blur: 25}).addTo(map)
Because the default setting made overlay almost invisible.
Finnaly a chunk of forleaf_saur.Rdata:
country type_ves dates lat lng
Japan MmDS 2013-08-11 43.6667 147.3167
Japan MmDS 2013-08-11 44.25 148.35
Japan MmDS 2013-08-11 43.6167 147.1667
Japan MmDS 2013-08-11 44.2667 148.3333
Japan MmDS 2013-08-11 43.15 146.3833
Japan MmDS 2013-08-11 44.2333 148.2833
Japan MmDS 2013-08-11 45.0833 153.2833
Japan MmDS 2013-08-11 45 153.4667
Japan MmDS 2013-08-11 43.1667 146.6333
Japan MmDS 2013-08-11 44.6667 151.1333
Japan MmDS 2013-08-11 43.25 146.7167
Japan MmDS 2013-08-11 44.5333 150.3
Japan MmDS 2013-08-11 43.2667 146.5667
Japan MmDS 2013-08-11 44.25 148.3
Japan MmDS 2013-08-11 44.85 151.5
Japan MmDS 2013-08-11 44.9667 153.3167
Japan MmDS 2013-08-11 43.2833 146.9667
Japan MmDS 2013-08-11 44.5 151.5
Japan MmDS 2013-08-11 43.2833 146.95
Japan MmDS 2013-08-11 44.5 151.45
Japan MmDS 2013-08-11 45.05 153.2833
Japan MmDS 2013-08-11 45.0333 153.45
Japan MmDS 2013-08-11 43.1 146.5333
Japan MmDS 2013-08-11 44.1 151.3167
Japan MmDS 2013-08-11 45.0667 153.4333
Japan MmDS 2013-08-11 45.0167 153.4
Japan MmDS 2013-08-11 45.0833 153.3
Japan MmDS 2013-08-11 45.0167 153.2167
Japan MmDS 2013-08-11 44.7667 151.3667
Japan MmDS 2013-08-11 45.0833 153.4167
Japan MmDS 2013-08-11 43.1833 146.45
Japan MmDS 2013-08-11 44.2167 148.3333
Japan MmDS 2013-08-11 44.85 151.5333
Japan MmDS 2013-08-11 43.1667 146.3833
Japan MmDS 2013-08-11 44.2167 148.3
Japan MmDS 2013-08-12 43.1667 146.4667
Japan MmDS 2013-08-12 44.5333 150.4333
Japan MmDS 2013-08-12 43.25 146.6833
Japan MmDS 2013-08-12 44.5833 150.3833
Japan MmDS 2013-08-12 43.25 146.7833
Japan MmDS 2013-08-12 44.5833 150.4333
Japan MmDS 2013-08-12 43.1833 146.6667
Japan MmDS 2013-08-12 44.1 149.8667
Japan MmDS 2013-08-12 44.4333 151.85
Japan MmDS 2013-08-12 44.4667 151.8
Japan MmDS 2013-08-12 43.35 147.1
Japan MmDS 2013-08-12 44.5667 150.4833
Japan MmDS 2013-08-12 43.1333 146.4167
Japan MmDS 2013-08-12 44.6 150.5167
Japan MmDS 2013-08-12 43.5167 147.4667
Japan MmDS 2013-08-12 44.5667 150.4167
Japan MmDS 2013-08-12 43.1833 146.6167
Japan MmDS 2013-08-12 44.1167 149.9
Japan MmDS 2013-08-12 43.3 146.8667
Japan MmDS 2013-08-12 44.5333 150.4
Japan MmDS 2013-08-12 43.55 147.9333
Japan MmDS 2013-08-12 44.0167 149.6
Japan MmDS 2013-08-12 43.1833 146.5333
Japan MmDS 2013-08-12 44.55 150.4167
Japan MmDS 2013-08-12 43.2167 146.6167
Japan MmDS 2013-08-12 44.6 150.5333
Japan MmDS 2013-08-12 43.3333 146.95
Japan MmDS 2013-08-12 44.5333 150.3833
Japan MmDS 2013-08-12 43.1667 146.6667
Japan MmDS 2013-08-12 44 149.7667
Japan MmDS 2013-08-12 44.4833 151.7667
Japan CPT 2013-08-12 44.7833 153.6833
Japan MmDS 2013-08-12 43.1667 146.6167
Japan MmDS 2013-08-12 44.3667 151.4833
Japan MmDS 2013-08-12 44.8167 153.5167
Japan MmDS 2013-08-12 44.8667 153.55
Japan MmDS 2013-08-12 43.2 146.7833
Japan MmDS 2013-08-12 44.4 151.5
Japan CPTM 2013-08-12 43.1667 146.6
Japan CPTM 2013-08-12 44.4333 151.5667
Japan CPTM 2013-08-12 43.15 146.5667
Japan CPTM 2013-08-12 44.45 151.55
Japan SDS 2013-08-12 44.55 152.1833
Japan MmDS 2013-08-12 44.8167 153.6167
Japan MmDS 2013-08-12 44.75 152.7167
Japan MmDS 2013-08-12 43.35 147.35
Japan MmDS 2013-08-12 44.35 151.5
Japan MmDS 2013-08-12 44.8333 153.5
Japan MmDS 2013-08-12 44.85 153.5333
Japan MmDS 2013-08-12 44.8667 153.5
Japan MmDS 2013-08-12 44.8 153.65
Japan MmDS 2013-08-12 44.8833 153.5667
Japan MmDS 2013-08-12 44.85 153.5667
Japan MmDS 2013-08-12 44.8833 153.6667
Japan MmDS 2013-08-12 44.8667 153.7
Japan MmDS 2013-08-12 43.3833 147.5
Japan MmDS 2013-08-12 44.3333 151.5
Japan MmDS 2013-08-12 44.8667 153.5333
Japan MmDS 2013-08-12 44.8333 153.5667
Japan MmDS 2013-08-12 44.8667 153.55
Japan MmDS 2013-08-12 44.9 153.5833
Japan MmDS 2013-08-12 43.3333 147.3667
Japan MmDS 2013-08-12 44.3 151.4833
Japan MmDS 2013-08-12 44.85 153.45
Japan MmDS 2013-08-12 44.8667 153.5833
Japan MmDS 2013-08-12 44.9 153.4833
Japan MmDS 2013-08-12 44.9167 153.5667
Japan MmDS 2013-08-12 44.8333 153.5167
Japan MmDS 2013-08-12 44.8833 153.5333
Japan MmDS 2013-08-12 44.85 153.6333
Japan MmDS 2013-08-12 44.8333 153.55
Japan MmDS 2013-08-12 44.8667 153.6833
Japan MmDS 2013-08-12 44.8667 153.4667
Japan MDS 2013-08-12 45.0167 153.4833
Japan MmDS 2013-08-12 43.1833 146.7333
Japan MmDS 2013-08-12 44.35 151.5667
Japan MmDS 2013-08-12 44.8 153.6667
Japan MmDS 2013-08-12 44.85 153.65
Japan MmDS 2013-08-12 43.3333 147.15
Japan MmDS 2013-08-12 44.3667 151.5167
Japan MmDS 2013-08-12 43.2333 146.8167
Japan MmDS 2013-08-12 44.4333 151.5667
Japan MmDS 2013-08-12 44.8833 153.5833
Japan MmDS 2013-08-12 44.9 153.4833
Japan MmDS 2013-08-12 43.2 146.9167
Japan MmDS 2013-08-12 44.3667 151.5667
Japan MmDS 2013-08-13 43.2 146.6833
Japan MmDS 2013-08-13 44.5167 151.1667
Japan CPT 2013-08-13 44.9833 153.3667
Japan MmDS 2013-08-13 43.25 146.85
Japan MmDS 2013-08-13 44.55 151.3667
Japan MDS 2013-08-13 43.3 147.05
Japan MDS 2013-08-13 44.4333 151.2667
Japan MmDS 2013-08-13 43.1833 146.65
Japan MmDS 2013-08-13 44.4833 151.4333
Japan MmDS 2013-08-13 43.2167 146.8167
Japan MmDS 2013-08-13 44.1667 150.6667
Japan MmDS 2013-08-13 43.2333 146.75
Japan MmDS 2013-08-13 44.4333 150.9667
Japan MmDS 2013-08-13 43.45 147.5167
Japan MmDS 2013-08-13 44.5 151.5667
Japan MmDS 2013-08-13 43.25 146.8
Japan MmDS 2013-08-13 44.4667 151.1333
Japan MmDS 2013-08-13 43.3667 147.1
Japan MmDS 2013-08-13 44.4 150.7667
Japan MmDS 2013-08-13 43.15 146.5667
Japan MmDS 2013-08-13 44.4333 151.4667
Japan MmDS 2013-08-13 43.2 146.6667
Japan MmDS 2013-08-13 44.2 150.65
Japan MmDS 2013-08-13 45.0833 153.4
Japan MmDS 2013-08-13 43.1167 146.45
@Vladicon I have been fiddling with this for weeks and have it working now- thank you so much!
Here is what finally worked for me- note that the inputs do nothing yet; they are just placeholders for the filters i will build now-
#server.r
library(shiny);library(rCharts);library(rjson);library(plyr)
maindata<-na.omit(read.csv("Heatmap Data 143 new.csv",header=T,stringsAsFactors=F))
maindata<-ddply(maindata,.(lat,lon),summarise,count=length(street))
shinyServer(function(input,output){
output$placehold<-renderUI({
selectInput("test","Test Input",choices=c("Input1","Input2"),selected="Input1")
})
output$baseMap<-renderMap({
baseMap<-Leaflet$new()
baseMap$setView(c(median(maindata[,1]),median(maindata[,2])),14)
baseMap$tileLayer(provider="OpenStreetMap")
baseMap
})
output$datamap<-renderUI({
nowmax<-max(maindata$count)
dataJSON<-toJSONArray2(maindata,json=F,names=F)
dataJSON2<-rjson::toJSON(dataJSON)
tags$body(tags$script(HTML(sprintf("
var addressPoints = %s
var maxval = %f
var heat = L.heatLayer(addressPoints, {maxZoom: 14, radius: 20, blur: 25}).addTo(map)
</script>",dataJSON2,nowmax
))))
})
})
and
library(shiny);library(rCharts);library(rjson)
shinyUI(pageWithSidebar(
headerPanel("Test"),
sidebarPanel(uiOutput("placehold")),
mainPanel(
chartOutput('baseMap','leaflet'),
tags$style('.leaflet {width: 500px;}'),
tags$head(tags$script(src="http://leaflet.github.io/Leaflet.heat/dist/leaflet-heat.js")),
uiOutput('datamap')
)
))
Thanks @Vladicon for helping @paulyeno work through this. If either of you are interested in writing a blog post explaining the intricacies of how you got it working, let me know.
The new version of shiny 0.10.2 breaks the above code. After hours trying to understand why I couldn't replicate a simple example, I tried to install shiny 0.10.1 and the above works perfectly. Basically it seems that the chart box is badly shaped and there is no heat map... Help!!
Hello- I have the following (inelegant and hastily cobbled together from another project) code which takes a data frame (where column 5 is longitude, 6 is latitude, and 10 is they type of crime) as input and produces a heat map, based on your Houston crime heat map example.
If I view the map in RStudio it renders the map and heat map overlay fine, but only the map will render in Shiny. I don't know if this is an issue with my code, Shiny, or rCharts, but any words of advice would be appreciated!
This code works fine in RStudio:
but this code will not work in Shiny: server.R
and ui.R: