How to set custom color in AddTimeLine - r

I am trying to create a time line plot using leaflet and leaftime packages. I want to set custom color in addTimeline to specify each point to his groups, as follows:
library(leaflet)
library(leaftime)
library(geojsonio)
power_d <- data.frame(
"Latitude" = c(
33.515556, 38.060556, 47.903056, 49.71, 49.041667, 31.934167,
54.140586, 54.140586, 48.494444, 48.494444
),
"Longitude" = c(
129.837222, -77.789444, 7.563056, 8.415278, 9.175, -82.343889,
13.664422, 13.664422, 17.681944, 17.681944
),
"start" = seq.Date(as.Date("2015-01-01"), by = "day", length.out = 10),
"end" = seq.Date(as.Date("2015-01-01"), by = "day", length.out = 10) + 1,
color_temp=rep(c("red","blue","green"),len=10)
)
power_geo <- geojsonio::geojson_json(power_d ,lat="Latitude",lon="Longitude")
leaflet() %>%
addTiles() %>%
setView(44.0665,23.74667,2) %>%
addTimeline(data = power_geo,
timelineOpts = timelineOptions(
styleOptions = styleOptions(
radius = 5,
color=color_temp,
fillColor = color_temp,
fillOpacity = 1
)
)
)
Unfortunately I got following error:
Error in lapply(x, f) : object 'color_temp' not found
I also try replacing color_temp with power_d$color_temp, the code run without error, but the color of points do not change. The color arguments not work in above code, why? and how to fix it?

It doesn't seem as if you can pass a vector of colours with the standard styleOptions, however, an example from the help page for ?addTimeline show how you can add colours based on the data using a little JavaScript (which thankfully is provided in the example).
Using the example that starts "# to style each point differently based on the data" you need to change it slightly to point to your colour vector e.g. change data.properties.color to data.properties.color_temp. Running the code below leads to
# code
leaflet(power_geo) %>%
addTiles() %>%
setView(44.0665,23.74667,2) %>%
addTimeline(
timelineOpts = timelineOptions(
styleOptions = NULL,
pointToLayer = htmlwidgets::JS(
"
function(data, latlng) {
return L.circleMarker(
latlng,
{
radius: 25,
color: data.properties.color_temp,
fillColor: data.properties.color_temp,
fillOpacity: 1
}
);
}
"
)
)
)

Related

Leaflet map crashes on recoloring after translation (Shiny, Leaflet, shiny.i18n)

