R tmap how to show only 1 legend - r

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)

Related

Removing density (polygon )outside country map boundary in R

I have a location point data (lat and long) like this to map and I want to remove density lines outside the US map boundary.
df1<-structure(list(Latitude = c(44.085655, 45.75582402, 44.465059,
46.85455171, 44.79125494, 44.085655, 44.43086558, 45.75582402,
44.77051274, 45.19945455, 47.27561322, 44.21957345, 44.3090238,
44.94220871, 44.961121, 44.710093, 44.34052462, 45.11789419,
45.95867596, 46.56683647, 46.50792317, 44.45755466, 45.07106473,
44.28764499, 45.77015307, 44.71947041, 45.00157585, 44.68872029,
44.533648, 46.88808589, 44.56185674, 44.08025478, 45.36716924,
44.82353463, 45.06309272, 46.14316994, 44.47153, 44.29015112,
44.3461, 44.3429524167217, 44.3622947358144, 46.861376854859,
46.193502, 44.28649439, 44.677071, 44.656418), Longitude = c(-70.164692,
-87.08797801, -73.1317265, -68.03996219, -68.80975286, -70.164692,
-71.18455899, -87.08797801, -85.64676572, -67.27073026, -68.58126288,
-73.50262934, -71.75870552, -72.17091902, -74.82915083, -73.447775,
-74.12240542, -87.60659852, -86.22085006, -87.408152, -84.3395823,
-83.33775439, -83.42056958, -85.39666393, -84.72208165, -84.69989941,
-84.66704973, -85.64621272, -87.933788, -67.99941449, -70.54746671,
-70.18023411, -68.53049377, -68.73114004, -69.87230606, -67.83254698,
-73.20752, -69.69422198, -69.7603999999998, -69.7510695984823,
-69.8046068622161, -68.0330276970697, -67.801417, -69.6878877839999,
-67.57706, -67.646081)), row.names = c(NA, -46L), class = "data.frame")
I am mapping this data with this code:
world <- ne_countries(scale = "medium", returnclass = "sf")
usa = filter(world,admin =="United States of America")
usa <- st_as_sf(maps::map("state", fill=TRUE, plot =FALSE))
# Plot
ggplot() +
geom_sf(data = usa, fill = "blue",color = "black",alpha=.9) +
coord_sf(
xlim = c(-119, -74),
ylim = c(22, 51),
default_crs = sf::st_crs(4326),
crs = st_crs("ESRI:102003"),
expand = TRUE,
lims_method = "box",
label_axes = list(
bottom = "E", top = "E",
left = "N", right = "N"
))+stat_density2d_filled(data = df1, aes(x = Longitude, y = Latitude, fill=(..level..),
alpha = (..level..)), geom = "polygon")
The plot is like that
I am looking to remove the polygons are outside the US map (Blue texture). I have used this code to do that but In step 2 I have problem :
#Step 1
spdf <- SpatialPointsDataFrame(coords = vetrace1[, c("Longitude", "Latitude")], data = vetrace1,
proj4string = CRS("+proj=longlat +datum=WGS84 +no_defs +ellps=WGS84 +towgs84=0,0,0"))
step 2
whatever <- spdf[!is.na(over(spdf, as(usa, "SpatialPolygons"))), ]
# step 3
whatever <- as.data.frame(whatever)
The error I got is :
"Error in h(simpleError(msg, call)) :
error in evaluating the argument 'y' in selecting a method for function 'over': no method or default for coercing “sf” to “SpatialPolygons”"
Could you help me how to trim this map.

Drawing arbitrary lines on a highchart map in R (library highcharter)

