Related
I am mapping out zip code areas in leaflet and coloring the polygon based on the Dealer.
Dealer Zipcodes geometry
A 32505 list(list(c(.....)))
B 32505 ....
This code is used to create the colors, labels, and the map.
factpal <- colorFactor(topo.colors(5), data$Dealer)
labels <- paste0("Zip Code: ",data$Zipcodes, ", Dealer: ", data$Dealer)
leaflet(data) %>%
addTiles() %>%
addPolygons( color = ~factpal(Dealer),),
label = labels) %>%
leaflet.extras::addSearchOSM(options = searchOptions(collapsed = FALSE)) %>%
addLegend(pal = factpal, values = ~Dealer,
opacity = 0.7,
position = "bottomright")
When the zip code (and thus the geometry) are the same between two dealers, only one label is visible, though it is clear colors are overlapping. All I want is for that label to somehow show the info for both dealers in that zip code. Please let me know if there is code missing you need, or clarification needed.
Not sure whether you could have multiple tooltips but to show all Dealers in the tooltip you could change your labels such that they include all dealer names per zip code, e.g. making use of dplyr you could do:
library(leaflet)
library(dplyr)
factpal <- colorFactor(topo.colors(5), data$Dealer)
data <- data %>%
group_by(Zipcodes) %>%
mutate(labels = paste(Dealer, collapse = ", "),
labels = paste0("Zip Code: ", Zipcodes, ", Dealer: ", labels))
leaflet(data) %>%
addTiles() %>%
addPolygons(
color = ~factpal(Dealer),
label = ~labels,
weight = 1
) %>%
# leaflet.extras::addSearchOSM(options = searchOptions(collapsed = FALSE)) %>%
addLegend(
pal = factpal, values = ~Dealer,
opacity = 0.7,
position = "bottomright"
)
DATA
nycounties <- rgdal::readOGR("https://eric.clst.org/assets/wiki/uploads/Stuff/gz_2010_us_050_00_20m.json")
nycounties_sf <- sf::st_as_sf(nycounties)
nycounties_sf_n <- nycounties_sf %>%
filter(STATE == "01") %>%
select(Zipcodes = COUNTY, geometry)
data <- list(
A = sample_n(nycounties_sf_n, 40),
B = sample_n(nycounties_sf_n, 40),
C = sample_n(nycounties_sf_n, 40),
D = sample_n(nycounties_sf_n, 40)
)
data <- purrr::imap(data, ~ mutate(.x, Dealer = .y))
data <- do.call("rbind", data)
Recently, I have started learning about the R package "leaflet". This package allows you to identify points on a map provided their latitude and longitude. I created some fake data and I was able to successfully make a leaflet plot (with popup options that display properties of each point):
library(dplyr)
library(leaflet)
map_data <- data.frame("Lat" = c(43.6426, 43.6424, 43.6544, 43.6452, 43.6629), "Long" = c(-79.3871, -79.3860, -79.3807, -79.3806,-79.3957 ),
"Job" = c("Economist", "Economist", "Teacher", "Teacher", "Lawyer"),
"First_Name" = c("John","James", "Jack", "Jason", "Jim"),
"Last_Name" = c("Smith","Charles", "Henry", "David", "Robert"),
"vehicle" = c("car", "van", "car", "none", "car"))
map_data %>% leaflet() %>% addTiles() %>% addMarkers(clusterOption=markerClusterOptions(), lng = map_data$Long, lat = map_data$Lat, popup = paste("Job", map_data$Job, "<br>", "First_Name:", map_data$First_Name, "<br>", "Last_Name:", map_data$Last_Name, "<br>", "vehicle:", map_data$vehicle, "<br>" ))
Now, I wanted to take this a few steps further and color code the points based on the "job" of each individual. I found this github tutorial over here that I want to follow: https://poldham.github.io/abs/mapgbif.html
Using the same data I previously created, I tried to re-create a similar plot (slightly modifying it by adding my own popup options). However, when I run my code, I now get an empty map. Can someone please tell me what I am doing wrong? I have attached my code below:
library(dplyr)
library(leaflet)
library(RColorBrewer)
#create map data
map_data <- data.frame("Lati" = c(43.6426, 43.6424, 43.6544, 43.6452, 43.6629), "Longi" = c(-79.3871, -79.3860, -79.3807, -79.3806,-79.3957 ),
"Job" = c("Economist", "Economist", "Teacher", "Teacher", "Lawyer"),
"First_Name" = c("John","James", "Jack", "Jason", "Jim"),
"Last_Name" = c("Smith","Charles", "Henry", "David", "Robert"),
"vehicle" = c("car", "van", "car", "none", "car"))
#create initial map
map <- leaflet::leaflet(map_data) %>%
addTiles() %>% # Add default OpenStreetMap map tiles
addMarkers(~Longi, ~Lati, popup = map_data$Job)
#add markers
map <- leaflet(map_data) %>% addTiles() %>% addCircleMarkers(~Longi,
~Lati, popup = map_data$Job, radius = 1, fillOpacity = 0.5, clusterOptions = markerClusterOptions())
map <- leaflet(map_data) %>% addTiles() %>% addCircleMarkers(~Longi, ~Lati,
popup = map_data$Job, radius = 1, weight = 2, opacity = 0.5, fill = TRUE,
fillOpacity = 0.2)
#create colors (is it possible to make the colors Red, Blue and Green?)
previewColors(colorFactor("Paired", domain = NULL), LETTERS[1:3])
kingdom <- c("Economist", "Lawyer", "Teacher")
my_palette <- brewer.pal(3, "Paired")
previewColors(colorFactor(my_palette, levels = kingdom), kingdom)
factpal <- colorFactor(my_palette, levels = kingdom)
species_circle <- leaflet(map_data) %>% addTiles() %>% addCircleMarkers(~Longi,
~Lati, popup = map_data$Job, radius = 1, weight = 2, opacity = 0.5,
fill = TRUE, fillOpacity = 0.2, color = ~factpal(kingdom))
species_circle
groups = unique(map_data$Job)
#finalize map
map = leaflet(map_data) %>% addTiles(group = "OpenStreetMap")
for (i in groups) {
data = map_data[map_data$kingdom == i, ]
map = map %>% addCircleMarkers(data = data, ~Longi, ~Lati, radius = 1,
weight = 2, opacity = 0.5, fill = TRUE, fillOpacity = 0.2, color = ~factpal(kingdom),
group = i)
}
map %>% addLayersControl(overlayGroups = groups, options = layersControlOptions(collapsed = FALSE)
%>% addTiles() %>% # Add default OpenStreetMap map tiles
addMarkers(lng = map_data$Long, lat = map_data$Lat,
popup = paste("Job", map_data$Job, "<br>",
"First_Name:", map_data$First_Name, "<br>",
"Last_Name:", map_data$Last_Name, "<br>", "vehicle:", map_data$vehicle, "<br>" ))
Thanks!
The main issue with your code is that you filter on variable map_data$kingdom (which is no column of map_data) in the for loop instead of on variablr map_data$Job. Hence data is always an empty df and you don't get any markers.
Besides that:
You don't need the for loop
To get the right assigments for colors map ~factpal(Job) on color instead of ~factpal(kingdom).
You don't need to refer to variables in your data with map_data$. Simply use the name of the variable. Leaflet by default will look for these variables in the dataset you provided with leaflet(map_data)
I reduced all the unnecessary code to focus on the main map code. For illustration purposes I increased the radius of the cirleMarkers to 10 and set the opacity to 1.
library(dplyr)
library(leaflet)
library(RColorBrewer)
# create map data
map_data <- data.frame(
"Lati" = c(43.6426, 43.6424, 43.6544, 43.6452, 43.6629), "Longi" = c(-79.3871, -79.3860, -79.3807, -79.3806, -79.3957),
"Job" = c("Economist", "Economist", "Teacher", "Teacher", "Lawyer"),
"First_Name" = c("John", "James", "Jack", "Jason", "Jim"),
"Last_Name" = c("Smith", "Charles", "Henry", "David", "Robert"),
"vehicle" = c("car", "van", "car", "none", "car")
)
kingdom <- c("Economist", "Lawyer", "Teacher")
my_palette <- brewer.pal(3, "Paired")
factpal <- colorFactor(my_palette, levels = kingdom)
groups <- unique(map_data$Job)
# finalize map
map <- leaflet(map_data) %>%
addTiles(group = "OpenStreetMap") %>%
addCircleMarkers(~Longi, ~Lati, popup = ~Job,
radius = 10, weight = 2, opacity = 1, color = ~factpal(Job),
fill = TRUE, fillOpacity = 1, group = ~Job
)
map %>%
addLayersControl(overlayGroups = groups, options = layersControlOptions(collapsed = FALSE)) %>%
addTiles() %>%
addMarkers(lng = ~Longi,
lat = ~Lati,
popup = ~paste("Job", Job, "<br>",
"First_Name:", First_Name, "<br>",
"Last_Name:", Last_Name, "<br>", "vehicle:", vehicle, "<br>"))
EDIT To achieve the features you mentioned in your comment you could do:
If you want different colors you can simply pass any color vector to colorFactor, e.g.
my_palette <- c("red", "green", "blue")
factpal <- colorFactor(my_palette, levels = kingdom)
To remove the pins drop the line starting with addMarkers. In that case you have to move the code for the popup into addCircleMarkers (but be aware that there is already a popup=~Job in addCircleMarkers, i.e. overwrite this one). Another option would be to add group=~Job to addMarkers. Doing so only the pins for checked jobs will appear on the map.
I'm trying to create a choropleth map in county level using leaflet R package and I actually do it. But when I check my data file and the hover text of any county I find that the values are not correct. For example check the Conejos county. Any explanation? Or a better way to process tha data and create this map without the mismatches?
Code:
library(raster)
library(leaflet)
library(tidyverse)
# Get USA polygon data
USA <- getData("GADM", country = "usa", level = 2)
### Get data
mydata <- read.csv("https://www.betydb.org/miscanthus_county_avg_yield.csv",
stringsAsFactors = FALSE) %>%
dplyr::select(COUNTY_NAME, Avg_yield)
### Check counties that exist in USA, but not in mydata
### Create a dummy data frame and bind it with mydata
mydata <- data.frame(COUNTY_NAME = setdiff(USA$NAME_2, mydata$COUNTY_NAME),
Avg_yield = NA,
stringsAsFactors = FALSE) %>%
bind_rows(mydata)
### Create a color palette
mypal <- colorNumeric(palette = "viridis", domain = mydata$Avg_yield)
leaflet() %>%
addProviderTiles("OpenStreetMap.Mapnik") %>%
setView(lat = 39.8283, lng = -98.5795, zoom = 4) %>%
addPolygons(data = USA, stroke = FALSE, smoothFactor = 0.2, fillOpacity = 0.3,
fillColor = ~mypal(mydata$Avg_yield),
popup = paste("Region: ", USA$NAME_2, "<br>",
"Avg_yield: ", mydata$Avg_yield, "<br>")) %>%
addLegend(position = "bottomleft", pal = mypal, values = mydata$Avg_yield,
title = "Avg_yield",
opacity = 1)
I tried to make interactive map using R shiny which will show plot of male and female citizens in some cities. Data frame sample is shown below.
df1 <- read.table(header = TRUE, text = "city,year,male,female,long,lat
A,2017,1038,876,35.54331,139.12333
A,2018,1281,911,35.54331,139.12333
B,2017,832,517,35.14189,140.664113
B,2018,914,589,35.14189,140.664113", sep = ",")
df2 <- df1
The interactive map is built by using leaflet package and if the city marker is clicked, a plot which built by highchart will be shown.
output$chart <- renderHighchart({
df2 <- df1[df1$city == click_marker(),]
hchart() %>%
hc_add_series(df2, "column", hcaes(x = year, y = male, group = city, name = "Male")) %>%
hc_add_series(df2, "column", hcaes(x = year, y = female, group = city, name = "Female")) %>%
hc_xAxis(title = list(text = "Year")) %>%
hc_yAxis(title = list(text = "Amount (Thousands)"))
})
highchartOutput('chart')
I expect the output is a plot that show amount of male and female in the city for each year given but the output that I got is "argument object is missing, with no default."
What if you change hchart to highchart and the names to lowercase? Apparently they have to be found in the data.frame.
highchart() %>%
hc_add_series(df2, "column", hcaes(x = year, y = male, group = city, name = "male")) %>%
hc_add_series(df2, "column", hcaes(x = year, y = female, group = city, name = "female")) %>%
hc_xAxis(title = list(text = "Year")) %>%
hc_yAxis(title = list(text = "Amount (Thousands)"))
I have a tidy dataframe, similar to the following:
tidyDF <- data.frame(PORT_NAME = c("South Louisiana, LA, Port of",
"Houston, TX", "Long Beach, CA",
"New York, NY and NJ",
"Los Angeles, CA", "Beaumont, TX",
"Corpus Christi, TX", "New Orleans, LA",
"Baton Rouge, LA", "Mobile, AL"),
TOTAL_TONS = c(267390209, 234304391, 170052128,
126158655, 122033848, 87283716, 84928330,
84465052, 69185878, 64287565),
portSel = c("NO", "NO", "NO", "NO", "NO", "YES",
"NO", "NO", "NO", "NO"))
I would like to create a barplot with specific colors based on the portSel variable.
Here is the code I am using:
library(highcharter)
myColors <- c("#002F80", "#F9AF38")
highchart() %>%
hc_add_series_df(data = tidyDF,
type = "bar",
x = PORT_NAME,
y = TOTAL_TONS,
group = portSel) %>%
hc_xAxis(title = list(text = "Ports"),
tickmarkPlacement = "on",
tickLength = 0,
labels = list(
enabled = FALSE
)) %>%
hc_yAxis(title = list(text = "2014 Total Tonnage")) %>%
hc_legend(enabled = FALSE) %>%
hc_colors(myColors)
I have tried both group and color in hc_add_series_df. Neither work correctly. When I use group = portSel, as above, the colors are correct, but it moves the single YES port to be grouped with the first NO port. When I use color = portSel, it puts the YES port in the correct spot, but it no longer uses the custom colors in myColors.
Any advice is welcome!
Thanks.
I modified the previous answer.
You're not using groups in the right way. The group option is to create/add more than 1 series, that's why the first yes is next to the first no because the value are put in order.
About the colors, the function hc_add_series_df colorize the points (bars, column) according the given color variable so don't use the color given by hc_colors.
So, I think a simple way to do this is add the series "manually". This means craete a list from the data with the specific data (and color) that you want.
tidyDF2 <- tidyDF %>%
mutate(color = ifelse(portSel == "NO", myColors[1], myColors[2])) %>%
select(y = TOTAL_TONS, color)
highchart() %>%
hc_chart(type = "bar") %>%
hc_xAxis(labels = list(
enabled = FALSE
)) %>%
hc_add_series(data = list_parse(tidyDF2), showInLegend = FALSE)
Does this help you?
Previous answer.
You can try add in hc_xAxis the next arguments: type = "categorical", categories = tidyDF$PORT_NAME, and use just group in hc_add_series_df. You will see a bar chart with the "yes" column a little displace due you put 2 series (one for each group), for example http://www.highcharts.com/demo/column-parsed
highchart() %>%
hc_add_series_df(data = tidyDF,
type = "bar",
x = PORT_NAME,
y = TOTAL_TONS,
group = portSel) %>%
hc_xAxis(title = list(text = "Ports"),
type = "categorical",
categories = tidyDF$PORT_NAME,
tickmarkPlacement = "on",
tickLength = 0,
labels = list(
enabled = TRUE
)) %>%
hc_yAxis(title = list(text = "2014 Total Tonnage")) %>%
hc_legend(enabled = FALSE) %>%
hc_colors(myColors)