I'm building a shiny app with a leaflet map that updates based on user selection. When I got to working on the labels for shiny, I noticed my performance dropped upon hitting my action button to refresh the map. It takes about 10 seconds

Digging into it, it takes 10 seconds regardless of its rendering 1 point or 3000 points. I've strangely been able to troubleshoot and find that if I remove the HTML function (to render an unformatted label) it instantly renders any number of points upon refresh.

Any ideas why rendering HTML labels takes so much longer than unformatted labels, regardless of the number of points?

global.R

# Packages
library(shiny)
library(sf)
library(leaflet)
library(maps)
library(dplyr)
library(htmltools)

# Initialize Data
print('Read in Data')
df <- read.delim("inst/Sample Data.csv", na.strings="")%>%
  mutate(SurfaceHoleLongitude=as.numeric(substr(SurfaceHoleLongitude,2,length(SurfaceHoleLongitude))))%>%
  filter(is.na(SurfaceHoleLongitude)==FALSE & is.na(SurfaceHoleLatitude)==FALSE)%>%
  filter(SurfaceHoleLongitude!='NA' & SurfaceHoleLatitude!='NA')%>%
  as.data.frame()
print('Create Labels')
df <- df %>%
  mutate(pointlabel=paste0(`Lease.Name`,
                          "<br>", County,", ",State,
                          "<br> Operator: ", Operator,
                          "<br> Customer Name: ", Customer.Name,
                          "<br> Reservoir: ", Reservoir#,
                          # "<br>BOKF Exposure", `BOKF.Exposure`,
                          # "<br>DROI", `CEResults.DROI`,
                          # "<br>Outstanding Percent", `Outstanding Percent`
  ))%>%
  rowwise()%>%
  mutate(pointlabel=HTML(pointlabel))
print('Finished Making Labels')

app.R


# Tabset of hideable filters
parameter_tabs <- tabsetPanel(
  id = "filterTabset",
  type = "hidden",
  tabPanel("Operator",
           selectInput(
             selected = 'BCE Mach III LLC',
             inputId='Filter1', multiple = TRUE, label='Operator',
             choices=df%>%select(Operator)%>%unique()%>%pull())),
  tabPanel("Customer Name", 
           selectInput(
             inputId='Filter2', multiple = TRUE, label='Customer Name',
             choices=df%>%select(Customer.Name)%>%unique()%>%pull())),
  tabPanel("Region", 
           selectInput(
             inputId='Filter3', multiple = TRUE, label='Region',
             choices=df%>%select(Region)%>%unique()%>%pull())),
  tabPanel("County", 
           selectInput(
             inputId='Filter4', multiple = TRUE, label='County',
             choices=df%>%select(County)%>%unique()%>%pull())),
  tabPanel("State", 
           selectInput(
             inputId='Filter5', multiple = TRUE, label='State',
             choices=df%>%select(State)%>%unique()%>%pull())),
  tabPanel("Reservoir", 
           selectInput(
             inputId='Filter6', multiple = TRUE, label='Reservoir',
             choices=df%>%select(Reservoir)%>%unique()%>%pull()))
)

# Define UI for app
ui <- fluidPage(
  
  # App title ----
  titlePanel("Engineering Toolkit"),
  
  # Sidebar layout with input and output definitions ----
  sidebarLayout(
    
    # Sidebar panel for inputs ----
    sidebarPanel(
      
      # Input 1: selectInput to choose a filter to appear in 2nd selectInput ----
      selectInput(
        inputId='FilterFieldSelection',
        label='Filter Field',
        choices=c('Operator','Customer Name','Region','County','State','Reservoir'),
        selected = 'Operator',
        multiple = FALSE#,
        # selectize = TRUE,
        # width = NULL,
        # size = NULL
      ),
      
      # Input 2: Specific selectInput to actually filter data
      parameter_tabs,
      
      # Input 3: Action button to load map
      actionButton('button','Load Map')
      
    ),
    
    # Main panel for displaying outputs ----
    mainPanel(
      
      # Output: Map ----
      leafletOutput("WellMap")
      
    )
  )
)


# Define Server
server <- function(input, output) {
  
  # Reactive (lazy) expression for getting the data subsetted to what the user selected
  filteredData <- reactive({
    df%>%
      # Filtering only occurs if the there is a selection (length>0)
      filter(case_when(length(input$Filter1)>0 ~ Operator      %in% input$Filter1,TRUE~1==1))%>%
      filter(case_when(length(input$Filter2)>0 ~ Customer.Name %in% input$Filter2,TRUE~1==1))%>%
      filter(case_when(length(input$Filter3)>0 ~ Region        %in% input$Filter3,TRUE~1==1))%>%
      filter(case_when(length(input$Filter4)>0 ~ County        %in% input$Filter4,TRUE~1==1))%>%
      filter(case_when(length(input$Filter5)>0 ~ State         %in% input$Filter5,TRUE~1==1))%>%
      filter(case_when(length(input$Filter6)>0 ~ Reservoir     %in% input$Filter6,TRUE~1==1))
    
  })
  
  # Fire this when 1st selectInput "FilterOfFilters" is changed,
  observeEvent(input$FilterFieldSelection, {
    
    # Update choices of 2nd selectInput "SpecificFilter" 
    updateTabsetPanel(inputId = "filterTabset", selected = input$FilterFieldSelection)
      
  })
  
  # Output to UI
  output$WellMap <- 
    
    # Output Leaflet map
    renderLeaflet({
      
      # Draw Map layers (not points)
      counties.sf <- st_as_sf(map("county", plot = FALSE, fill = TRUE))
      counties.latlong<-st_transform(counties.sf,crs = "+init=epsg:4326")
      
      leaflet() %>% 
        addTiles() %>%
        addPolygons(weight=1,fill=FALSE,color='black',data=counties.latlong) %>%
        addCircles(lat= ~SurfaceHoleLatitude,lng= ~SurfaceHoleLongitude,label= ~pointlabel,
          group = 'pointLayer',data=df%>%filter(Operator=='BCE Mach III LLC'),
          radius=0.5,color='red',opacity=0.5,fill=FALSE,stroke = TRUE,weight=5)
      
    }) 
  
  # Perform this only on button press
  observeEvent(input$button,{
    
    # Clear points on map 
    leafletProxy("WellMap", data = filteredData())%>%
      clearGroup('pointLayer')%>%
    # Update map  with Updated Data
      addCircles(lat= ~SurfaceHoleLatitude,lng= ~SurfaceHoleLongitude,
                 group = 'pointLayer',radius=0.5,label= ~pointlabel,
                 color ='red',opacity=0.5,fill=FALSE,stroke = TRUE,weight=5)
      
  })
}

# Run App
shinyApp(ui = ui, server = server)

Shiny Leaflet Slow with HTML Labels

global.R

app.R