Leaflet in R: How to generate multiple icons - r

I have a data frame that contains a list of all sports venues in my state.
Here is a list of the column names in my data frame (pretty self explanatory):
[1] "City" "latitude" "longitude" "Rank" "Population" "County"
[7] "Desc"
I have created all icons below:
library(leaflet)
NHL <- makeIcon(
iconUrl = "https://www-league.nhlstatic.com/images/logos/league-dark/133-flat.svg",
iconWidth = 31*215/230,
iconHeight = 31,
iconAnchorY = 16,
iconAnchorX = 31*215/230/2)
MLB <- makeIcon(
iconUrl = "https://www.mlbstatic.com/team-logos/league-on-dark/1.svg",
iconWidth = 31*215/230,
iconHeight = 31,
iconAnchorY = 16,
iconAnchorX = 31*215/230/2)
MLS <-makeIcon(
iconUrl = "https://league-mp7static.mlsdigital.net/styles/non-retina_desktop_logo/s3/logo25-77x77_0.png?LzMdhn2DU4GXKEjKfJ2QYWMaQKQIk7VQ&itok=ZtYZ58tI",
iconWidth = 31*215/230,
iconHeight = 31,
iconAnchorY = 16,
iconAnchorX = 31*215/230/2)
NBA <-makeIcon(
iconUrl = "https://seeklogo.net/wp-content/uploads/2014/09/NBA-logo.png",
iconWidth = 31*215/230,
iconHeight = 31,
iconAnchorY = 16,
iconAnchorX = 31*215/230/2)
NFL <-makeIcon(
iconUrl = "https://static.nfl.com/static/content/public/static/wildcat/assets/img/application-shell/shield/default.svg",
iconWidth = 31*215/230,
iconHeight = 31,
iconAnchorY = 16,
iconAnchorX = 31*215/230/2)
I am trying to create a leaflet plot that highlights each sports team venue in my state by showing the relevant icon. The code below will only show a single icon (whichever is first in the icon = list)
df %>%
leaflet() %>%
addTiles() %>%
addMarkers(lat = df$Latitude, lng = df$Longitude, icon = c(MLB, NHL, NFL, MLS, NBA))
I've also created another data frame (df2; below) that contains each venue (Stadium Name) and the relevant league (NFL/NHL/etc) and I've tried to pass this to "icon = df2$League" but it does not recognize it as an object. Any ideas?
> colnames(df2)
[1] "Club" "Sport" "League" "Symbol" "Venue" "City" "Latitude"
[8] "Longitude"

You didn't provide reproducible data so I've made up some example data assuming your df has a column with the league name, which we can use to match the name of the icon:
library(leaflet)
library(sf)
# generate example data
set.seed(2020)
venues <- c('NHL', 'MLB', 'MLS', 'NBA', 'NFL')
nc <- st_read(system.file("shape/nc.shp", package="sf"))
df <- st_sample(nc, 5) %>%
st_coordinates() %>%
as.data.frame
df$league <- venues
df
#> X Y league
#> 1 -78.58785 35.94350 NHL
#> 2 -80.82830 35.88732 MLB
#> 3 -78.83967 36.11236 MLS
#> 4 -80.09532 35.01562 NBA
#> 5 -83.72636 35.33204 NFL
All we need to do is create a named iconList where the name of the icon matches the name in the "league" column of our dataframe. With ~iconSet[league] we can ensure the correct icon is being used for each point in the df.
# create iconSet
iconSet <- iconList(NHL= NHL,
MLB =MLB,
MLS = MLS,
NBA = NBA,
NFL = NFL)
# map
leaflet(df) %>%
addTiles() %>%
addMarkers(lng=~X, lat=~Y, icon = ~iconSet[league])

Related

How can I programmatically create a list of objects of the leaflet icon class?