I'm currently trying to make a Shiny app for Leaflet cards with simple translations. Each leaflet card has several base groups that are linked to different variables. To avoid re-rendering the leaflet maps every time the base group changes, I have adopted a function I found here which only changes the fill of the polygons.
As long as I only use one language, the app works without problems, but when multiple translations options are implemented, the app crashes. The problem seems to occur when I try to link input$map_groups to variables needed for colouring.
My code looks like this:
library(shiny)
library(shinyWidgets)
library(leaflet)
library(sf)
library(dplyr)
library(shiny.i18n)
#--- Loading Generic Shape File For Demonstration
shape <- st_read(system.file("shape/nc.shp", package = "sf"),
stringsAsFactors = FALSE) %>%
#--- Mutating Two Variables To Factors As My Map Uses Factors
mutate(One = as.factor(SID74), Two = as.factor(SID79)) %>%
#--- Keep Just This Three Variables
select(c(CNTY_ID, One, Two))
#--- Color Palette For Filling Polygons
scale.color <- colorFactor(palette = "RdYlBu", levels = seq(1:60))
#--- Loading And Rgistering Translation File
lang <- Translator$new(translation_json_path = "./translations.json")
lang$set_translation_language("gb")
language <- c("English", "Deutsch", "Français" , "Español")
#--- Naming Vector For Base Groups And Related Variables
layer_calls <- setNames(c('One', 'Two'), c("First", "Second"))
#--- A Function For Recoloring An Existing Polygon And Related JS-Code
#----- Source: https://github.com/rstudio/leaflet/issues/496#issuecomment-650122985
setShapeStyle <- function(map, data = getMapData(map), layerId, stroke = NULL, color = NULL, weight = NULL,
opacity = NULL, fill = NULL, fillColor = NULL, fillOpacity = NULL, dashArray = NULL,
smoothFactor = NULL, noClip = NULL, options = NULL){
options <- c(list(layerId = layerId),
options,
filterNULL(list(stroke = stroke, color = color, weight = weight, opacity = opacity,
fill = fill, fillColor = fillColor, fillOpacity = fillOpacity,
dashArray = dashArray, smoothFactor = smoothFactor, noClip = noClip)))
# Evaluate All Options
options <- evalFormula(options, data = data)
options <- do.call(data.frame, c(options, list(stringsAsFactors = FALSE)))
layerId <- options[[1]]
style <- options[-1] # drop layer column
leaflet::invokeMethod(map, data, "setStyle", "shape", layerId, style);
}
leafletjs <- tags$head(
tags$script(HTML(
'
window.LeafletWidget.methods.setStyle = function(category, layerId, style){
var map = this;
if (!layerId){
return;
} else if (!(typeof(layerId) === "object" && layerId.length)){ // in case a single layerid is given
layerId = [layerId];
}
//convert columnstore to row store
style = HTMLWidgets.dataframeToD3(style);
//console.log(style);
layerId.forEach(function(d,i){
var layer = map.layerManager.getLayer(category, d);
if (layer){ // or should this raise an error?
layer.setStyle(style[i]);
}
});
};
'
)))
#--- Defining UI
ui <- fluidPage(
leafletjs,
usei18n(lang),
pickerInput(inputId = 'selected_language', width = 125,
choices = c("gb", "de", "fr", "es"),
selected = lang$get_key_translation()),
leafletOutput("map")
)
#--- Defining Server Logic
server <- function(input, output, session){
output$map <- renderLeaflet({
leaflet(data = shape) %>%
#--- Initial Unfilled Polygon Map
addPolygons(layerId = ~CNTY_ID, stroke = TRUE, color = "white", weight = 1.25,
highlightOptions = highlightOptions(stroke = 5, weight = 10)) %>%
#--- Initial Layer Controls
addLayersControl(baseGroups = lang$t(names(layer_calls)))
})
#--- Filling Polygons Based On Base Layer-Variable After Translation
observe({
req(input$selected_language)
update_lang(session, input$selected_language)
leafletProxy("map", data = shape) %>%
#--- This Part Always Crashes Shiny!!!
setShapeStyle(layerId = ~CNTY_ID, fillOpacity = 1)#, fillColor = ~scale.color(get(layer_calls[lang$t(input$map_groups)])))
})
}
# Run the application
shinyApp(ui = ui, server = server)
My basic translation scheme would be provided by a JSON file which looks like this:
{
"languages": [
"gb",
"de",
"fr",
"es"
],
"translation": [
{
"gb": "First",
"de": "Erste",
"fr": "Premier",
"es": "Primera"
},
{
"gb": "Second",
"de": "Zweite",
"fr": "Deuxième",
"es": "Segundo"
}
]
}
In my One-Langue-App I can simply use , fillColor = ~scale.color(get(layer_calls[[input$map_groups]])) to trigger a recoloring after the base group has been changed. Unfortunately, I have no idea how to connect the selected base group to a call of the needed variable to trigger the recoloring. Any kind of help is greatly appreciated!

r plotly update button with line plot does not work with add_markers

