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

[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!

Related

View venn.diagram in RStudio viewer (not just write to file) using VennDiagram?

Using the VennDiagram package, we can make a venn diagram like so with the venn.diagram() function like so:
library(tidyverse)
library(hrbrthemes)
library(tm)
library(proustr)
# Load dataset from github
data <- read.table("https://raw.githubusercontent.com/holtzy/data_to_viz/master/Example_dataset/14_SeveralIndepLists.csv", header=TRUE)
to_remove <- c("_|[0-9]|\\.|function|^id|script|var|div|null|typeof|opts|if|^r$|undefined|false|loaded|true|settimeout|eval|else|artist")
data <- data %>% filter(!grepl(to_remove, word)) %>% filter(!word %in% stopwords('fr')) %>% filter(!word %in% proust_stopwords()$word)
# library
library(VennDiagram)
#Make the plot
venn.diagram(
x = list(
data %>% filter(artist=="booba") %>% select(word) %>% unlist() ,
data %>% filter(artist=="nekfeu") %>% select(word) %>% unlist() ,
data %>% filter(artist=="georges-brassens") %>% select(word) %>% unlist()
),
category.names = c("Booba (1995)" , "Nekfeu (663)" , "Brassens (471)"),
filename = 'venn.png',
output = TRUE ,
imagetype="png" ,
height = 480 ,
width = 480 ,
resolution = 300,
compression = "lzw",
lwd = 1,
col=c("#440154ff", '#21908dff', '#fde725ff'),
fill = c(alpha("#440154ff",0.3), alpha('#21908dff',0.3), alpha('#fde725ff',0.3)),
cex = 0.5,
fontfamily = "sans",
cat.cex = 0.3,
cat.default.pos = "outer",
cat.pos = c(-27, 27, 135),
cat.dist = c(0.055, 0.055, 0.085),
cat.fontfamily = "sans",
cat.col = c("#440154ff", '#21908dff', '#fde725ff'),
rotation = 1
)
This results in a .png written to the working directly.
How can it instead be viewed in the RStudio viewer pane, and also used in RMarkdown docs etc (i.e. just in the same way a regular ggplot or base plots would be viewed)?
Also note, the same question applies to any of the examples found in the ?
venn.diagram documentation (they all seem to write to file instead of display in the RStudio viewer)
This should also do the job. I deleted the arguments for readability:
...
plt <- venn.diagram(
filename = NULL,
cex = 1,
cat.cex = 1,
lwd = 2,
)
grid::grid.draw(plt)
From ?venn.diagram
filename
Filename for image output, or if NULL returns the grid object itself
It seems, you can control almost anything. Again the docs:
... A series of graphical parameters tweaking the plot. See below for
details Details
Argument Venn Sizes Class Description
cex 1,2,3,4,5 numeric Vector giving the size for each area label (length = 1/3/7/15 based on set-number)
Thus we need to be able to display grid objects. plot() and print() don't do this job (it seems there is not print.grid()).
I usually do:
library(VennDiagram)
set.seed(1)
list1 <- list(A=sample(LETTERS, 12), B=sample(LETTERS, 12))
venn1 <- venn.diagram(list1, filename = NULL)
grid.newpage()
grid.draw(venn1)
I think it still writes a log file into the working directory, but not the graph.
You can put two diagrams side by side like this:
library(gridExtra)
set.seed(2)
list2 <- list(A=sample(LETTERS, 16), B=sample(LETTERS, 12))
venn2 <- venn.diagram(list2, filename = NULL)
grid.arrange(gTree(children=venn1),
gTree(children=venn2),
ncol=2)
Created on 2020-04-23 by the reprex package (v0.3.0)
I figured out a way - there may be better way(s). This involves writing to tempfile() instead of a file in the working directory and then reading it in with a few extra lines of code
Note: the only changes to the original code are the addition of
1 extra line at the start temp_file <- tempfile()
the rewriting of filename = 'venn.png' into filename = temp_file
3 extra lines at the bottom
# Libraries
library(tidyverse)
library(hrbrthemes)
library(tm)
library(proustr)
# Load dataset from github
data <- read.table("https://raw.githubusercontent.com/holtzy/data_to_viz/master/Example_dataset/14_SeveralIndepLists.csv", header=TRUE)
to_remove <- c("_|[0-9]|\\.|function|^id|script|var|div|null|typeof|opts|if|^r$|undefined|false|loaded|true|settimeout|eval|else|artist")
data <- data %>% filter(!grepl(to_remove, word)) %>% filter(!word %in% stopwords('fr')) %>% filter(!word %in% proust_stopwords()$word)
# library
library(VennDiagram)
temp_file <- tempfile()
#Make the plot
venn.diagram(
x = list(
data %>% filter(artist=="booba") %>% select(word) %>% unlist() ,
data %>% filter(artist=="nekfeu") %>% select(word) %>% unlist() ,
data %>% filter(artist=="georges-brassens") %>% select(word) %>% unlist()
),
category.names = c("Booba (1995)" , "Nekfeu (663)" , "Brassens (471)"),
filename = temp_file,
output = TRUE ,
imagetype="png" ,
height = 480 ,
width = 480 ,
resolution = 300,
compression = "lzw",
lwd = 1,
col=c("#440154ff", '#21908dff', '#fde725ff'),
fill = c(alpha("#440154ff",0.3), alpha('#21908dff',0.3), alpha('#fde725ff',0.3)),
cex = 0.5,
fontfamily = "sans",
cat.cex = 0.3,
cat.default.pos = "outer",
cat.pos = c(-27, 27, 135),
cat.dist = c(0.055, 0.055, 0.085),
cat.fontfamily = "sans",
cat.col = c("#440154ff", '#21908dff', '#fde725ff'),
rotation = 1
)
# https://stackoverflow.com/a/20909108/5783745
library(png)
img <- readPNG(temp_file)
grid::grid.raster(img)

wide data format as input to a Shiny mapview app - reactive wrapper(s) needed?

I'm having trouble using columns from data originating in wide format as dynamic inputs to a Shiny map app.
In the app I'm hoping to be able to:
select a parameter of point data (sample data below: 16 locations, 6 parameters) in a drop down type menu and adjust the symbol size to represent the selected parameter's absolute values with a slider (to help visualize positive and negative differences from zero)
with any parameter selected, retain ability to see all parameters (the columns) in mapview's popup feature (mapview turns the columns into rows for the popup). It seems a filtered long format data.frame would be missing data from the popup/viewing perspective
retain the (non absolute) original value on the mouseover hover label (eg the -7.3 in the image)
In addition to having those features, I don't know if/where I need to set reactive wrapper(s)? Or, maybe I could do everything more easily with another map-centric library (even though mapview is awesome for many things)?
My attempts are commented out below - the UI works as intended except without drop down selectability - the app is limited to only one working dropdown parameter with mapview(df["param1"] and cex = param1 * input$cex.
Here's the reproducible app.r:
library(tidyverse)
library(sf)
library(shiny)
library(shinydashboard)
library(leaflet)
library(mapview)
## sample earthquake data ##
set.seed(6)
lat <- rnorm(16,-34, 9)
lon <- rnorm(16,-67,.3)
param1 <- rnorm(16, 10, 40) %>% round(1)
param2 <- rnorm(16, 25, 3) %>% round(1)
param3 <- rnorm(16, -18, 10) %>% round(1)
param4 <- rnorm(16, -200, 93) %>% round(1)
param5 <- rnorm(16, 0.1, .09) %>% round(1)
param6 <- rnorm(16, 417, 33) %>% round(1)
df <- data.frame(lat, lon, param1, param2, param3, param4, param5,
param6)
df <- st_as_sf(df, coords = c("lon", "lat"), crs = 4326)
paramchoices <- colnames(df) %>% .[.!="geometry"]
colorpal = mapviewPalette("mapviewSpectralColors")
ui <- dashboardPage(
dashboardHeader(),
dashboardSidebar(
sliderInput("cex", "Symbol Size",
min = 0.000001, max = 10, value = 1, step = 0.000001
),
selectizeInput(
"parameter", "Earthquake Parameter", choices = paramchoices,
selected = c("param1"),
multiple = FALSE)
),
dashboardBody(
tags$style(type = "text/css", "#mapplot {height: calc(100vh - 80px) !important;}"),
leafletOutput("mapplot")
)
)
server <- function(input, output) {
# df <- reactive ({
# df %>% mutate(selectedparameter = input$parameter,
# selectedparameter_abs = abs(selectedparameter))
# })
output$mapplot <- renderLeaflet({
m <- mapview(df["param1"], #mouseover column
#m <- mapview(df["selectedparameter"],
cex = param1 * input$cex, #marker size column
#cex = df$selectedparameter_abs * input$cex,
col.regions = colorpal(100),
alpha.regions = 0.3,
legend = TRUE,
popup = popupTable(df),
layer.name = "selectedparam[unit]")
m#map
}
)}
shinyApp(ui, server)
more info related to the absolute value part - Point color and symbol size based on different variables in mapview
thank you.

Mapping the shortest flight path across the date line in R leaflet/Shiny, using gcIntermediate [duplicate]

This question already has answers here:
Plotting routes that cross the international dateline using leaflet library in R
(3 answers)
Closed 4 years ago.
I'm creating a map of Australian airports and their international destinations using R-Leaflet.
Here is my sample data:
df<-data.frame("Australian_Airport" = "Brisbane",
"International" = c("Auckland", "Bandar Seri Begawan","Bangkok","Christchurch","Denpasar","Dunedin","Hamilton","Hong Kong","Honiara","Kuala Lumpur"),
"Australian_lon" = c(153.117, 153.117,153.117,153.117,153.117,153.117, 153.117, 153.117, 153.117, 153.117),
"Australian_lat" = c(-27.3842,-27.3842,-27.3842,-27.3842,-27.3842,-27.3842, -27.3842, -27.3842, -27.3842, -27.3842),
"International_lon" = c(174.7633, 114.9398, 100.5018, 172.6362, 115.2126,-82.77177, -84.56134, 114.10950, 159.97290, 101.68685),
"International_lat" = c(-36.848460, 4.903052, 13.756331, -43.532054,-8.670458,28.019740, 39.399501, 22.396428, -9.445638, 3.139003)
)
I thought it would be cool to use curved flight paths using gcIntermediate, so I created a SpatialLines object:
library(rgeos)
library(geosphere)
p1<-as.matrix(df[,c(3,4)])
p2<-as.matrix(df[,c(5,6)])
df2 <-gcIntermediate(p1, p2, breakAtDateLine=F,
n=100,
addStartEnd=TRUE,
sp=T)
And then I plotted it using leaflet and Shiny:
server <-function(input, output) {
airportmap<- leaflet() %>% addTiles() %>%
addCircleMarkers(df, lng = df$Australian_lon, lat = df$Australian_lat,
radius = 2, label = paste(df$Australian_Airport, "Airport"))%>%
addPolylines(data = df2, weight = 1)
output$mymap <- renderLeaflet({airportmap}) # render the base map
}
ui<- navbarPage("International flight path statistics - top routes",
tabPanel("Interactive map",
leafletOutput('mymap', width="100%", height=900)
)
)
# Run the application
shinyApp(ui = ui, server = server)
It looks like this:
So the paths are incorrect if they cross the date line. Changing breakAtDateLine to FALSE doesn't fix it (the line disappears but the path is still broken). At this stage, I suspect I may need to use a different mapping system or something but I'd be very grateful if anyone has some advice.
Thanks in advance.
Overview
I set the max bounds and minimum zoom level to only display the world map once. It looks okay in the RStudio viewer but fails when I display it in browser. I'm hoping this helps spark other answers.
Code
# load necessary packages
library( leaflet )
library( geosphere )
# create data
df <-
data.frame("Australian_Airport" = "Brisbane",
"International" = c("Auckland", "Bandar Seri Begawan","Bangkok","Christchurch","Denpasar","Dunedin","Hamilton","Hong Kong","Honiara","Kuala Lumpur"),
"Australian_lon" = c(153.117, 153.117,153.117,153.117,153.117,153.117, 153.117, 153.117, 153.117, 153.117),
"Australian_lat" = c(-27.3842,-27.3842,-27.3842,-27.3842,-27.3842,-27.3842, -27.3842, -27.3842, -27.3842, -27.3842),
"International_lon" = c(174.7633, 114.9398, 100.5018, 172.6362, 115.2126,-82.77177, -84.56134, 114.10950, 159.97290, 101.68685),
"International_lat" = c(-36.848460, 4.903052, 13.756331, -43.532054,-8.670458,28.019740, 39.399501, 22.396428, -9.445638, 3.139003)
, stringsAsFactors = FALSE
)
# create curved lines
curved.lines <-
gcIntermediate(
p1 = as.matrix( x = df[ , 3:4 ] )
, p2 = as.matrix( x = df[ , 5:6 ] )
, breakAtDateLine = TRUE
, n = 1000
, addStartEnd = TRUE
, sp = TRUE
)
# create leaflet
airport <-
leaflet( options = leafletOptions( minZoom = 1) ) %>%
setMaxBounds( lng1 = -180
, lat1 = -89.98155760646617
, lng2 = 180
, lat2 = 89.99346179538875 ) %>%
addTiles() %>%
addCircleMarkers( data = df
, lng = ~Australian_lon
, lat = ~Australian_lat
, radius = 2
, color = "red"
, label = paste( ~Australian_Airport
, "Airport" )
) %>%
addCircleMarkers( data = df
, lng = ~International_lon
, lat = ~International_lat
, radius = 2
, color = "blue"
, label = paste( ~International
, "Airport" )
) %>%
addPolylines( data = curved.lines
, weight = 1
)
# display map
airport
# end of script #
If you are interested in another mapping library, then googleway uses Google Maps, which in my experience is better at handling lines that cross the date line.
Notes
To use Google Maps you need an API key
Currently only sf objects are supported, not sp
This will also work in shiny; I'm just showing you the basic map here
I authored googleway
library(sf)
library(googleway)
## convert the sp object to sf
sf <- sf::st_as_sf(df2)
set_key("your_api_key")
google_map() %>%
add_polylines(data = sf)

disable zoom, dragging in gvisMap

Is there a way to entirely disable dragging and/or zooming in gvisMap, and remove the zoom control also? I have looked at options under google.com developers docs referenced in the help for gvisMap(options) but can't see this control.
Broadening the scope of the question to include alternative packages, I note that plotGoogleMaps() in R package plotGoogleMaps has an option draggable=FALSE, but there is no corresponding parameter to disable zoom, and rendering it in shiny is not so simple as renderGvis(). I had a quick look at RgoogleMaps package also.
Background: I particularly want a google satellite map for the transition to street view, I set the map bounds from a zoom/drag enabled leaflet map, so enabling zoom/drag on the google satellite view is redundant/confusing. Disabling these capabilities is a detail that would improve the UX.
[edit] This revised example is a bit longer but shows in full the functionality I am referring to. It works fine apart from some niggles such as I don't know why the fudge factors are needed, and I don't know how to turn off the markers in the google map - but these are outside the scope of my question. The specific subject of my question however is: can I disable drag and zoom on the google map, just like I do in leafletOptions(zoomControl = FALSE, dragging = F)? If I had a supplementary question, it would be something like 'how do I reduce the proliferation of google mapping packages?' - but that is not a valid question for this forum. That said, I'd welcome any broader steer on how to simplify this.
library(shiny)
library(leaflet)
library(googleVis)
library(RgoogleMaps)
ui <- fluidPage(fluidPage(fluidRow(
h5('control map - use only this one to drag and zoom'),
column(6, leafletOutput('controlmap'), offset = 0)
,
h5("google map - drop 'peg man' to get street view"),
column(6, htmlOutput('gmap'), offset = 0)
)
,
fluidRow(
h5('choropleth - where the colour-coded data is displayed'),
column(6, leafletOutput('fitmap'), offset = 0)
)))
server <- function(input, output) {
latlongR <- reactive({
if (is.null(input$controlmap_bounds)) {
data.frame(
Lat = c(51.52, 51.51),
Long = c(-.106, -.096),
Tip = as.character(1:2)
)
} else {
data.frame(
Lat = c(
input$controlmap_bounds$north,
input$controlmap_bounds$south
),
Long = c(
input$controlmap_bounds$east,
input$controlmap_bounds$west
),
Tip = as.character(1:2)
)
}
})
boundR <- reactive({
fudgezoom <- .7 #fudge - unsure why neeed
x0 <- latlongR()
d1 <- abs(diff(x0[, 1]))
d2 <- abs(diff(x0[, 2]))
m1 <- mean(x0[, 1])
m2 <- mean(x0[, 2])
x1 <- c(m1 + fudgezoom * d1 / 2, m1 - fudgezoom * d1 / 2)
x2 <- c(m2 + fudgezoom * d2 / 2, m2 - fudgezoom * d2 / 2)
x3 <- cbind(x0, LatLong = paste0(x1, ':', x2))
x3
})
output$controlmap <- renderLeaflet({
leaflet(width = 500, height = 400) %>%
addProviderTiles('OpenStreetMap') %>%
setView(lng = -0.106831,
lat = 51.515328,
zoom = 15)
})
output$fitmap <- renderLeaflet({
x1 <- latlongR()
fudgefit <- .5 #this fudge depends on layout and maybe other variables
x2 <-
RgoogleMaps::MaxZoom(
latrange = fudgefit * x1$Lat,
lonrange = fudgefit * x1$Long,
size = c(500, 400)
)
leaflet(
width = 500,
height = 400,
options = leafletOptions(zoomControl = FALSE, dragging = F)
) %>%
addProviderTiles('CartoDB.Positron') %>%
fitBounds(
lng1 = x1$Long[1],
lat1 = x1$Lat[1],
lng2 = x1$Long[2],
lat2 = x1$Lat[2]
) %>%
setView(zoom = x2,
lat = mean(x1$Lat),
lng = mean(x1$Long))
})
output$gmap <- renderGvis({
x3 <- boundR()
gvisMap(
x3,
"LatLong" ,
tipvar = "Tip",
options = list(
showTip = F,
icons = NULL,
useZoomControl = F,
useMapTypeControl = F
)
)
})
}
shinyApp(ui = ui, server = server)

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