I'm trying to plot polygons on a map using rMaps and fill the polygons with different colors.
I tried unsuccessfully change the 'color' and 'fillcolor' attributes:
require(yaml)
library(rCharts)
library(rMaps)
library(plyr)
mk_polygon <- function(lats, lons, poly_color){
stopifnot(length(lats)==length(lons))
coord_list <- llply(seq_along(lats), function(i) c(lons[[i]], lats[[i]]))
list(
type = 'Feature',
properties = list(color = poly_color,
fillcolor = poly_color,
name = "station"),
geometry = list(type = 'Polygon',
coordinates = list(coord_list))
)
}
style <- list()
polygons <- list()
path <- "C:/DataVisualization/polygons/"
files <- list.files(path)
for(i in 1:length(files)){
poly <- read.csv(paste(path,files[i],sep=""),header=T)
polygons[[length(polygons)+1]] <- mk_polygon(poly$lat, poly$lon, color[i])
}
NYC <- c(40.7142700, -74.0059700)
map <- Leaflet$new()
map$setView(NYC, zoom = 10)
map$geoJson(polygons)
map
My code plots all the polygons with the same color (blue, the default color).
Does anyone know how to change it?
Any help is greatly appreciated.
Related
I have a raster layer that contains 24-hour snow accumulations across the United States. The data can be pulled from here:
https://www.nohrsc.noaa.gov/snowfall_v2/data/202105/sfav2_CONUS_24h_2021052412.tif
I only want to plot the cells in the raster with values greater than or equal to 4 (inches) on a leaflet map. This is what my current map looks like:
https://i.stack.imgur.com/2Mi4r.png
I changed all values less than 4 to NA thinking that the raster cells wouldn't show up on the map. I want to remove all cells on the map that are greyed-out. The functions subset() and filter() do not work on raster layers. Any ideas? My code below for reference:
library(dplyr)
library(rgdal)
library(raster)
library(ncdf4)
library(leaflet)
library(leaflet.extras)
download.file(obsvSnow_Link, destfile = file.path(folderpath, 'observedSnow.tif'))
obsvSnow <- raster(file.path(folderpath, 'observedSnow.tif'))
names(obsvSnow) <- 'snowfall'
obsvSnow[obsvSnow < 4,] <- NA
colores <- c("transparent","#99CCFF","#3399FF","#0000FF","#FFE066", "#FF9900", "#E06666","#CC0000","#990033")
at <- c(4,8,seq(12,42,6),100)
cb <- colorBin(palette = colores, bins = at, domain = at)
mp <- leaflet(width = "100%",options = leafletOptions(zoomControl = FALSE)) %>%
addTiles() %>%
addRasterImage(x=obsvSnow$snowfall,
colors = cb,
opacity = 0.6) %>%
addLegend(title = 'Inches',
position='bottomright',
pal = cb, values = at) %>%
leaflet.extras::addSearchUSCensusBureau(options = searchOptions(autoCollapse=TRUE, minLength=10)) %>%
addScaleBar(position='bottomleft') %>%
addFullscreenControl()
mp
I have this script that draw a wkt file, how to show only 1 legend not two
library(sf)
library(tmap)
dataset= read.csv('https://raw.githubusercontent.com/djouallah/loadRobjectPBI/master/wkt/wkt.csv')
dataset <- dataset[c("geometry","color","status","labels")]
dataset$color <- as.character(dataset$color)
map <- st_as_sf(dataset, wkt="geometry",crs = 4326)
chartlegend <- unique(dataset[c("status","color")])
chartlegend <- chartlegend[order(chartlegend$status),]
rm(dataset)
tm_shape(map)+tm_lines(col="color",lwd = 3.5)+tm_symbols(col = "color", size = 0.06,shape=15)+tm_text(text="labels",col="white")+
rm(map)+
tm_add_legend(type='fill',labels=chartlegend$status, col=chartlegend$color)+
tm_layout(frame = FALSE,bg.color = "transparent",legend.width=2)+
tm_legend(position=c("right", "top"),text.size = 1.3)+
rm(chartlegend)
I am performing a PCA on my .tps file and I need to assign colors to species or specimens so that when plotting the graph (and the legend on it) colors do not overlap.
This is my current code:
prueba <- readland.tps("todos",specID = "ID")
ProPrueba <- gpagen(prueba)
NameList <- dimnames(prueba)[[3]]
UniqueNames <- gsub('[[:digit:]]+', '', NameList)
dimnames(prueba)[[3]] <- UniqueNames
factores <- factor(UniqueNames)
pca_prueba <- plotTangentSpace(ProPrueba$coords, label= NULL, verbose =T,
groups=factores, warpgrids=F, legend = T)
Resulting in:
I am currently struggling to map multiple polygons in a shiny app. The purpose of the shiny app is to take some data pertaining to disease spread in a number of states and map the areas of highest risk. The app must be able to map multiple states at the click of the "Start!" button.
(Note: This app is very large (6000+ lines in total) so only relevant code will be shown here, I don't want to burden the ones trying to help me)
Excerpts from:
Server.R
#The purpose of col_inputs and col_names is to create a two-dimensional array with all of the input parameters for the function. This was done to maintain compatibility with some legacy code. Catted_states on the other hand combines all states selected into a list.
(Example: c("AZ","FL","VA")
output$gm <- renderLeaflet({
global_map(ARG_1, ARG_2, ARG_3)
})
Global_Map.R
The only real concerns with this code is that 'M' isn't being drawn at all after the for loop finishes.
global_map <- function(col_names, col_inputs, catted_states) {
User_para <- array(0, dim = c(16, 2))
for( I in 1:length(states) {
if (state_num > 10) {
read.csv(Loop specific file)
}
if (state_num < 10) {
read.csv(Loop specific file)
}
state_num * Loop specific calculation[I]
pal <- colorNumeric(palette = "Purples", domain = state_output$risk)
pal_sR <- pal(state_output$risk)
m <- addProviderTiles(m, "CartoDB.Positron")
m <- addLegend(m, title = "Risk", pal = pal, values = ~state_output$risk,
opacity = 0.7)
m <- addPolygons(m, stroke = FALSE, smoothFactor = 0, fillOpacity = 0.5,
color = ~pal_sR)
}
}
How can I get this code to map the multiple states? What is incorrect about my leaflet calls? I need this code to load multiple shape files into shiny and draw polygons once on each shape file and map them accordingly
I am not really sure if that solves your problem, but your example is absolutely not reproducible and also has several errors. If you want to produce several polygons inside a for loop and then add them to a leaflet map, here is the code:
library(shiny)
library(leaflet)
ui <- fluidPage(
sliderInput("nPolys", "How many Loops", min = 1, max = 20, value = 3),
## Map
leafletOutput("gm")
)
server <- function(input, output) {
## Initialize map
m = leaflet() %>% addTiles()
## Render Map
output$gm <- renderLeaflet({
## Loop
for (I in 1:input$nPolys) {
## Create dummy polygons
Sr1 = Polygon(cbind(c(2,4,4,1,2)*runif(1,1,10),c(2,3,5,4,2)*runif(1,1,10)))
Sr2 = Polygon(cbind(c(5,4,2,5)*runif(1,1,10),c(2,3,2,2)*runif(1,1,10)))
Srs1 = Polygons(list(Sr1), "s1"); Srs2 = Polygons(list(Sr2), "s2")
SpP = SpatialPolygons(list(Srs1,Srs2), 1:2)
## add Polygons to map
m <- addPolygons(m, data=SpP, stroke = FALSE, smoothFactor = 0, fillOpacity = 0.5)
}
## Call map !
m
})
}
shinyApp(ui, server)
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.