переделать идентификаторы с блестящими js после обновления чекбоксов

Question

Я пытаюсь создать всплывающие окна для блока «дочерних» флажков, чтобы показать пользователю более подробные данные, изначально это работает нормально - я использовал shiny js, чтобы присвоить каждому флажку идентификатор, чтобы я мог сделать всплывающее окно для каждого.

Проблема возникает, потому что у меня также есть список «родительских» флажков, которые контролируют «дочерние» флажки. Когда я управляю «дочерними» полями с «родительскими» (используя UpdateCheckboxGroupInput), сгенерированные идентификаторы исчезают, и поэтому всплывающие окна не могут быть восстановлены.

Я пытался добавьте начальный блестящий js код, который я использовал для создания идентификаторов изначально после того, как я регенерирую флажки, однако это, похоже, не работает. флажка вместо идентификатора, однако 'AddPopover' в настоящее время не принимает ничего, кроме идентификатора (для этого есть запрос на github: https://github.com/ebailey78/shinyBS/issues/124)

Воспроизводимый код ниже:

library(shiny)
library(shinyjs)
library(shinyWidgets)
library(shinyBS)

# create data
numbers <- c(0:99)
parent_label <- c(rep(c(letters[1:10]),10)) 
descriptions <- c()
  for (num in 0:99) {
next_desc <- paste0("Label",num)
  descriptions <- c(descriptions, next_desc)
}

table_for_hover <- data.frame(numbers,descriptions,parent_label)


# force group checkbox to be in a block with many columns rather than one line
inline_check_boxes_test <- 
  list(tags$style(HTML("
                       .multicol { 
                       height: 250px;
                       -webkit-column-count: 3; /* Chrome, Safari, Opera */ 
                       -moz-column-count: 3;    /* Firefox */ 
                       column-count: 3; 
                       -moz-column-fill: auto;
                       -column-fill: auto;
                       } 
                       ")) 
  )



# make child checkboxes
controls_test <-
  list( tags$div(align = 'left', 
                 class = 'multicol',
                 style = "width: 260px",
                 prettyCheckboxGroup(inputId  = 'codes', 
                                     label = "", 
                                     choiceNames  = numbers,
                                     choiceValues = numbers,
                                     selected = numbers,
                                     inline   = FALSE,
                                     fill = TRUE,
                                     shape = "curve",
                                     icon = icon("check"))))

#get id on hover
js <- "
$(document).ready(function(){
$('input').on('mouseover', function(evt){
Shiny.setInputValue('input', evt.target.id);
});
})
"

runApp(list(
ui = fluidPage(
  tags$head(tags$script(HTML(js))),
  shinyjs::useShinyjs(),
  column(2, wellPanel(fluidRow(checkboxGroupInput("parent_sectors",
                                                  label = "Parent sectors",
                                                  choices = unique(table_for_hover$parent_label),
                                                  selected = unique(table_for_hover$parent_label))))),
  column(8,wellPanel(fluidRow(inline_check_boxes_test,
                              fluidRow(column(width = 2,
                                              controls_test))))),
  #-- the line below is superfluous I know, but for some reason all popovers doesn't work properly if it isn't there --#
  bsPopover(id = 'input_4',title = "Title4", content = "Test4", trigger = 'hover'),
  #-- the line above is superfluous I know, but for some reason all popovers doesn't work properly if it isn't there --#
   verbatimTextOutput("input")

),

server = shinyServer(function(input, output, session) {
  #create IDs for child checkboxes
  shinyjs::runjs(HTML('
    var inputs = $(".shiny-options-group").find("input[name=codes]");
                      for(var i = 0; i < inputs.length; i++) {
                      inputs[i].setAttribute("id", "input_" + i);
                      }
                      '))

  # check that hover is working
   output[["input"]] <- renderPrint({
     input[["input"]]
   })


  # add popover 
  observe(
  addPopover(session, id = input[["input"]], 
             title = paste0("Category: ",input[["input"]]),
             content = paste(paste0("Sector: ",table_for_hover[table_for_hover$numbers==as.numeric(sub(".*_", "", input[["input"]])),3]),
                            paste0("Description: ",table_for_hover[table_for_hover$numbers==as.numeric(sub(".*_", "", input[["input"]])),2]),sep = "<br>"),
             trigger = 'hover')
  )



  parent_sectors_reactive <- reactiveValues(lstval = c(), curval = c())

  #update child checkboxes when parents are changed
  observeEvent(input$parent_sectors,{parent_sectors_reactive$lstval <- parent_sectors_reactive$curval;
  parent_sectors_reactive$curval <- input$parent_sectors




  if (length(dplyr::setdiff(parent_sectors_reactive$curval,parent_sectors_reactive$lstval))==1) {

    active_sectors <- parent_sectors_reactive$curval
    previous_sectors <- parent_sectors_reactive$lstval
    new_sectors <- active_sectors[!(active_sectors %in% previous_sectors)]
    active_codes <- input$codes
    new_codes <- table_for_hover$numbers[table_for_hover$parent_label %in% new_sectors]
    active_codes <- c(active_codes,new_codes)

    updateCheckboxGroupInput(session,'codes', choices = table_for_hover$numbers, selected = active_codes)

    ### need to re-insert IDs here ###


  } else if (length(dplyr::setdiff(parent_sectors_reactive$lstval,parent_sectors_reactive$curval))==1){
    active_sectors <- parent_sectors_reactive$curval
    previous_sectors <- parent_sectors_reactive$lstval
    removed_sectors <- previous_sectors[!(previous_sectors %in% active_sectors)]
    active_codes <- input$codes
    removed_codes <- table_for_hover$numbers[table_for_hover$parent_label %in% removed_sectors]
    active_codes <- active_codes[!(active_codes %in% removed_codes)]

    updateCheckboxGroupInput(session,'codes', choices = table_for_hover$numbers, selected = active_codes)

    ### need to re-insert IDs here ###

  }


  })

})))