Shiny Module Namespace außerhalb der Benutzeroberfläche für JavaScript-Links

Question

Ich versuche, glänzende Module zu verwenden, um den UI- und Server-Code wiederzuverwenden, um aus drei verschiedenen Datensätzen zu präsentieren, die die gleiche Präsentation teilen.

Ein wenig Herausforderung bei der Verwendung von Namespaces, wenn JavaScript-basierte modale Popup-Link-Erstellung außerhalb des UI/Server-Codes verwendet wird.

Hier ist mein Nicht-Arbeits 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) 

Eine Arbeitsversion erfolgreich myLinkName in der Beschreibung Teil des Modal Pop-up anzeigen würde. Der Grund dafür, dass dieser Code nicht funktioniert, liegt darin, dass der UI-Komponenten-ID-Wert außerhalb des UI-Codes ohne den Namespace Containment erstellt wird. Ich verstehe das. Aber ich bin nicht in der Lage herauszufinden, wie man es überarbeitet, so dass der Namensraum übereinstimmt.

Irgendwelche Ideen/Optionen?

Answer 1

Ich habe eine Beispielanwendung erstellt, die eine Schaltfläche zu jeder Zeile der Datentabelle hinzufügen würde, und wenn die Schaltfläche gedrückt wird, wird ein Diagramm erstellt, das auf dieser Zeile basiert. Beachten Sie, dass die angeklickte Zeile auch für die spätere Verwendung aufgezeichnet und in einer Variablen namens SelectedRow() gespeichert wird. Lassen Sie mich wissen, wenn Sie

mehr Klärungsbedarf

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) 

Schritt 1: Erzeugen Sie die Tabelle mit den Tasten

Wie man dort sehen kann, ist ein Knopf View für jede Zeile

genannt

Schritt 2: Sobald auf die Schaltfläche geklickt wird, wird das Diagramm erstellt

Beachten Sie, dass der Titel des Plots auf der geklickt Reihe basiert Ändern