UI外部用于JavaScript链接的闪亮模块名称空间 [英] Shiny modules namespace outside of UI for javascript links

问题描述

我正在尝试使用闪亮的模块来重复使用UI和服务器代码，以显示共享同一演示文稿的三个不同数据集.

I am trying to use shiny modules to re-use the UI and server code to present off of three different data sets that share the same presentation.

在UI/服务器代码之外使用基于javascript的模式弹出链接创建时，在处理名称空间时遇到了一些挑战.

Running into a bit of a challenge dealing with namespace when using javascript based modal popup link creation outside of the UI / server code.

这是我无法使用的应用代码:

Here is my non-working app code:

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.该代码不起作用的原因是，UI组件ID值是在没有命名空间包含的UI代码外部创建的.我明白了.但是，我无法弄清楚如何对其进行修改以使名称空间匹配.

A working version would successfully display myLinkName in the description portion of the modal pop up. The reason this code does not work is because the UI component ID value is created outside of the UI code without the namespace containment. I get that. But, I am not able to figure out how to re-work it so that the name space matches.

有什么想法/选择吗?

推荐答案

我创建了一个示例应用程序，该应用程序将向数据表的每一行添加一个按钮，如果按下按钮，它将基于该行创建一个绘图.请注意，单击的行也将记录下来以备后用，并保存在名为SelectedRow()的变量中.让我知道您是否需要更多说明

I've created a sample app that would add a button to each row of the datatable and if the button is pressed it will create a plot based on that row. Note that the clicked row is also recorded for later use and saved in a variable called SelectedRow(). Let me know if you need more clarification

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的按钮

As you can see there is a button called View for each row

第2步:单击按钮后，将生成图

请注意，情节的标题会根据所单击的行而更改

Note that the title of the plot changing based on the clicked row

这篇关于UI外部用于JavaScript链接的闪亮模块名称空间的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！