Leaflet legend for addAwesomeMarkers function with icons - r

Is there any way to create a leaflet legend for addAwesomeMarkers function with right colors and icons. For example, in the following map, I would like to create a legend given under the code.
library(leaflet)
IconSet <- awesomeIconList(
ship = makeAwesomeIcon(icon= 'ship', markerColor = 'green', iconColor = 'white', library = "fa"),
pirate = makeAwesomeIcon(icon= 'fire', markerColor = 'blue', iconColor = 'white', library = "fa")
)
# 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
addAwesomeMarkers(icon = ~IconSet[type])
You time and effort to answer is cordially appreciated.

There is a way you can do this, referenced in this answer, and that is by inserting a map control and define the control with html. Unlike the other answer, the icons use css styling to create the image (one element creates the marker shape, the other contains the icon, a div and a span). The images come from the css classes assigned to each element:
the div sets the background color of the marker
the span (or for font-awesome, the <i>), sets the icon and the icons color (though for font-awesome, it doesn't seem that color changes of the icon)
Each icon library uses different classes and slightly different conventions.
Given the method referenced in the other answer, and the properties of the icons, I built a basic function that displays an icon legend.
I did manage to build a function that positions icons from each of the three supported leaflet icon libraries (ion, font-awesome, glyphicon), but each one has slightly different positioning attributes which is still resulting in minor positioning issues for me. In the interest of shorter example code, I've included only positioning for font-awesome, positioning of others follows similar methods. If desired, I can post the version of the function with support for all three.
The function only creates the html, you'll need to place it in a control still (it is basic, a few parameters could easily be added to customize it):
# legend html generator:
markerLegendHTML <- function(IconSet) {
# container div:
legendHtml <- "<div style='padding: 10px; padding-bottom: 10px;'><h4 style='padding-top:0; padding-bottom:10px; margin: 0;'> Marker Legend </h4>"
n <- 1
# add each icon for font-awesome icons icons:
for (Icon in IconSet) {
if (Icon[["library"]] == "fa") {
legendHtml<- paste0(legendHtml, "<div style='width: auto; height: 45px'>",
"<div style='position: relative; display: inline-block; width: 36px; height: 45px' class='awesome-marker-icon-",Icon[["markerColor"]]," awesome-marker'>",
"<i style='margin-left: 8px; margin-top: 11px; 'class= 'fa fa-",Icon[["icon"]]," fa-inverse'></i>",
"</div>",
"<p style='position: relative; top: -20px; display: inline-block; ' >", names(IconSet)[n] ,"</p>",
"</div>")
}
n<- n + 1
}
paste0(legendHtml, "</div>")
}
And, all together with adding the control (note that it takes the names for the legend from the icon list, so I've modified these from your original, but everything else should be the same):
library(leaflet)
# legend html generator:
markerLegendHTML <- function(IconSet) {
# container div:
legendHtml <- "<div style='padding: 10px; padding-bottom: 10px;'><h4 style='padding-top:0; padding-bottom:10px; margin: 0;'> Marker Legend </h4>"
n <- 1
# add each icon for font-awesome icons icons:
for (Icon in IconSet) {
if (Icon[["library"]] == "fa") {
legendHtml<- paste0(legendHtml, "<div style='width: auto; height: 45px'>",
"<div style='position: relative; display: inline-block; width: 36px; height: 45px' class='awesome-marker-icon-",Icon[["markerColor"]]," awesome-marker'>",
"<i style='margin-left: 8px; margin-top: 11px; 'class= 'fa fa-",Icon[["icon"]]," fa-inverse'></i>",
"</div>",
"<p style='position: relative; top: -20px; display: inline-block; ' >", names(IconSet)[n] ,"</p>",
"</div>")
}
n<- n + 1
}
paste0(legendHtml, "</div>")
}
IconSet <- awesomeIconList(
"Regular Ship" = makeAwesomeIcon(icon= 'ship', markerColor = 'green', iconColor = 'white', library = "fa"),
"Pirate Ship" = makeAwesomeIcon(icon= 'fire', markerColor = 'blue', iconColor = 'white', library = "fa")
)
# 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", "Regular Ship"),
c("Regular Ship", "Pirate Ship")
))
)
leaflet(df) %>% addTiles() %>%
addAwesomeMarkers(icon = ~IconSet[type]) %>%
addControl(html = markerLegendHTML(IconSet = IconSet), position = "bottomleft")