I am drawing a highcharts map using the highcharter package in R. I added already some points (cities) and want to link them by drawing an additionnal beeline using the world map-coordinates.
I already managed to draw the beelines by first drawing the map, then hovering over the cities which shows me the plot-coordinates, and then redrawing the plot using the aforementioned plot-coordinates. (Watch out: I used the PLOT-coordinates and my goal is to use directly the WORLD MAP-coordinates.)
If you only have 1 or two cities, it's not a big deal. But if you have like 100 cities/points, it's annoying. I guess the answer will be something like here: Is it possible to include maplines in highcharter maps?.
Thank you!
Here my code:
library(highcharter)
library(tidyverse)
# cities with world coordinates
ca_cities <- data.frame(
name = c("San Diego", "Los Angeles", "San Francisco"),
lat = c(32.715736, 34.052235, 37.773972), # world-map-coordinates
lon = c(-117.161087, -118.243683, -122.431297) # world-map-coordinates
)
# path which I create AFTER the first drawing of the map as I get the
# plot-coordinates when I hover over the cities.
path <- "M669.63,-4963.70,4577.18,-709.5,5664.42,791.88"
# The goal: the path variable above should be defined using the WORLD-
# coordinates in ca_cities and not using the PLOT-coordinates.
# information for drawing the beeline
ca_lines <- data.frame(
name = "line",
path = path,
lineWidth = 2
)
# construct the map
map <- hcmap("countries/us/us-ca-all", showInLegend = FALSE) %>%
hc_add_series(data = ca_cities, type = "mappoint", name = "Cities") %>%
hc_add_series(data = ca_lines, type = "mapline", name = "Beeline", color = "blue")
map
See picture here
After several hours, I found an answer to my problem. There are maybe easier ways, but I'm going to post my version using the rgdal-package.
The idea is to convert first the world map-coordinates to the specific map's coordinate system (ESRI) and then back-transform all adjustments from highcharts:
library(highcharter)
library(tidyverse)
library(rgdal) # you also need rgdal
# cities with world coordinates
ca_cities <- data.frame(
name = c("San Diego", "Los Angeles", "San Francisco"),
lat = c(32.715736, 34.052235, 37.773972),
lon = c(-117.161087, -118.243683, -122.431297)
)
# pre-construct the map
map <- hcmap("countries/us/us-ca-all", showInLegend = FALSE)
# extract the transformation-info
trafo <- map$x$hc_opts$series[[1]]$mapData$`hc-transform`$default
# convert to coordinates
ca_cities2 <- ca_cities %>% select("lat", "lon")
coordinates(ca_cities2) <- c("lon", "lat")
# convert world geosystem WGS 84 into transformed crs
proj4string(ca_cities2) <- CRS("+init=epsg:4326") # WGS 84
ca_cities3 <- spTransform(ca_cities2, CRS(trafo$crs)) #
# re-transform coordinates according to the additionnal highcharts-parameters
image_coords_x <- (ca_cities3$lon - trafo$xoffset) * trafo$scale * trafo$jsonres + trafo$jsonmarginX
image_coords_y <- -((ca_cities3$lat - trafo$yoffset) * trafo$scale * trafo$jsonres + trafo$jsonmarginY)
# construct the path
path <- paste("M",
paste0(paste(image_coords_x, ",", sep = ""),
image_coords_y, collapse = ","),
sep = "")
# information for drawing the beeline
ca_lines <- data.frame(
name = "line",
path = path,
lineWidth = 2
)
# add series
map <- map %>%
hc_add_series(data = ca_cities, type = "mappoint", name = "Cities") %>%
hc_add_series(data = ca_lines, type = "mapline", name = "Beeline", color = "blue")
map

label for overlapping polygons in R leaflet

I need to label several overlapping polygons, but only the label of the biggest one is shown. However when I tested with some simulated data the labels were shown correctly. I compared the data in two cases carefully but cannot find the difference caused the problem.
Here is a minimal example of simulated overlapping polygons:
library(leaflet)
library(sp)
poly_a <- data.frame(lng = c(0, 0.5, 2, 3),
lat = c(0, 4, 4, 0))
poly_b <- data.frame(lng = c(1, 1.5, 1.8),
lat = c(2, 3, 2))
pgons = list(
Polygons(list(Polygon(poly_a)), ID="1"),
Polygons(list(Polygon(poly_b)), ID="2")
)
poly_dat <- data.frame(name = as.factor(c("a", "b")))
rownames(poly_dat) <- c("1", "2")
spgons = SpatialPolygons(pgons)
spgonsdf = SpatialPolygonsDataFrame(spgons, poly_dat, TRUE)
leaflet() %>% addPolygons(data = spgonsdf, label = ~name
# ,
# highlightOptions = highlightOptions(
# color = "red", weight = 2,bringToFront = TRUE)
)
It's working properly:
However it didn't work with my data.
https://github.com/rstudio/leaflet/files/1430888/Gabs.zip
You can drag the zip into this site and use the i button to see it's correctly labeled
library(rgdal)
# download Gabs.zip and extract files to Gabs folder
hr_shape_gabs <- readOGR(dsn = 'Gabs', layer = 'Gabs - OU anisotropic')
hr_shape_gabs_pro <- spTransform(hr_shape_gabs,
CRS("+proj=longlat +datum=WGS84 +no_defs"))
leaflet(hr_shape_gabs_pro) %>%
addTiles() %>%
addPolygons(weight = 1, label = ~name)
Only the biggest polygon label is shown:
The data in both case are SpatialPolygonsDataFrame, the data slot have proper polygon names.
Change the order of polygons in hr_shape_gabs: polygon in position 3 should be the smaller one.
library(leaflet)
library(sp)
library(rgdal)
hr_shape_gabs <- readOGR(dsn = 'Gabs - OU anisotropic.shp',
layer = 'Gabs - OU anisotropic')
# Change the position of the smaller and wider polygons
# Position 1 = wider polygon, position 3 = smaller polygon
pol3 <- hr_shape_gabs#polygons[[3]]
hr_shape_gabs#polygons[[3]] <- hr_shape_gabs#polygons[[1]]
hr_shape_gabs#polygons[[1]] <- pol3
hr_shape_gabs$name <- rev(hr_shape_gabs$name)
hr_shape_gabs_pro <- spTransform(hr_shape_gabs,
CRS("+proj=longlat +datum=WGS84 +no_defs"))
leaflet() %>%
addTiles() %>%
addPolygons(data= hr_shape_gabs_pro, weight = 1, label = ~name)
Here's a scalable solution in sf for many layers, based on this answer.
The idea is to order the polygons by decreasing size, such that the smallest polygons plot last.
library(sf)
library(dplyr)
# calculate area of spatial polygons sf object
poly_df$area <- st_area(poly_df)
poly_df <- arrange(poly_df, -area)
# view with labels in leaflet to see that small polygons plot on top
leaflet(poly_df) %>% addTiles() %>% addPolygons(label = ~id)
Apologies for the lack of reproducibility. This is more of a concept answer.

