Plot polygons with different colors using rMaps - r

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

How to filter a raster layer and plot only the cells above a certain value in R using Leaflet?

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

R tmap how to show only 1 legend

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)

How to assign colors using plotTangentSpace

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:

How can I use a "For" loop to map multiple polygons with the leaflet within shiny in R?

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)

plotting barchart in popup using leaflet library

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.

Resources