Espacio de nombres de módulos brillantes fuera de la interfaz de usuario para enlaces de JavaScript

shiny shinybs

Question

Estoy tratando de usar módulos brillantes para volver a utilizar la interfaz de usuario y el código del servidor para presentar tres conjuntos de datos diferentes que comparten la misma presentación.

Encontrarse con un pequeño desafío relacionado con el espacio de nombres cuando se usa la creación de vínculos emergentes modales basados ​​en JavaScript fuera del código UI / servidor.

Aquí está mi código de la aplicación que no funciona:

library(shiny)
library(shinyBS)
library(DT)

df <- data.frame(id = c(''a'', ''b'', ''c''), value = c(1, 2, 3))

on_click_js = "
Shiny.onInputChange(''myLinkName'', ''%s'');
$(''#myModal'').modal(''show'')
"

convert_to_link = function(x) {
  as.character(tags$a(href = "#", onclick = sprintf(on_click_js, x), x))
}
df$id_linked <- sapply(df$id, convert_to_link)
df <- df[, c(''id_linked'', ''value'')]

mySampleUI <- function(id) {
  ns <- NS(id)

  fluidPage(
    mainPanel(
      dataTableOutput(ns(''myDT'')),
      bsModal(id = ''myModal'',
              title = ''My Modal Title'',
              trigger = '''',
              size = ''large'',
              textOutput(ns(''modalDescription''))
      ),
      width = 12
    )
  )
}

ui <- fluidPage(mySampleUI(''myUI''))

myServerFunc <- function(input, output, session, df) {
  output$myDT <- DT::renderDataTable({
    datatable(df, escape = FALSE, selection=''none'')
  })
  output$modalDescription <- renderText({
    sprintf(''My beautiful %s'', input$myLinkName)
  })
}

server <- function(input, output) {
  callModule(myServerFunc, ''myUI'', df)
}

shinyApp(ui = ui, server = server)

Una versión de trabajo mostraría myLinkName con éxito en la parte de descripción del myLinkName emergente modal. El motivo por el que este código no funciona es porque el valor de ID del componente de la interfaz de usuario se crea fuera del código de la UI sin la contención del espacio de nombres. Lo entiendo. Pero no puedo encontrar la forma de volver a trabajar para que coincida el espacio de nombres.

¿Alguna idea / opción?

Answer 1

Creé una aplicación de muestra que agregaría un botón a cada fila de la tabla de datos y, si se presiona, creará una gráfica basada en esa fila. Tenga en cuenta que la fila cliqueada también se registra para su uso posterior y se guarda en una variable llamada SelectedRow() . Avíseme si necesita más aclaración

rm(list = ls())
library(DT)
library(shiny)
library(shinyBS)
library(shinyjs)
library(shinydashboard)

# This function will create the buttons for the datatable, they will be unique
shinyInput <- function(FUN, len, id, ...) {inputs <- character(len)
                                           for (i in seq_len(len)) {
                                             inputs[i] <- as.character(FUN(paste0(id, i), ...))}
                                           inputs
}

ui <- dashboardPage(
  dashboardHeader(title = "Simple App"),
  dashboardSidebar(
    sidebarMenu(id = "tabs",
                menuItem("Menu Item 1", tabName = "one", icon = icon("dashboard"))
    )
  ),
  dashboardBody(
    tabItems(
      tabItem(tabName = "one",h2("Datatable Modal Popup"),
              DT::dataTableOutput(''my_table''),uiOutput("popup")
              )
    )
  )
)

server <- function(input, output, session) {
  my_data <- reactive({
    testdata <- mtcars
    as.data.frame(cbind(View = shinyInput(actionButton, nrow(testdata),''button_'', label = "View", onclick = ''Shiny.onInputChange(/"select_button/",  this.id)'' ),testdata))
  })  
  output$my_table <- DT::renderDataTable(my_data(),selection = ''single'',options = list(searching = FALSE,pageLength = 10),server = FALSE, escape = FALSE,rownames= FALSE)

  # Here I created a reactive to save which row was clicked which can be stored for further analysis
  SelectedRow <- eventReactive(input$select_button,{
    as.numeric(strsplit(input$select_button, "_")[[1]][2])
  })

  # This is needed so that the button is clicked once for modal to show, a bug reported here
  # https://github.com/ebailey78/shinyBS/issues/57
  observeEvent(input$select_button, {
    toggleModal(session, "modalExample", "open")
  })

  output$popup <- renderUI({
    print(input$select_button)
    bsModal("modalExample", "Sample Plot", "", size = "large",
            column(12,renderPlot(plot(rnorm(1:10),type="l",col="red",main = paste0("You selected Row Number: ",SelectedRow())))
                   )
            )
  })
}

shinyApp(ui, server)

Paso 1: genera la tabla con botones

Como puede ver, hay un botón llamado View para cada fila

Paso 2: una vez que se hace clic en el botón, se generará la trama

Tenga en cuenta que el título de la trama cambia en función de la fila clicada