Visualization issue while using Leaflet

I have two data frame as below:
PickUP <- data.frame(pickuplong = c(-73.93909 ,-73.94189 ,-73.93754,-73.91638,-73.92792 ,-73.88634), pickuplat =c(40.84408,40.83841,40.85311,40.84966,40.86284,40.85628))
Dropoff <- data.frame(pickuplong = c(-73.93351 ,-73.93909 ,-73.93909 ,-73.80747,-73.95722,-73.91880), pickuplat =c(40.76621,40.84408,40.85311,40.69951,40.68877,40.75917), Droplong =c(-73.91300,-73.96259 ,-73.94870,-73.93860,-73.93633, -73.90690), Droplat =c(40.77777,40.77488 ,40.78493,40.84463,40.75977,40.77013))
I try to find the pickup coordinations (longtitude and latitude) in the pickup data frame which are repeated in dropoff dataframe. I have the below code but I got the error on this:
library(sp)
library(rgdal)
library(leaflet)
library(mapview)
library(dplyr)
a <- semi_join(Dropoff , PickUP , by = c("pickuplong","pickuplat"))
a$ID <- 1:nrow(a)
Dropoff_p <- a[, c("ID", "Pickup_longitude", "Pickup_latitude")]
Dropoff_d <- a[, c("ID", "Dropoff_longitude", "Dropoff_latitude")]
coordinates(Dropoff_p) <- ~Pickup_longitude + Pickup_latitude
coordinates(Dropoff_d) <- ~Dropoff_longitude + Dropoff_latitude
proj4string(Dropoff_p) <- CRS("+init=epsg:4326")
proj4string(Dropoff_d) <- CRS("+init=epsg:4326")
map_p <- mapview(Dropoff_p, color = "red")
map_d <- mapview(Dropoff_d, color = "blue")
map_p + map_d
My error is:
Error in $<-.data.frame (tmp, "ID", value = c(1L, 0L)) :
replacement has 2 rows, data has 0 Error during wrapup: cannot open the
connection
When subsetting the data frame, you have to use the same column names. I changed the column name in the Dropoff_p, Dropoff_d, coordinates(Dropoff_p), and proj4string(Dropoff_d), and then your script works.
In addition, the mapview package just has a new update. If you want, you can update your mapview to version 2.0.1. You can also add col.regions = "red" and col.regions = "blue" because it seems like under the new version the color argument will only change the outline of a point. To change the fill color, use col.regions.
library(sp)
library(rgdal)
library(leaflet)
library(mapview)
library(dplyr)
a <- semi_join(Dropoff , PickUP , by = c("pickuplong","pickuplat"))
a$ID <- 1:nrow(a)
Dropoff_p <- a[, c("ID", "pickuplong", "pickuplat")]
Dropoff_d <- a[, c("ID", "Droplong", "Droplat")]
coordinates(Dropoff_p) <- ~pickuplong + pickuplat
coordinates(Dropoff_d) <- ~Droplong + Droplat
proj4string(Dropoff_p) <- CRS("+init=epsg:4326")
proj4string(Dropoff_d) <- CRS("+init=epsg:4326")
map_p <- mapview(Dropoff_p, color = "red", col.regions = "red")
map_d <- mapview(Dropoff_d, color = "blue", col.regions = "blue")
map_p + map_d

Plot polygons with different colors using rMaps

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.

Resources