Two errors in dynamic sidebar output when trying to use renderUI() with lapply()

Hello all. I have been struggling for hours attempting to debug this code but have stull come up empty. I receive the error "Warning: Error in :: NA/NaN argument" when the app is ran, and then receive a second error "Warning: Error in $: object of type 'closure' is not subsettable". I am not sure what is causing these errors, and I am not sure how to address them. Any direction that someone could point me in would be of great benefit, thank you.

The code is as follows:

library(tmap)
library(shiny)
library(bs4Dash)
library(fresh)
library(colourpicker)

# theme ----
dark_theme <- create_theme( 
  bs4dash_vars(
    navbar_dark_color = "#bec5cb",
    navbar_dark_active_color = "#FFF",
    navbar_dark_hover_color = "#FFF"
  ),
  bs4dash_yiq(
    contrasted_threshold = 10, 
    text_dark = "#FFF", 
    text_light = "#272c30"
  ),
  bs4dash_layout(main_bg = "#353c42"),
  bs4dash_sidebar_dark(
    bg = "#272c30",
    header_color = '#1F456E', 
    active_color = '#FFF',
    color = "#bec5cb", 
    hover_color = "#FFF",
    submenu_bg = "#FFF", 
    submenu_color = "#FFF", 
    submenu_hover_color = "#FFF"
  ),
  bs4dash_status(dark = "#272c30", info = '#1F456E'),
  bs4dash_color(gray_900 = "#FFF", white = "#272c30")
)

# User Interface ----
ui <- bs4DashPage(
    dark = TRUE,
    freshTheme = dark_theme,
    header = bs4DashNavbar(title = 'layrs'), # page header
    options = list(sidebarExpandOnHover = FALSE), # global page options
    controlbar = bs4DashControlbar(
      fileInput('userData', 'Choose Geospatial Data', # file upload in control bar
                multiple = FALSE,
                accept = c('.geojson', '.kml')),
      actionButton('addLayer', 'Add Layer')), # work in progress -- not functonal
    sidebar = bs4DashSidebar(width = '345px', text = 'layer1', icon = NULL, expandOnHover =  FALSE,
        uiOutput('sidebarLayers')
    ),
    body = bs4DashBody(
        tmapOutput('userMap', height = "1250px") # map output perameters
    )
)

# Server ----
server <- function(input, output, session) {
  layerCount <- reactive(Values(count = 0))
  
  generateAccordion <- function(id) {
    bs4AccordionItem(
      title = paste0("Layer ", id), collapsible = TRUE,
      colourInput(id = paste0('col', id), 'Fill Color', 'purple'),
      colourInput(id = paste0('bcol', id), 'Border Color', 'Black'),
      sliderInput(id = paste0('alpha', id), 'Opacity', min = 0, max = 100, value = 100, step = 0.1),
      numericInput(id = paste0('lwd', id), 'Border Width', value = 1)
      )
  }
  
  observeEvent(input$addLayer, {
    layerCount$count <- layerCount$count + 1
    accordionId <- layerCount$count
    insertUI(
      selector = '#addLayer',
      where = 'afterEnd',
      ui = generateAccordion(accordionId)
      
    )
  })
  
output$sidebarLayers <- renderUI({
  accordions <- lapply(1:layerCount, generateAccordion)
  do.call(accordion, accordions)
})

  output$userMap <- renderTmap({ # render the map
    req(input$userData)
    tm_shape(shp = st_read(input$userData$datapath)) + # reactivity for user inputs
      tm_polygons(col = input$col, border.col = input$bcol, alpha=((input$alpha)/100), lwd = input$lwd)
      })
}

  

shinyApp(ui = ui, server = server)```

I'm not familiar with bs4Dash package, so I can't solve all the problems, but a few errors I spotted are:

Instead of

layerCount <- reactive(Values(count = 0))

you need

layerCount <- reactiveValues(count = 0)

Instead of

colourInput(id = paste0('col', id), 'Fill Color', 'purple'),
colourInput(id = paste0('bcol', id), 'Border Color', 'Black'),
sliderInput(id = paste0('alpha', id), 'Opacity', min = 0, max = 100, value = 100, step = 0.1),
numericInput(id = paste0('lwd', id), 'Border Width', value = 1)

you need

colourInput(inputId = paste0('col', id), 'Fill Color', 'purple'),
colourInput(inputId = paste0('bcol', id), 'Border Color', 'Black'),
sliderInput(inputId = paste0('alpha', id), 'Opacity', min = 0, max = 100, value = 100, step = 0.1),
numericInput(inputId = paste0('lwd', id), 'Border Width', value = 1)

And, finally, instead of

accordions <- lapply(1:layerCount, generateAccordion)

you need

accordions <- lapply(1:layerCount$count, generateAccordion)

There are more errors, but this is as far as I managed to go. The next one is missing id in function accordion, so you might have to re-write this part of the code. I hope this helps.

This topic was automatically closed 54 days after the last reply. New replies are no longer allowed.

If you have a query related to it or one of the replies, start a new topic and refer back with a link.