Блестящее пространство имен модулей вне пользовательского интерфейса для ссылок javascript

Я пытаюсь использовать блестящие модули для повторного использования пользовательского интерфейса и серверного кода для представления трех разных наборов данных, которые используют одну и ту же презентацию.

При выполнении модальных всплывающих ссылок за пределами кода пользовательского интерфейса или сервера возникла небольшая проблема, связанная с пространством имен.

Вот мой нерабочий код приложения:

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)

Рабочая версия будет успешно отображатьсяmyLinkName в части описания модального всплывающего окна. Причина, по которой этот код не работает, заключается в том, что значение идентификатора компонента пользовательского интерфейса создается за пределами кода пользовательского интерфейса без содержания пространства имен. Я понимаю. Но я не могу понять, как его переработать так, чтобы пространство имен совпадало.

Есть идеи / варианты?

Ответы на вопрос(1)

Я создал пример приложения, которое добавит кнопку в каждую строку таблицы данных, и если кнопка будет нажата, она создаст график на основе этой строки. Обратите внимание, что выбранная строка также записывается для последующего использования и сохраняется в переменной с именемSelectedRow(), Дайте мне знать, если вам нужно больше разъяснений

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)

Шаг 1. Создайте таблицу с помощью кнопок

Как вы можете видеть, есть кнопка под названиемView для каждого ряда

Шаг 2: После нажатия кнопки будет создан график

Обратите внимание, что название сюжета меняется в зависимости от строки щелчка

 Gopala26 июл. 2016 г., 15:33
Хотя это очень хорошее усилие, я не хочу делать это таким образом. В любом случае, я понял, что, создавая Shinynamespace в глобальной среде, и используяpaste чтобы связать воедино Javascript ссылку, это путь. Не в восторге от хакерского кода, но, похоже, делает свое дело.ns <- NS('myUI'); Затем,on_click_js = paste("Shiny.onInputChange('", ns('myLinkName'), "', '%s'); $('#myModal').modal('show')", sep = "")
 Jan Stanstrup06 окт. 2017 г., 15:30
Очень полезно для меня. Но это не сработает, если дважды нажать одну и ту же кнопку. Поскольку значение не обновляется, нет ничего, что вызывает показ мод.
 user524920319 нояб. 2018 г., 18:53
@ Гопала, можешь объяснить роль «% s». Мои модули без JS работают, когдаoutput$plot<-renderUI({}) а такжеplotOutput(ns(plot)), Тем не менее, когда я вызываю JS для чтения значения из JS в модуль R, используяShiny.onInputChange.... это не делает, как ожидалось. Потому что теперь plotOutputsomeID-plot, Как ты решил это? Можете ли вы обновить свой ответ на это спасибо

Ваш ответ на вопрос