I have a problem with the joined plot of an updatable line and static markers in R plotly. The line plot is updated via a drop down menu button, which works well on its own. The additional dots in the add_markers function are also correct when the plot is first initialized.
But after the first update, the markers are cut off (to the left side of the plot where the line starts) and remaining markers are modified (y values are different to initial ones).
For the example here the button function is simplified, but the result shows the same strange behavior.
`
sample_df <- tibble::tibble(quarter_date = rep(c("2022-06-30","2022-09-30","2022-12-31"),3),
forecast_value = runif(9,min = 10,max = 16),
forecast_date = c(rep("2022-07-23",3),rep("2022-08-26",3),rep("2022-09-15",3)))
marks = tibble::tibble(dates = c("2022-05-21","2022-06-15","2022-07-02","2022-07-26","2022-08-27"),
values = c(11,13,12,15,14))
create_buttons <- function(df, date_id) {
lapply(
date_id,
FUN = function(date_id,df) {
button <- list(
method = 'restyle',
args = list('y', list(df %>%
dplyr::filter(forecast_date == date_id) %>%
dplyr::pull(forecast_value))),
label = sprintf('Forecast # %s', date_id)
)
},
df
)
}
plotly::plot_ly(x = ~quarter_date) %>%
plotly::add_trace(data = sample_df %>%
dplyr::filter(forecast_date == max(forecast_date)),
#x = ~period_date,
y = ~forecast_value,
type = 'scatter',
mode = 'markers+lines',
name = 'forecasts') %>%
plotly::layout(
title = "Drop down menue",
yaxis = list(title = "y"),
updatemenus = list(
list(
y =1,
x = 0.9,
buttons = create_buttons(sample_df, unique(sample_df$forecast_date))
)
)) %>%
plotly::add_markers(data = marks,
x = ~dates,
y = ~values)
`
I have tried to set a wide xrange, used a second y2 axis and different approaches in the button calculation but nothing works as intended.
Does anyone have a clue why the add_markers is not working correctly after updating the line plot? Any ideas are highly appreciated!
Adding markers aren't the issue. The issue comes from the restyle. When you restyle the plot without designating that you only meant to change one trace, you changed all traces.
The solution is actually quite simple, you just need one more argument in your args call-- the trace number in a list: list(0) in this case. I've commented out your original args call, so you can see the change.
To make this repeatable, I added set.seed(46) before the creation of sample_df.
create_buttons <- function(df, date_id) {
lapply(
date_id,
FUN = function(date_id, df) {
button <- list(
method = 'restyle',
args = list('y', list(df %>% filter(forecast_date == date_id) %>%
pull(forecast_value)), list(0)),
# args = list('y', list(df %>%
# filter(forecast_date == date_id) %>%
# pull(forecast_value))),
label = sprintf('Forecast # %s', date_id)
)
},
df
)
}
Now when you run your plot, you will see that your marker data remains visible.

Is there a way to add a click event to open a url in a highcharter plot without shiny?

I am trying to make a map plot using highcharter in which the points can be clicked to access their associated url. I've created the following simplified version of what I am doing (I'm doing a mapbubble plot instead) to illustrate my code. What am I doing wrong? Note: I have also tried this.point.options.url in the javascript section of the code.
library(dplyr)
library(highcharter)
data("USArrests", package = "datasets")
USArrests = mutate(USArrests, "woe-name" = rownames(USArrests))
USArrests[["url"]] = c("https://www.google.com/", "https://www.wikipedia.org/")
hcmap(map = "countries/us/us-all", data = USArrests,
joinBy = "woe-name", value = "UrbanPop", name = "Urban Population",
allowPointSelect = TRUE) %>%
hc_plotOptions(
point = list(
events = list(
click = JS("function() {
window.open(point.url);
}"
)
)
)
)
There are 2 issues with your code:
The map tile is a map and not a point, thus, your option file should link the event handler to map and not point.
To access the urlyou have to use a parameter in your JS function via which you can access the url eventually.
hcmap(map = "countries/us/us-all", data = USArrests,
joinBy = "woe-name", value = "UrbanPop", name = "Urban Population",
allowPointSelect = TRUE) %>%
hc_plotOptions(
map = list(
events = list(
click = JS("function(self) {
window.open(self.point.url);
}"
)
)
)
)

Customize colors for boxplot with highcharter