How can I programmatically create a list of objects of the leaflet icon class?
I have created a map using the leaflet library that will eventually show dozens of locations. For this I want to add some custom icons using the addMarkers function, which takes an iconSet created using iconList as documented here.
In the example below (which uses icons from https://icon-library.net/), the creation of myicons by means of iconList, which contains two direct calls to makeIcon, is unproblematic because only two icons are used. However, in the real world the number of icons, their URLs and other attributes will not be known in advance.
If create a list using iconList and use cbind to attach it to the data frame as a new column, I get the expected "cannot coerce class" error message.
My only option appears to be to programmatically create the myicons list, but using something like mynewicons <- iconList(sapply(1:nrow(df.data), function(i) {makeIcon(df.data$url[i],iconWidth = df.data$width[i],iconHeight = df.data$height[i])})) results in an Arguments passed to iconList() must be icon objects returned from makeIcon() error.
How can I create this list of leaflet icons dynamically rather than specifying it in advance?
require(leaflet)
require(magrittr)
entrynames <- c("Entry 1","Entry 2")
lat <- c(51.509950,51.510736)
lng <- c(-0.1345093,-0.135190)
iconurl <- c("https://icon-library.net/images/right-arrow-icon-png/right-arrow-icon-png-9.jpg",
"https://icon-library.net/images/back_previous_arrow_play_next_stop_pause_101040.png")
iconwidth <- c(60,50)
iconheight <- c(60,50)
df.data <- data.frame(entrynames=entrynames,lat=lat,lng=lng,
url=iconurl,width=iconwidth,height=iconheight,stringsAsFactors = FALSE)
df.data$entrynames <- as.character(df.data$entrynames)
myicons <- iconList(
marker1 = makeIcon(iconUrl = df.data$url[1],iconWidth = df.data$width[1],iconHeight = df.data$height[1]),
marker2 = makeIcon(iconUrl = df.data$url[2],iconWidth = df.data$width[2],iconHeight = df.data$height[2])
)
m <- leaflet() %>% setView(lng = -0.1345093, lat = 51.510090, zoom = 18) %>% addTiles() %>%
addMarkers(data = df.data,
lat = ~lat,
lng = ~lng,
icon = myicons)
m
MRE output:
It's a bit hacky and I am not too familiar with leaflet but using purrr::map and purrr::flatten plus fixing names and attributes seems to work:
require(leaflet)
#> Indlæser krævet pakke: leaflet
require(magrittr)
#> Indlæser krævet pakke: magrittr
entrynames <- c("Entry 1","Entry 2")
lat <- c(51.509950,51.510736)
lng <- c(-0.1345093,-0.135190)
iconurl <- c("https://icon-library.net/images/right-arrow-icon-png/right-arrow-icon-png-9.jpg",
"https://icon-library.net/images/back_previous_arrow_play_next_stop_pause_101040.png")
iconwidth <- c(60,50)
iconheight <- c(60,50)
df.data <- data.frame(entrynames=entrynames,lat=lat,lng=lng,
url=iconurl,width=iconwidth,height=iconheight,stringsAsFactors = FALSE)
df.data$entrynames <- as.character(df.data$entrynames)
myicons <- iconList(
marker1 = makeIcon(iconUrl = df.data$url[1],iconWidth = df.data$width[1],iconHeight = df.data$height[1]),
marker2 = makeIcon(iconUrl = df.data$url[2],iconWidth = df.data$width[2],iconHeight = df.data$height[2])
)
mynewicons <- purrr::map(1:nrow(df.data),
function(i) {
iconList(makeIcon(df.data$url[i],
iconWidth = df.data$width[i],
iconHeight = df.data$height[i])
)
}
) %>%
purrr::flatten()
names(mynewicons) <- glue::glue("marker{1:nrow(df.data)}")
attr(mynewicons, "class") <- "leaflet_icon_set"
identical(myicons, mynewicons)
#> [1] TRUE
Created on 2019-10-24 by the reprex package (v0.3.0)

How do I map county-level data as a heatmap using FIPS codes (interactively?) in R

I am hoping to create an interactive map that will allow me to create a plot where users can change the year and variable plotted. I've seen the package tmap be used, so I'm imagining something like that, but I'd also take advice for a static map, or another approach to an interactive one. My data is much, much, richer than this, but looks something like:
example <- data.frame(fips = rep(as.numeric(c("37001", "37003", "37005", "37007", "37009", "37011", "37013", "37015", "37017", "37019"), 4)),
year = c(rep(1990, 10), rep(1991, 10), rep(1992, 10), rep(1993, 10)),
life = sample(1:100, 40, replace=TRUE),
income = sample(8000:1000000, 40, replace=TRUE),
pop = sample(80000:1000000, 40, replace=TRUE))
I'd like my output to be a map of ONLY the counties contained in my dataset (in my case, I have all the counties in North Carolina, so I don't want a map of the whole USA), that would show a heatmap of selected variables of interest (in this sample data, year, life, income, and pop. Ideally I'd like one plot with two dropdown-type menus that allow you to select what year you want to view, and which variable you want to see. A static map where I (rather than the user) defines year and variable would be helpful if you don't know how to do the interactive thing.
I've tried the following (taken from here), but it's static, which is not my ideal, and also appears to be trying to map the whole USA, so the part that's actually contained in my data (North Carolina) is very small.
library(maps)
library(ggmap)
library(mapproj)
data(county.fips)
colors = c("#F1EEF6", "#D4B9DA", "#C994C7", "#DF65B0", "#DD1C77",
"#980043")
example$colorBuckets <- as.numeric(cut(example$life, c(0, 20, 40, 60, 80,
90, 100)))
colorsmatched <- example$colorBuckets[match(county.fips$fips, example$fips)]
map("county", col = colors[colorsmatched], fill = TRUE, resolution = 0,
lty = 0, projection = "polyconic")
Here's almost the whole solution. I had hoped some package would allow mapping to be done by fips code alone, but haven't found one yet. You have to download shapefiles and merge them by fips code. This code does everything I wanted above except allow you to also filter by year. I've asking that question here, so hopefully someone will answer there.
# get shapefiles (download shapefiles [here][1] : http://www2.census.gov/geo/tiger/GENZ2014/shp/cb_2014_us_county_5m.zip )
usgeo <- st_read("~/cb_2014_us_county_5m/cb_2014_us_county_5m.shp") %>%
mutate(fips = as.numeric(paste0(STATEFP, COUNTYFP)))
### alternatively, this code *should* allow you download data ###
### directly, but somethings slightly wrong. I'd love to know what. ####
# temp <- tempfile()
# download.file("http://www2.census.gov/geo/tiger/GENZ2014/shp/cb_2014_us_county_5m.zip",temp)
# data <- st_read(unz(temp, "cb_2014_us_county_5m.shp"))
# unlink(temp)
########################################################
# create fake data
example <- data.frame(fips = rep(as.numeric(c("37001", "37003", "37005", "37007", "37009", "37011", "37013", "37015", "37017", "37019"), 4)),
year = c(rep(1990, 10), rep(1991, 10), rep(1992, 10), rep(1993, 10)),
life = sample(1:100, 40, replace=TRUE),
income = sample(8000:1000000, 40, replace=TRUE),
pop = sample(80000:1000000, 40, replace=TRUE))
# join fake data with shapefiles
example <- st_as_sf(example %>%
left_join(usgeo))
# drop layers (not sure why, but won't work without this)
example$geometry <- st_zm(example$geometry, drop = T, what = "ZM")
# filter for a single year (which I don't want to have to do)
example <- example %>% filter(year == 1993)
# change projection
example <- sf::st_transform(example, "+proj=longlat +datum=WGS84")
# create popups
incomepopup <- paste0("County: ", example$NAME, ", avg income = $", example$income)
poppopup <- paste0("County: ", example$NAME, ", avg pop = ", example$pop)
yearpopup <- paste0("County: ", example$NAME, ", avg year = ", example$year)
lifepopup <- paste0("County: ", example$NAME, ", avg life expectancy = ", example$life)
# create color palettes
yearPalette <- colorNumeric(palette = "Blues", domain=example$year)
lifePalette <- colorNumeric(palette = "Purples", domain=example$life)
incomePalette <- colorNumeric(palette = "Reds", domain=example$income)
popPalette <- colorNumeric(palette = "Oranges", domain=example$pop)
# create map
leaflet(example) %>%
addProviderTiles("CartoDB.Positron") %>%
addPolygons(stroke=FALSE,
smoothFactor = 0.2,
fillOpacity = .8,
popup = poppopup,
color = ~popPalette(example$pop),
group = "pop"
) %>%
addPolygons(stroke=FALSE,
smoothFactor = 0.2,
fillOpacity = .8,
popup = yearpopup,
color = ~yearPalette(example$year),
group = "year"
) %>%
addPolygons(stroke=FALSE,
smoothFactor = 0.2,
fillOpacity = .8,
popup = lifepopup,
color = ~lifePalette(example$life),
group = "life"
) %>%
addPolygons(stroke=FALSE,
smoothFactor = 0.2,
fillOpacity = .8,
popup = incomepopup,
color = ~incomePalette(example$income),
group = "income"
) %>%
addLayersControl(
baseGroups=c("income", "year", "life", "pop"),
position = "bottomleft",
options = layersControlOptions(collapsed = FALSE)
)
I'm still looking for a way to add a "year" filter that would be another interactive radio-button box to filter the data by different years.

Icons not loading (empty image) in R Leaflet with Shiny

[R-3.4.3 64-bit, RStudio, shinydashboard_0.6.1, shiny_1.0.5, leaflet.extras_0.2, Chrome]
I'm making icons to use in R/Leaflet with Shiny and all im getting is the below, but i've no idea why:
This is using the toy example from here:
oceanIcons <- iconList(
ship = makeIcon("ferry-18.png", "ferry-18#2x.png", 18, 18),
pirate = makeIcon("danger-24.png", "danger-24#2x.png", 24, 24)
)
# Some fake data
df <- sp::SpatialPointsDataFrame(
cbind(
(runif(20) - .5) * 10 - 90.620130, # lng
(runif(20) - .5) * 3.8 + 25.638077 # lat
),
data.frame(type = factor(
ifelse(runif(20) > 0.75, "pirate", "ship"),
c("ship", "pirate")
))
)
leaflet(df) %>% addTiles() %>%
# Select from oceanIcons based on df$type
addMarkers(icon = ~oceanIcons[type])
And the following, with different but similar toy data, when using runApp(shinyApp(ui, server), launch.browser = TRUE);
See the documentation for makeIcon. As the first argument it expects:
iconUrl: the URL or file path to the icon image
So your code will only work if you either have the png in your working directory, alter the path so it contains the correct path to the image on your hard drive, or you could use an URL. So a working example would be:
# Make a list of icons. We'll index into it based on name.
oceanIcons <- iconList(
ship = makeIcon("http://globetrotterlife.org/blog/wp-content/uploads/leaflet-maps-marker-icons/ferry-18.png", 18, 18),
pirate = makeIcon("http://globetrotterlife.org/blog/wp-content/uploads/leaflet-maps-marker-icons/danger-24.png", 24, 24)
)
# Some fake data
df <- sp::SpatialPointsDataFrame(
cbind(
(runif(20) - .5) * 10 - 90.620130, # lng
(runif(20) - .5) * 3.8 + 25.638077 # lat
),
data.frame(type = factor(
ifelse(runif(20) > 0.75, "pirate", "ship"),
c("ship", "pirate")
))
)
leaflet(df) %>% addTiles() %>%
# Select from oceanIcons based on df$type
addMarkers(icon = ~oceanIcons[type])
Hope this helps!

Geographical county level heat map

I frequently need to create geographical heat maps in R. Currently, I have been doing it in a licensed version of Tableau in my office computer which does a superb job. But I need to learn how to do it when I'm out of office. The data is sometimes confidential, so I cannot use Tableau public over the internet. I looked but could not find any solution that produces the result I need.
The data consists of names of districts in the state of Jharkhand, India along with child population in age group 6 to 14 in thousands. In Tableau, I merely have to set the DISTNAME column to "Geographical Role" at "County" level and it pulls the map of the state along with district boundaries from the internet (OpenStreetMap) and produces a heat map like this which is the result I expect from R, if possible:
The data is:
geo_data <- structure(list(DISTNAME = c("BOKARO", "CHATRA", "DEOGHAR", "DHANBAD",
"DUMKA", "GARHWA", "GIRIDIH", "GODDA", "GUMLA", "HAZARIBAGH",
"JAMTARA", "KHUNTI", "KODARMA", "LATEHAR", "LOHARDAGA", "PAKUR",
"PALAMU", "PASHCHIMI SINGHBHUM", "PURBI SINGHBHUM", "RAMGARH",
"RANCHI", "SAHIBGANJ", "SARAIKELA-KHARSAWAN", "SIMDEGA"), POP = c(521.5,
196.5, 323.8, 445.5, 123, 373.9, 357.6, 248.2, 212.4, 686.7,
626.7, 383.6, 391.9, 141, 436.1, 454.6, 301.3, 325.5, 193.7,
238.3, 208.7, 587.4, 130.1, 268)), .Names = c("DISTNAME", "POP"
), row.names = c(NA, 24L), class = "data.frame")
And looks like:
DISTNAME POP
1 BOKARO 521.5
2 CHATRA 196.5
3 DEOGHAR 323.8
4 DHANBAD 445.5
5 DUMKA 123.0
6 GARHWA 373.9
7 GIRIDIH 357.6
8 GODDA 248.2
9 GUMLA 212.4
10 HAZARIBAGH 686.7
11 JAMTARA 626.7
12 KHUNTI 383.6
13 KODARMA 391.9
14 LATEHAR 141.0
15 LOHARDAGA 436.1
16 PAKUR 454.6
17 PALAMU 301.3
18 PASHCHIMI SINGHBHUM 325.5
19 PURBI SINGHBHUM 193.7
20 RAMGARH 238.3
21 RANCHI 208.7
22 SAHIBGANJ 587.4
23 SARAIKELA-KHARSAWAN 130.1
24 SIMDEGA 268.0
You'll need SHP file, which can be found using getData(). Full working code:
library(tidyverse)
library(broom)
library(rgdal)
Your geo data
geo_data <- structure(list(DISTNAME = c("BOKARO", "CHATRA", "DEOGHAR", "DHANBAD", "DUMKA", "GARHWA", "GIRIDIH", "GODDA", "GUMLA", "HAZARIBAGH", "JAMTARA", "KHUNTI", "KODARMA", "LATEHAR", "LOHARDAGA", "PAKUR", "PALAMU", "PASHCHIMI SINGHBHUM", "PURBI SINGHBHUM", "RAMGARH", "RANCHI", "SAHIBGANJ", "SARAIKELA-KHARSAWAN", "SIMDEGA"),
POP = c(521.5, 196.5, 323.8, 445.5, 123, 373.9, 357.6, 248.2, 212.4, 686.7, 626.7, 383.6, 391.9, 141, 436.1, 454.6, 301.3, 325.5, 193.7, 238.3, 208.7, 587.4, 130.1, 268)),
.Names = c("DISTNAME", "POP"),
row.names = c(NA, 24L),
class = "data.frame")
get the map
library(raster)
IN2 <- getData('GADM', country='IND', level=2)
IN2 <- spTransform(IN2, CRS("+init=epsg:4326"))
IN2_map <- tidy(IN2, region = "NAME_2")
id in geo_data to lower
geo_data$DISTNAME <- tolower(geo_data$DISTNAME)
IN2_map %>%
mutate(id = tolower(id)) %>%
left_join(geo_data, by = c("id" = "DISTNAME")) %>%
ggplot() +
geom_polygon(aes(long, lat, group=group, fill = POP), color = "black")
In the solution below I've used map shapefiles downloaded from: http://projects.datameet.org/maps/districts/
Edit: Later I also tried Jharkhand map extracted from http://gadm.org/country which shows slight differences in district boundaries. It matches better with other political maps of the state available on the internet.
Here's my solution:
library(tmap)
library(tmaptools)
geo_data <- data.frame(
DISTNAME = c("BOKARO", "CHATRA", "DEOGHAR", "DHANBAD", "DUMKA", "GARHWA", "GIRIDIH", "GODDA", "GUMLA", "HAZARIBAGH", "JAMTARA", "KHUNTI", "KODARMA", "LATEHAR", "LOHARDAGA", "PAKUR", "PALAMU", "PASHCHIMI SINGHBHUM", "PURBI SINGHBHUM", "RAMGARH", "RANCHI", "SAHIBGANJ", "SARAIKELA-KHARSAWAN", "SIMDEGA"),
POP = c(521.5, 196.5, 323.8, 445.5, 123, 373.9, 357.6, 248.2, 212.4, 686.7, 626.7, 383.6, 391.9, 141, 436.1, 454.6, 301.3, 325.5, 193.7, 238.3, 208.7, 587.4, 130.1, 268))
# the path to shape file
shp_file <- "H:/Mapping/maps-master/Districts/Census_2011/2011_Dist.shp"
india <- read_shape(shp_file, as.sf = TRUE, stringsAsFactors = FALSE)
india$DISTRICT <- toupper(india$DISTRICT)
jharkhand <- india[india$ST_NM =="Jharkhand", ]
jharkhand_pop <- merge(x = jharkhand,
y = geo_data,
by.x = "DISTRICT",
by.y = "DISTNAME")
#tmap_mode(mode = "plot") # static
tmap_mode(mode = "view") # interactive
qtm(jharkhand_pop, fill = "POP",
text = "DISTRICT",
text.size=.9)
The static map (plot mode) is very good but the interactive map (view mode) is super awesome. It gives the option to pull additional map information from three different sources from the internet.
A big thanks to the creators of tmap and tmaptools packages. This method is far superior to many comparatively longer and awkward solutions that can be found on the internet.
If we want more customization:
tm_shape(jharkhand_pop) +
tm_polygons() +
tm_shape(jharkhand_pop) +
tm_borders() +
tm_fill("POP",
palette = get_brewer_pal("YlOrRd", n = 20),
n = 20,
legend.show = F,
style = "order") + # "cont" or "order" for continuous variable
tm_text("DISTRICT", size = .7, ymod = .1) +
tm_shape(jharkhand_pop) +
tm_text("POP", size = .7, ymod = -.2)
we get the following in plot mode:

Leaflet in R plotting icons unpredictably

My Shiny app takes a dataframe like this:
and subsets appropriately by allowing the user to select a person (P1_name) and a date (date).
When initally launched, it looks like this:
and already, it is clear that the app isn't working. There should be a letter 'N' at the location of the town of Apple Valley, but instead there is nothing. I can't figure out why, since the DF has been subsetted correctly:
and the layers should be plotted correctly:
m <- leaflet(DF) %>%
addTiles() %>% # Add default OpenStreetMap map tiles
setView(lat=setzoom[1], lng=setzoom[2], zoom=zoom_num) %>%
addMarkers(lat=subset(DF, P1_outcome=='W')$lat, lng=subset(DF, P1_outcome=='W')$lon, icon = icon_W) %>%
addMarkers(lat=subset(DF, P1_outcome=='L')$lat, lng=subset(DF, P1_outcome=='L')$lon, icon = icon_L) %>%
addMarkers(lat=subset(DF, P1_outcome=='D')$lat, lng=subset(DF, P1_outcome=='D')$lon, icon = icon_D) %>%
addMarkers(lat=subset(DF, P1_outcome=='N')$lat, lng=subset(DF, P1_outcome=='N')$lon, icon = icon_N)
Unfortunately, this is just one symptom of some sort of skitzophrenic behavior that my app is displaying. If that was the only problem, I'd be rejoicing. Instead, say I select John Doe, on his first row (which should be Crecent City)
and BOOM I get:
How in the world did Leaflet think I had given it two sets of coordinates to plot, and what made it think that John Doe was drowing somewhere in the Pacific Ocean.
Nothing here makes much sense. I can't see a pattern in the chaos it is outputting. It's barely 100 lines of simple code.
Some ideas:
the conditionalPanel is mixing up my dataframe? I don't think so, since I can View(DF) and see that this part isn't the problem.
the layering in the icons isn't working? Not sure how this would be a problem, as we know that this is the correct way to plot icons.
I am getting an xtable warning, Warning in run(timeoutMs) : data length exceeds size of matrix, but this is just for the tableOutput part, which I don't think is related to any of the issue I'm beseiged with.
I'm stumped. Been stuck on this all day. If anyone has any insight, ideas, incantations, etc, I'd love to hear them.
UI.R
library(shiny)
library(ggplot2)
library(dplyr)
library(leaflet)
library(data.table)
options(xtable.include.rownames=F)
library(ggmap)
library(lubridate)
DF <- data.frame(lon=c(-120.6596156, -87.27751, -119.7725868, -124.2026, -117.1858759),
lat=c(35.2827524, 33.83122, 36.7468422, 41.75575, 34.5008311),
date=c('2014-03-14', '2014-01-11', '2013-11-22', '2012-08-23', '2013-08-23'),
location=c('San Luis Obispo', 'Jasper', 'Fresno', 'Crescent City', 'Apple Valley'),
P1_name=c('John Doe', 'John Doe', 'John Doe', 'John Doe', 'Joe Blow'),
P1_outcome=c('W', 'L', 'D', 'W', 'N'))
DF$date <- as.Date(DF$date, format="%Y-%m-%d")
DF <- arrange(DF, P1_name, date)
DT <- data.table(DF)
DT[, .date := sequence(.N), by = "P1_name"]
DF$date <- paste(DF$date, ' (', DT$.date, ')', sep='')
DF <- arrange(DF, P1_name, desc(date))
DF$P1_name <- as.character(DF$P1_name)
DF$P1_outcome <- as.character(DF$P1_outcome)
DF$location <- as.character(DF$P1_location)
#str(DF$P1_outcome)
icon_W <- makeIcon(
iconUrl = "http://i58.tinypic.com/119m3r5_th.gif",
iconWidth = 10, iconHeight = 23,
iconAnchorX = 10, iconAnchorY =23
)
icon_L <- makeIcon(
iconUrl = "http://i62.tinypic.com/2dulcvq_th.jpg",
iconWidth = 10, iconHeight = 23,
iconAnchorX = 10, iconAnchorY = 23
)
icon_D <- makeIcon(
iconUrl = "http://i58.tinypic.com/2zox2yf_th.gif",
iconWidth = 10, iconHeight = 23,
iconAnchorX = 10, iconAnchorY = 23
)
icon_N <- makeIcon(
iconUrl = "http://i62.tinypic.com/339j7de_th.gif",
iconWidth = 10, iconHeight = 23,
iconAnchorX = 22, iconAnchorY = 94
)
server <- function(input, output, session) {
output$dates<-renderUI({
selectInput('dates', 'by date / number', choices=DF[which(DF$P1_name == input$person), ]$date, selectize = FALSE)
})
output$map<-renderLeaflet({
validate(
need(!is.null(input$dates),""),
need(!is.null(input$person),"")
)
if(input$radio=='by date'){
DF <- filter(DF, P1_name==input$person, date==input$dates)
View(DF)
zoom_num <- 5
setzoom <- c(DF$lat, DF$lon)
outcome <- data.frame(DF$P1_outcome, DF$location)
output$table <- renderTable(outcome)
}
else{
DF <- filter(DF, P1_name==input$person)
View(DF)
zoom_num <- 2
setzoom <- c(DF$lat[1], DF$lon[1])
outcome <- data.frame(DF$P1_outcome, DF$location)
output$table <- renderTable(outcome)
}
m <- leaflet(DF) %>%
addTiles() %>% # Add default OpenStreetMap map tiles
setView(lat=setzoom[1], lng=setzoom[2], zoom=zoom_num) %>%
addMarkers(lat=subset(DF, P1_outcome=='W')$lat, lng=subset(DF, P1_outcome=='W')$lon, icon = icon_W) %>%
addMarkers(lat=subset(DF, P1_outcome=='L')$lat, lng=subset(DF, P1_outcome=='L')$lon, icon = icon_L) %>%
addMarkers(lat=subset(DF, P1_outcome=='D')$lat, lng=subset(DF, P1_outcome=='D')$lon, icon = icon_D) %>%
addMarkers(lat=subset(DF, P1_outcome=='N')$lat, lng=subset(DF, P1_outcome=='N')$lon, icon = icon_N)
}) #<- end output$map
} #<- end server function
ui <- fluidPage(
titlePanel("Location Explorer"),
sidebarLayout (
sidebarPanel(
selectInput('person', 'Select person', choices=unique(DF$P1_name), selectize = FALSE),
radioButtons('radio', 'Select row(s)', choices=c('by date', 'all'), selected = NULL, inline = TRUE),
conditionalPanel(
condition = "input.radio == 'by date'",
uiOutput('dates')
),
conditionalPanel(
condition = "input.radio == 'all'"
)
),
mainPanel(
leafletOutput('map'),
fluidRow(column(4, tableOutput('table')))
))
) #<- end ui
shinyApp(ui = ui, server = server)
One of the issue could be that you are adding empty markers in your subsets and leaflet reacts strangely to that.
For example, when you select Joe Blow, all the subsets for P1_outcome == "W", "L" or "D" are empty.
As described here, you could use the iconList function to change the icons depending on P1_outcome and remove all the subset.
You could for example add:
icon_list <- iconList(W=icon_W,L=icon_L,D=icon_D,N=icon_N)
right after you define all the icons, and use:
m <- leaflet(DF) %>%
addTiles() %>% # Add default OpenStreetMap map tiles
setView(lat=setzoom[1], lng=setzoom[2], zoom=zoom_num) %>%
addMarkers(lat=DF$lat, lng=DF$lon,icon= ~icon_list[DF$P1_outcome])
to create your map.

Resources