Related

Is it possible in R to hide plotly subplots using a dropdown

I am trying generating series of small plotly plots based on a group in a data.frame and then using plotly::subplot() to bind them together. I would like to then use a dropdown filter to only display some of the subplots.
So far (using the plotly docs https://plotly.com/r/map-subplots-and-small-multiples/ and this answer https://stackoverflow.com/a/66205810/1498485) I can create the plots and the buttons and show and hide the contents of the subplots.
But I cannot figure out how to hide/reset the axis so only the selected subplot is displayed. Below is a minimised example of what I am doing.
# create data
df <- expand.grid(group = LETTERS[1:4],
type = factor(c('high','med','low'), levels = c('high','med','low')),
date = seq(as.Date('2020-01-01'), Sys.Date(), 'month')) %>%
mutate(value = abs(rnorm(nrow(.)))) %>%
group_by(group)
# define plot function
create_plots <- function(dat){
legend <- unique(dat$group) == 'A'
plot_ly(dat, x = ~date) |>
add_lines(y = ~value, color = ~type, legendgroup = ~type, showlegend = legend) %>%
add_annotations(
text = ~unique(group),
x = 0.1,
y = 0.9,
yref = "paper",
xref = "paper",
xanchor = "middle",
yanchor = "top",
showarrow = FALSE,
font = list(size = 15)
)
}
# create buttons to filter by group (based on https://stackoverflow.com/a/66205810/1498485)
buttons <- LETTERS[1:4] |>
lapply(function(x){
list(label = x,
method = 'update',
args = list(list(
name = c('high', 'med', 'low'),
visible = unlist(Map(rep, x == LETTERS[1:4], each = 3))
)))
})
# generate subplots
df %>%
do(mafig = create_plots(.)) %>%
subplot(nrows = 2) %>%
layout(
updatemenus = list(
list(y = 0.8,
buttons = buttons))
)
Yes, but as far as I know, you'll have to go beyond the Plotly package. This solution uses the libraries htmltools and shinyRPG. (It is not a Shiny app!)
I don't think that shinyRPG is a cran package. (It wasn't when I obtained it.) To download this package use this.
devtools::install_github("RinteRface/shinyRPG")
I'm using this library to make the selection box. Instead of a dropdown, I used a multiple selection box (you can select one to many plots at the same time).
The first thing I did was comment out the layout options for the plots and assign them to an object.
# generate subplots
so <- df %>%
do(mafig = create_plots(.)) %>%
subplot(nrows = 2) #%>%
# layout(
# updatemenus = list(
# list(y = 0.8,
# buttons = buttons))
# )
The only other change I made to the original subplot object was to change the default height. I used this percentage because the selection box is given 15% of the space (width-wise).
so[["sizingPolicy"]][["defaultHeight"]] <- "80%"
Next is the selection box.
When it comes to the options, I have c(setNames(1:4, LETTERS[1:4])) This reflects as A, B, C, and D in the selection options, because you have that labeled on the graphs. You can change this to anything. The matching names have no bearing on connecting the selection to the plot. However, the values 1:4 do. If you change this, it will impact the selection success.
tagSel <- rpgSelect(
"selectBox",
"Selections:",
c(setNames(1:4, LETTERS[1:4])), # left is values, right is labels
multiple = T)
tagSel$attribs$class <- 'select'
tagSel$children[[2]]$attribs$class <- "mutli-select"
tagSel$children[[2]]$attribs$onchange <- "getOps(this)"
With browsable, I combined the selection box, the Javascript, and the JQuery that connects the selection with the plots visibility, some styling options, and the subplots.
If it seems like a lot, the vast majority is actually for beautification. (That's almost everything in the style tags.)
I added a lot of comments in the JS, but if something's unclear, let me know.
browsable(tagList(list(
tags$head(
tags$script(HTML("function getOps(sel) { /* activate select */
$plts = $('svg g.cartesianlayer').find('g.subplot'); /* find plots */
$labs = $('svg g.infolayer').find('g.annotation'); /* find plot labels */
$plts.addClass('plotter'); /* add opacity to plots */
$labs.addClass('plotter'); /* add opacity to subplot labels */
for(i = 0; i < sel.length; i++) { /* look through options */
opt = sel.options[i];
j = opt.value;
if ( opt.selected ) {
$plts.filter(':nth-child(' + j + ')').removeClass('plotter-inact');
$labs[i].firstChild.classList.remove('plotter-inact');
} else {
$plts.filter(':nth-child(' + j + ')').addClass('plotter-inact');
$labs[i].firstChild.classList.add('plotter-inact');
}
}
}")),
tags$style(".plotter {opacity: 1;}
.plotter-inact {opacity: 0;}
.select {
position: relative; width: 13ch;
border: 2px solid #003b70;
margin: 0 2px; cursor: pointer;
border-radius: 5px; font-size: 1.1em;
text-align: center; line-height: 1.25em;
}
#selectBox {
background-color: #003b70;
width: 10ch; text-align: center;
color: white; font-weight: bold;
line-height: 1.25em;
}
.yaLeft {
position: relative;
float: left; width: 85%;
height: 100vh;
}
.yaRight {
float: right; width: 15%;
}")),
div(div(class = "yaLeft", so),
div(class = "yaRight", tagSel)))))

Can you color an adjacent cell in gt table in r?

a1 and b1 are colored based on their values. I would like a2 to be the same color as a1 and b2 the same color as b1. Is this possible?
library(dplyr)
library(gt)
library(viridis)
set.seed(123)
df <- data.frame(exp = (LETTERS[1:5]),
a1 = sample(x = 1:20, size = 5),
a2 = sample(x = 1:10, size = 5),
b1 = sample(x = 1:20, size = 5),
b2 = sample(x = 1:10, size = 5))
df %>%
gt() %>%
data_color(
columns = c(a1,b1),
colors = scales::col_numeric(
palette = viridis(20, direction = 1, option ="D"), #color from viridis package
domain = NULL)
)
Many thanks!!
My first intuition was to grab the colors for a1 and b1 in the gt object:
But it was not possible to find them there, so
Next I created a vector of the colors like
#install.packages("colourvalues")
library(colourvalues)
colors <- color_values(df$a1)
and wanted to apply it to colors parameter in data_color for column a2
But this is not possible according to this issue https://github.com/rstudio/gt/issues/633.
On the same site #jthomasmock provided a solution with an own html before gt.
But this raised problems according to the text font on dark background, which
I could solve with the help of #stefan here: How to use INLINE HTML to make text white on dark background automatically after setting background from palette
#install.packages("prismatic")
library(dplyr)
library(purrr)
library(gt)
library(viridis)
library(prismatic)
df %>%
mutate(
color = scales::col_numeric(
palette = viridis(20, direction = 1, option ="D"), #color from viridis package
domain = NULL)(a1),
a1 = glue::glue(
'<span style=\"display: inline-block; direction: ltr; border-radius: 5px; padding-right: 2px;',
'color: {prismatic::best_contrast(color, c("white", "black"))}; background-color: {color}; width: 100%\"> {a1} </span>'
),
a1 = map(a1, ~gt::html(as.character(.x))),
a2 = glue::glue(
'<span style=\"display: inline-block; direction: ltr; border-radius: 5px; padding-right: 2px;',
'color: {prismatic::best_contrast(color, c("white", "black"))}; background-color: {color}; width: 100%\"> {a2} </span>'
),
a2 = map(a2, ~gt::html(as.character(.x))),
) %>%
mutate(
color = scales::col_numeric(
palette = viridis(20, direction = 1, option ="D"), #color from viridis package
domain = NULL)(b1),
b1 = glue::glue(
'<span style=\"display: inline-block; direction: ltr; border-radius: 5px; padding-right: 2px;',
'color: {prismatic::best_contrast(color, c("white", "black"))}; background-color: {color}; width: 100%\"> {b1} </span>'
),
b1 = map(b1, ~gt::html(as.character(.x))),
b2 = glue::glue(
'<span style=\"display: inline-block; direction: ltr; border-radius: 5px; padding-right: 2px;',
'color: {prismatic::best_contrast(color, c("white", "black"))};background-color: {color}; width: 100%\"> {b2} </span>'
),
b2 = map(b2, ~gt::html(as.character(.x))),
) %>%
select(-color) %>%
gt()

Displaying multiple dygraphs on a grid in R-Markdown

Following the conversation here, is there a way to organize the output dygraphs in a grid? To Have one or more graph in a row.
The code below would generate 4 dygraphs arranged vertically.
Is there a way to organize them in a 4x4 grid?
I tried using tags$div but it wraps all the graphs in one div.
Is there a way to apply a CSS property such as display: inline-block; to each dygraph widget? or any other better method?
```{r}
library(dygraphs)
library(htmltools)
makeGraphs = function(i){
dygraph(lungDeaths[, i], width = 300, height = 300, group = "lung-deaths")%>%
dyOptions(strokeWidth = 3) %>%
dyRangeSelector(height = 20)
}
lungDeaths <- cbind(mdeaths, fdeaths, ldeaths, mdeaths)
res <- lapply(1:4, makeGraphs )
htmltools::tagList(tags$div(res, style = "width: 620px; padding: 1em; border: solid; background-color:#e9e9e9"))
```
Current output screenshot:
I think I figured it out, not sure its the best solution, but adding a wrapper div with a display:inline-block; property seems to work quite well.
I just added this line to the function that generates each dygraph:
htmltools::tags$div(theGraph, style = "padding:10px; width: 250px; border: solid; background-color:#e9e9e9; display:inline-block;")
so the updated code looks like this:
```{r graphs}
library(dygraphs)
library(htmltools)
makeGraphs = function(i){
theGraph <- dygraph(lungDeaths[, i], width = 400, height = 300, group = "lung-deaths")%>%
dyOptions(strokeWidth = 3) %>%
dyRangeSelector(height = 20)
htmltools::tags$div(theGraph, style = "padding:10px; width: 450px; border: solid; background-color:#e9e9e9; display:inline-block;")
}
lungDeaths <- cbind(mdeaths, fdeaths, ldeaths, mdeaths)
res <- lapply(1:4, makeGraphs )
htmltools::tagList(res)
```
Output Screenshot:

How to customize hover text for plotly boxplots in R

I understand how to customize the hover text for scatter plots in plotly, but box plots do not accept the 'text' attribute. Warning message: 'box' objects don't have these attributes: 'text'. I have over 300 x-axis variables and there are numbered samples(1-50) in two groups(A or B) that I want to plot together in the same box plot, then I'd like to differentiate between the sample numbers and groups through hover text when moving the cursor over outliers. I'd like to have my custom data labels instead of the automatic quartile labels. Is that possible with plotly boxplots?
library(plotly)
library(magrittr)
plot_ly(melt.s.data,
x = ~variable,
y = ~value,
type = 'box',
text = ~paste("Sample number: ", Sample_number,
'<br>Group:', Group)) %>%
layout(title = "Individual distributions at each x")
Here is some sample data showing only 5 x variables (but the code should work when extrapolated to my 300)...
#sample data
set.seed(456)
#Group A
sample.data_a <- data.frame(Class = "red", Group = "A",
Sample_number = seq(1,50,by=1),
x1= rnorm(50,mean=0, sd=.5),
x2= rnorm(50,mean=0.5, sd=1.5),
x3= rnorm(50,mean=5, sd=.1),
x4= rnorm(50,mean=0, sd=3.5),
x5= rnorm(50,mean=-6, sd=.005))
#Group B
sample.data_b <- data.frame(Class = "red", Group = "B",
Sample_number = seq(1,50,by=1),
x1= rnorm(50,mean=0, sd=5.5),
x2= rnorm(50,mean=0.5, sd=7.5),
x3= rnorm(50,mean=5, sd=.01),
x4= rnorm(50,mean=0, sd=.5),
x5= rnorm(50,mean=-6, sd=2.05))
#row Bind groups
sample.data <- rbind(sample.data_a, sample.data_b)
#melting data to have a more graphable format
library(reshape2)
melt.s.data<-melt(sample.data, id.vars=c("Class", "Group","Sample_number"))
The following are similar questions:
Here it seems like it is not possible.
This question is similar, but only wants to add relevant quartile info.
And this question is only about a single point in plotly boxplots.
It's possible with Shiny.
library(plotly)
library(shiny)
library(htmlwidgets)
# Prepare data ----
set.seed(456)
#Group A
sample.data_a <- data.frame(Class = "red", Group = "A",
Sample_number = seq(1,50,by=1),
x1= rnorm(50,mean=0, sd=.5),
x2= rnorm(50,mean=0.5, sd=1.5),
x3= rnorm(50,mean=5, sd=.1),
x4= rnorm(50,mean=0, sd=3.5),
x5= rnorm(50,mean=-6, sd=.005))
#Group B
sample.data_b <- data.frame(Class = "red", Group = "B",
Sample_number = seq(1,50,by=1),
x1= rnorm(50,mean=0, sd=5.5),
x2= rnorm(50,mean=0.5, sd=7.5),
x3= rnorm(50,mean=5, sd=.01),
x4= rnorm(50,mean=0, sd=.5),
x5= rnorm(50,mean=-6, sd=2.05))
#row Bind groups
sample.data <- rbind(sample.data_a, sample.data_b)
#melting data to have a more graphable format
melt.s.data <- reshape2::melt(sample.data,
id.vars=c("Class", "Group", "Sample_number"))
# Plotly on hover event ----
addHoverBehavior <- c(
"function(el, x){",
" el.on('plotly_hover', function(data) {",
" if(data.points.length==1){",
" $('.hovertext').hide();",
" Shiny.setInputValue('hovering', true);",
" var d = data.points[0];",
" Shiny.setInputValue('left_px', d.xaxis.d2p(d.x) + d.xaxis._offset);",
" Shiny.setInputValue('top_px', d.yaxis.l2p(d.y) + d.yaxis._offset);",
" Shiny.setInputValue('dy', d.y);",
" Shiny.setInputValue('dtext', d.text);",
" }",
" });",
" el.on('plotly_unhover', function(data) {",
" Shiny.setInputValue('hovering', false);",
" });",
"}")
# Shiny app ----
ui <- fluidPage(
tags$head(
# style for the tooltip with an arrow (http://www.cssarrowplease.com/)
tags$style("
.arrow_box {
position: absolute;
pointer-events: none;
z-index: 100;
white-space: nowrap;
background: CornflowerBlue;
color: white;
font-size: 13px;
border: 1px solid;
border-color: CornflowerBlue;
border-radius: 1px;
}
.arrow_box:after, .arrow_box:before {
right: 100%;
top: 50%;
border: solid transparent;
content: ' ';
height: 0;
width: 0;
position: absolute;
pointer-events: none;
}
.arrow_box:after {
border-color: rgba(136,183,213,0);
border-right-color: CornflowerBlue;
border-width: 4px;
margin-top: -4px;
}
.arrow_box:before {
border-color: rgba(194,225,245,0);
border-right-color: CornflowerBlue;
border-width: 10px;
margin-top: -10px;
}")
),
div(
style = "position:relative",
plotlyOutput("myplot"),
uiOutput("hover_info")
)
)
server <- function(input, output){
output$myplot <- renderPlotly({
plot_ly(melt.s.data,
type = "box",
x = ~variable, y = ~value,
text = paste0("<b> group: </b>", melt.s.data$Group, "<br/>",
"<b> sample: </b>", melt.s.data$Sample_number, "<br/>"),
hoverinfo = "y") %>%
onRender(addHoverBehavior)
})
output$hover_info <- renderUI({
if(isTRUE(input[["hovering"]])){
style <- paste0("left: ", input[["left_px"]] + 4 + 5, "px;", # 4 = border-width after
"top: ", input[["top_px"]] - 24 - 2 - 1, "px;") # 24 = line-height/2 * number of lines; 2 = padding; 1 = border thickness
div(
class = "arrow_box", style = style,
p(HTML(input$dtext,
"<b> value: </b>", formatC(input$dy)),
style="margin: 0; padding: 2px; line-height: 16px;")
)
}
})
}
shinyApp(ui = ui, server = server)
A possible solution might be using ggplot2 package and adding an invisible scatterplot to your boxplot:
library(ggplot2)
library(plotly)
gg_box <- melt.s.data %>%
ggplot(aes(x=variable, y=value, text=paste("Group:",Group, "\n",
"Class:", Class))) +
geom_boxplot()+
#invisible layer of points
geom_point(alpha = 0)
gg_box %>%
ggplotly()
You need to play a little bit with your cursor to see the additional labels.

Add Icons to Layer Control in Leaflet R

how to add icons to the layer control in package Leaflet R?.
I made icons with the following code:
rojos <- makeAwesomeIcon(icon='ion-waterdrop', library='ion', markerColor = 'red', iconColor = 'white')
verdes <- makeAwesomeIcon(icon='ion-waterdrop', library='ion', markerColor = 'green', iconColor = 'white')
and with the following code I made the map
agua <-leaflet(options = leafletOptions(zoomControl = TRUE,
minZoom = 10, maxZoom = 17,
dragging = TRUE))%>%
addTiles()%>%
setView(-101.145,19.793, 10) %>%
# MAPAS BASE
addProviderTiles(providers$OpenStreetMap.BlackAndWhite, group = "Calles") %>%
addProviderTiles(providers$Esri.WorldImagery, group = "Imagen satelital") %>%
###########################################################################################################
addGeoJSONv2(
jsonlite::toJSON(rojo),
markerType="marker",
markerIcons = rojos,
popupProperty='popup',
labelProperty='NOMBRE DEL CUERPO DE AGUA',
group = "Agua contaminada") %>%
addGeoJSONv2(
jsonlite::toJSON(verde),
markerType="marker",
markerIcons = verdes,
popupProperty='popup',
labelProperty='NOMBRE DEL CUERPO DE AGUA',
group = "Agua no contaminada") %>%
#POLIGONOS
addPolygons(data = cuitzeo, col="green",fillColor="Transparent", group = "Cuenca de Cuitzeo",
weight = 3, opacity = 1)%>%
addPolygons(data = pol_mor, col="#000000",fillColor="Transparent",
group = "Límite Municipal Morelia",
weight = 2, opacity = 1, fillOpacity = .8) %>%
# CONTROL DE CAPAS
addLayersControl(
baseGroups = c("Calles","Imagen satelital"),
overlayGroups = c("Agua contaminada","Agua no contaminada","Cuenca de Cuitzeo","Límite Municipal Morelia"),
options = layersControlOptions(collapsed = F)
)
the result of this is the following:
I would like to get something of this style, but with my icons:
There is a relatively easy way to do this that uses the functionality of leaflet in r and doesn't rely on custom javascript controls: include html tags in your group names.
Instead of naming a group: "Group A", name it:
<div style='position: relative; display: inline-block' class='awesome-marker-icon-blue awesome-marker'>
<i class='glyphicon glyphicon-glass icon-black '></i>
</div>
Group A
You could create this name programmatically fairly easily based on an icon name for example. Only a few things change in each name: the colors, the library (fa, ion, glyphicon), the icon class (eg: fa-glass, ion-checkmark, glyphicon-fire), and the displayed group name.
This approach creates a layer control that looks like what you want:
To make things easier, store the names in a named list/vector and use that to define the groups when appending layers and again when defining which groups should be in the control. Here's a basic example:
library(leaflet)
IconSet <- awesomeIconList(
"Cruise Ship" = makeAwesomeIcon(icon= 'glass', markerColor = 'blue', iconColor = 'black', library = "glyphicon"),
"Pirate Ship" = makeAwesomeIcon(icon= 'fire', markerColor = 'black', iconColor = 'white', library = "glyphicon")
)
# 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", "Cruise Ship"),
c("Cruise Ship", "Pirate Ship")
))
)
# group names:
groups <- c("Cruise Ship" <- "<div style='position: relative; display: inline-block' class='awesome-marker-icon-blue awesome-marker'><i class='glyphicon glyphicon-glass icon-black '></i></div>Cruise Ship",
"Pirate Ship" <- "<div style='position: relative; display: inline-block' class='awesome-marker-icon-black awesome-marker'><i class='glyphicon glyphicon-fire icon-white '></i></div>Pirate Ship")
leaflet(df) %>% addTiles() %>%
addAwesomeMarkers(icon = ~IconSet[type], group=~groups[type]) %>%
addLayersControl(
overlayGroups = groups,
options = layersControlOptions(collapsed = FALSE)
)
Again, if working a few layers, or dynamic layers, it shouldn't be too hard to create a function that takes the icon data and makes a corresponding name to be used later, as opposed to hard coding the names above.
Regardless, this should be usable as a way to implement icons in controls.

Resources