I have boxplots on highcharter and I would like to customize both the
Fill color
Border color
Here is my code
df = data.frame(cbind(categ = rep(c('a','b','c','d')),value = rnorm(1000)))
hcboxplot(var = df$categ, x = as.numeric(df$value)) %>%
hc_chart(type = "column") %>%
hc_colors(c("#203d7d","#a0a0ed","#203d7e","#a0a0ad"))
The hc_colors works only if I put var2 instead of var but then the box plot are shrunken...
API for styling fillColor: https://api.highcharts.com/highcharts/series.boxplot.fillColor
And for "Border color": https://api.highcharts.com/highcharts/series.boxplot.color
Pure JavaScript example of how to style and define points: https://jsfiddle.net/BlackLabel/6tud3fgx
And R code:
library(highcharter)
df = data.frame(cbind(categ = rep(c('a','b','c','d', 'e')),value = rnorm(1000)))
hcboxplot(var = df$categ, x = as.numeric(df$value)) %>%
hc_chart(type = "column", events = list(
load = JS("function() {
var chart = this;
chart.series[0].points[2].update({
color: 'red'
})
chart.series[0].points[4].update({
x: 4,
low: 600,
q1: 700,
median: 800,
q3: 900,
high: 1000,
color: 'orange'
})
}")
)) %>%
hc_plotOptions(boxplot = list(
fillColor = '#F0F0E0',
lineWidth = 2,
medianColor = '#0C5DA5',
medianWidth = 3,
stemColor = '#A63400',
stemDashStyle = 'dot',
stemWidth = 1,
whiskerColor = '#3D9200',
whiskerLength = '20%',
whiskerWidth = 3,
color = 'black'
)) %>%
hc_colors(c("#203d7d","#a0a0ed","#203d7e","#a0a0ad"))
I made a couple functions to do some stuff with highcharts and boxplots. It will let you color each boxplot and fill it accordingly, and then inject new graphical parameters according to the Highcharts API, should you desire.
Check it out:
## Boxplots Data and names, note the data index (0,1,2) is the first number in the datum
series<- list(
list(
name="a",
data=list(c(0,1,2,3,4,5))
),
list(
name="b",
data=list(c(1,2,3,4,5,6))
),
list(
name="c",
data=list(c(2,3,4,5,6,7))
)
)
# Graphical attribute to be set: fillColor.
# Make the colors for the box fill and then also the box lines (make them match so it looks pretty)
cols<- viridisLite::viridis(n= length(series2), alpha = 0.5) # Keeping alpha in here! (for box fill)
cols2<- substr(cols, 0,7) # no alpha, pure hex truth, for box lines
gen_key_vector<-function(variable, num_times){
return(rep(variable, num_times))
}
kv<- gen_key_vector(variable = "fillColor", length(series))
# Make a function to put stuff in the 'series' list, requires seq_along to be used since x is the list/vector index tracker
add_variable_to_series_list<- function(x, series_list, key_vector, value_vector){
base::stopifnot(length(key_vector) == length(value_vector))
base::stopifnot(length(series_list) == length(key_vector))
series_list[[x]][length(series_list[[x]])+1]<- value_vector[x]
names(series_list[[x]])[length(series_list[[x]])]<- key_vector[x]
return(series_list[[x]])
}
## Put the extra stuff in the 'series' list
series2<- lapply(seq_along(series), function(x){ add_variable_to_series_list(x = x, series_list = series, key_vector = kv, value_vector = cols) })
hc<- highcharter::highchart() %>%
highcharter::hc_chart(type="boxplot", inverted=FALSE) %>%
highcharter::hc_title(text="This is a title") %>%
highcharter::hc_legend(enabled=FALSE) %>%
highcharter::hc_xAxis(type="category", categories=c("a", "b", "c"), title=list(text="Some x-axis title")) %>%
highcharter::hc_add_series_list(series2) %>%
hc_plotOptions(series = list(
marker = list(
symbol = "circle"
),
grouping=FALSE
)) %>%
highcharter::hc_colors(cols2) %>%
highcharter::hc_exporting(enabled=TRUE)
hc
This probably could be adjusted to work with a simple dataframe, but I think it will get you what you want for right now without having to do too much extra work. Also, maybe look into list_parse or list_parse2' fromhighcharter...it could probably help with building out theseries` object..I still need to look into that.
Edit:
I have expanded the example to make it work with a regular DF. As per some follow up questions, the colors are set using the viridis palette inside the make_highchart_boxplot_with_colored_factors function. If you want to allow your own palette and colors, you could expose those arguments and just include them as parameters inside the function call. The expanded example borrows how to add outliers from the highcharter library (albeit in a hacky way) and then builds everything else up from scratch. Hopefully this helps clarify my previous answer. Please note, I could probably also clean up the if condition to make it a little more brief, but I kept it verbose for illustrative purposes.
Double Edit: You can now specify a vector of colors for each level of the factor variable
library(highcharter)
library(magrittr)
library(viridisLite)
df = data.frame(cbind(categ = rep(c('a','b','c','d')),value = rnorm(1000)))
df$value<- base::as.numeric(df$value)
add_variable_to_series_list<- function(x, series_list, key_vector, value_vector){
base::stopifnot(length(key_vector) == length(value_vector))
base::stopifnot(length(series_list) == length(key_vector))
series_list[[x]][length(series_list[[x]])+1]<- value_vector[x]
names(series_list[[x]])[length(series_list[[x]])]<- key_vector[x]
return(series_list[[x]])
}
# From highcharter github pages:
hc_add_series_bwpout = function(hc, value, by, ...) {
z = lapply(levels(by), function(x) {
bpstats = boxplot.stats(value[by == x])$stats
outliers = c()
for (y in na.exclude(value[by == x])) {
if ((y < bpstats[1]) | (y > bpstats[5]))
outliers = c(outliers, list(which(levels(by)==x)-1, y))
}
outliers
})
hc %>%
hc_add_series(data = z, type="scatter", ...)
}
gen_key_vector<-function(variable, num_times){
return(rep(variable, num_times))
}
gen_boxplot_series_from_df<- function(value, by,...){
value<- base::as.numeric(value)
by<- base::as.factor(by)
box_names<- levels(by)
z=lapply(box_names, function(x) {
boxplot.stats(value[by==x])$stats
})
tmp<- lapply(seq_along(z), function(x){
var_name_list<- list(box_names[x])
#tmp0<- list(names(df)[x])
names(var_name_list)<- "name"
index<- x-1
tmp<- list(c(index, z[[x]]))
tmp<- list(tmp)
names(tmp)<- "data"
tmp_out<- c(var_name_list, tmp)
#tmp<- list(tmp)
return(tmp_out)
})
return(tmp)
}
# Usage:
#series<- gen_boxplot_series_from_df(value = df$total_value, by=df$asset_class)
## Boxplot function:
make_highchart_boxplot_with_colored_factors<- function(value, by, chart_title="Boxplots",
chart_x_axis_label="Values", show_outliers=FALSE,
boxcolors=NULL, box_line_colors=NULL){
by<- as.factor(by)
box_names_to_use<- levels(by)
series<- gen_boxplot_series_from_df(value = value, by=by)
if(is.null(boxcolors)){
cols<- viridisLite::viridis(n= length(series), alpha = 0.5) # Keeping alpha in here! (COLORS FOR BOXES ARE SET HERE)
} else {
cols<- boxcolors
}
if(is.null(box_line_colors)){
if(base::nchar(cols[[1]])==9){
cols2<- substr(cols, 0,7) # no alpha, pure hex truth, for box lines
} else {
cols2<- cols
}
} else {
cols2<- box_line_colors
}
# Injecting value 'fillColor' into series list
kv<- gen_key_vector(variable = "fillColor", length(series))
series2<- lapply(seq_along(series), function(x){ add_variable_to_series_list(x = x, series_list = series, key_vector = kv, value_vector = cols) })
if(show_outliers == TRUE){
hc<- highcharter::highchart() %>%
highcharter::hc_chart(type="boxplot", inverted=FALSE) %>%
highcharter::hc_title(text=chart_title) %>%
highcharter::hc_legend(enabled=FALSE) %>%
highcharter::hc_xAxis(type="category", categories=box_names_to_use, title=list(text=chart_x_axis_label)) %>%
highcharter::hc_add_series_list(series2) %>%
hc_add_series_bwpout(value = value, by=by, name="Outliers") %>%
hc_plotOptions(series = list(
marker = list(
symbol = "circle"
),
grouping=FALSE
)) %>%
highcharter::hc_colors(cols2) %>%
highcharter::hc_exporting(enabled=TRUE)
} else{
hc<- highcharter::highchart() %>%
highcharter::hc_chart(type="boxplot", inverted=FALSE) %>%
highcharter::hc_title(text=chart_title) %>%
highcharter::hc_legend(enabled=FALSE) %>%
highcharter::hc_xAxis(type="category", categories=box_names_to_use, title=list(text=chart_x_axis_label)) %>%
highcharter::hc_add_series_list(series2) %>%
hc_plotOptions(series = list(
marker = list(
symbol = "circle"
),
grouping=FALSE
)) %>%
highcharter::hc_colors(cols2) %>%
highcharter::hc_exporting(enabled=TRUE)
}
hc
}
# Usage:
tst_box<- make_highchart_boxplot_with_colored_factors(value = df$value, by=df$categ, chart_title = "Some Title", chart_x_axis_label = "Some X Axis", show_outliers = TRUE)
tst_box
# Custom Colors:
custom_colors_with_alpha_in_hex<- paste0(gplots::col2hex(sample(x=colors(), size = length(unique(df$categ)), replace = FALSE)), "80")
tst_box2<- make_highchart_boxplot_with_colored_factors(value = df$value, by=df$categ, chart_title = "Some Title",
chart_x_axis_label = "Some X Axis",
show_outliers = TRUE, boxcolors = custom_colors_with_alpha_in_hex)
tst_box2
tst_box3<- make_highchart_boxplot_with_colored_factors(value = df$value, by=df$categ, chart_title = "Some Title",
chart_x_axis_label = "Some X Axis",
show_outliers = TRUE, boxcolors = custom_colors_with_alpha_in_hex, box_line_colors = "black")
tst_box3
I hope this helps, please let me know if you have any more questions. I'm happy to try to help as best I can.
-nate
Since there's no highcharter answer yet, I give you at least a base solution.
First, your definition of the data frame is somewhat flawed, rather do:
dat <- data.frame(categ=c('a','b','c','d'), value=rnorm(1000))
Now, using boxplot is quite straightforward. border option colors your borders. With option col you also could color the fills.
boxplot(value ~ categ, dat, border=c("#203d7d","#a0a0ed","#203d7e","#a0a0ad"), pars=list(outpch=16))
Gives
Note: See this nice solution for further customizations.

