JavaScriptモジュールのUIの外にある光沢のあるモジュールの名前空間

Question

光沢のあるモジュールを使用して、同じプレゼンテーションを共有する3つの異なるデータセットを表示するためにUIとサーバーコードを再利用しようとしています。

UI /サーバーコードの外で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を表示していました。このコードが機能しない理由は、UIコンポーネントID値が名前空間の包含を伴わずにUIコードの外部で作成されるためです。私はそれを得る。しかし、私は名前空間が一致するようにそれを再加工する方法を理解することができません。

アイデア/オプションはありますか？

Answer 1

私は、データテーブルの各行にボタンを追加するサンプルアプリケーションを作成しました。ボタンを押すと、その行に基づいてプロットが作成されます。クリックされた行は、後で使用するために記録され、という変数に保存されることに注意してください。あなたはより多くの明確化が必要な場合は、私に教えてください

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：ボタンをクリックするとプロットが生成されます

、これは非常に良い取り組みですが、私はそのようにしたくない