Drill Down Maps In R + Shiny

I want to implement drill down heat map of USA.
Something like : Highchart link
But I want to display my own data in the given drill down heat map in
R + shiny.
I am unable to understand how to get my data to work with the given example. I was able to implement the given example on R shiny but I don't know how to get my own data for states and county .
I have data in excel format which I want to show on the maps.
I am relatively new to JS and CSS , I think the challenge is in this only.
I have no knowledge of AJAX , and if it can be implemented without it then it would be great.
Someone suggested me to use JSON file to import my own data , but I cannot do it.
There is now an R package "leafdown" available on github, which provides drilldown functionality. It can be found here: https://hoga-it.github.io/leafdown/index.html.
A basic example:
devtools::install_github("hoga-it/leafdown")
library(leafdown)
library(leaflet)
library(shiny)
library(dplyr)
library(shinyjs)
ger1 <- raster::getData(country = "Germany", level = 1)
ger2 <- raster::getData(country = "Germany", level = 2)
ger2#data[c(76, 99, 136, 226), "NAME_2"] <- c(
"Fürth (Kreisfreie Stadt)",
"München (Kreisfreie Stadt)",
"Osnabrück (Kreisfreie Stadt)",
"Würzburg (Kreisfreie Stadt)"
)
spdfs_list <- list(ger1, ger2)
ui <- shiny::fluidPage(
tags$style(HTML(".leaflet-container {background: #ffffff;}")),
useShinyjs(),
actionButton("drill_down", "Drill Down"),
actionButton("drill_up", "Drill Up"),
leafletOutput("leafdown", height = 600),
)
# Little helper function for hover labels
create_labels <- function(data, map_level) {
labels <- sprintf(
"<strong>%s</strong><br/>%g € per capita</sup>",
data[, paste0("NAME_", map_level)], data$GDP_2014
)
labels %>% lapply(htmltools::HTML)
}
server <- function(input, output) {
my_leafdown <- Leafdown$new(spdfs_list, "leafdown", input)
update_leafdown <- reactiveVal(0)
observeEvent(input$drill_down, {
my_leafdown$drill_down()
update_leafdown(update_leafdown() + 1)
})
observeEvent(input$drill_up, {
my_leafdown$drill_up()
update_leafdown(update_leafdown() + 1)
})
output$leafdown <- renderLeaflet({
update_leafdown()
meta_data <- my_leafdown$curr_data
curr_map_level <- my_leafdown$curr_map_level
if (curr_map_level == 1) {
data <- meta_data %>% left_join(gdp_2014_federal_states, by = c("NAME_1" = "Federal_State"))
} else {
data <- meta_data %>% left_join(gdp_2014_admin_districts, by = c("NAME_2" = "Admin_District"))
}
my_leafdown$add_data(data)
labels <- create_labels(data, curr_map_level)
my_leafdown$draw_leafdown(
fillColor = ~ colorNumeric("Blues", GDP_2014)(GDP_2014),
weight = 2, fillOpacity = 0.8, color = "grey", label = labels,
highlight = highlightOptions(weight = 5, color = "#666", fillOpacity = 0.7)
) %>%
addLegend("topright",
pal = colorNumeric("Blues", data$GDP_2014),
values = data$GDP_2014,
title = "GDP per capita (2014)",
labFormat = labelFormat(suffix = "€"),
opacity = 1
)
})
}
shinyApp(ui, server)

Resources