Zeige Pop-up von Datatable in glänzend mit Teilmenge von anderen Datenrahmen

Question

Ich habe eine glänzende App, die eine Reihe von Produkten abhängig von der Suche anzeigt. Es untergliedert einen großen Datensatz und zeigt mir die Produkte, die ich möchte.

Ich habe einen anderen Datenrahmen, der die Bewertungen der genannten Produkte hat. Ich möchte, dass beim Klicken auf eine bestimmte Zeile die Überprüfungsinformationen in einer anderen Datentabelle angezeigt werden. Die zweite Datentabelle muss auch eine Teilmenge auf der Basis der Katalognummer (hier ist A Spalte.

Alle geschätzt Hilfe.

df1 <- data.frame(A= c("BX002","BX006", "BX008"), 
        B= c("Actin","Tubulin", "GAPDH"), 
        C = c("Mouse","Human", "Human"), 
        D = c("WB","WB", "IHC")) 
df2 <- data.frame(A= c("BX002","BX006", "BX008"), 
       B= c("Actin","Tubulin", "GAPDH"), 
       C = c("5","5", "4"), 
       D = c("Good","Good", "Bad"), 
       E = c("Kidney", "Liver", "Heart")) 

library(shinydashboard) 
library(shiny) 

app <- shinyApp(
     ui = dashboardPage(
          dashboardHeader(      
            title = "Search"), 
          dashboardSidebar(
             sidebarMenu(
               menuItem("Search Product", tabName = "product", icon = icon("search")))), 
          dashboardBody(
          tabItems(
          tabItem("product", 
            fluidPage(
             sidebarLayout(
               sidebarPanel(textInput("name", "Protein name", value = ""), 
                   submitButton("Search")), 
               mainPanel(
                 tabsetPanel(
                   tabPanel("Products", dataTableOutput("table1")))))))))), 



server = shinyServer(function(input, output, session) { 

     output$table1 <- DT::renderDataTable({ 

       validate(need(input$name != "", "Please select a Protein Name")) 

       search <- input$name 
       df <- subset(df1, grepl(search, df1$B, ignore.case = TRUE)==TRUE) 


       datatable(df, escape = FALSE, selection = "single") 

     }) 
       observeEvent(input$table1_rows_selected, 
           { 
             df <- subset(df2, df2$A == input$table1_rows_selected$A) 
             showModal(modalDialog(
               title = "Reviews", 
               df 

            )) 
           }) 


     }) 

)   

ich ein paar Methoden versucht haben, aber kann es nicht funktioniert.

Dies ist mein letzter atempt, ohne Box Popup, nichts keine Fehlermeldung.

beste

Answer 1

ich nahm einige libe Die Formatierung vereinfacht die Neuerstellung.

Dies sollte Ihnen die jist, wie die modalDialog Funktion arbeitet mit DT.

Hier ist ein funktionierendes Beispiel:

library(shiny) 
library(DT) 


ui <- fluidPage(

    textInput('name','Protein Name'), 
    dataTableOutput('table1') 


) 

server <- function(input, output,session) { 

    df1 <- data.frame(A= c("BX002","BX006", "BX008"), 
        B= c("Actin","Tubulin", "GAPDH"), 
        C = c("Mouse","Human", "Human"), 
        D = c("WB","WB", "IHC")) 
    df2 <- data.frame(A= c("BX002","BX006", "BX008"), 
        B= c("Actin","Tubulin", "GAPDH"), 
        C = c("5","5", "4"), 
        D = c("Good","Good", "Bad"), 
        E = c("Kidney", "Liver", "Heart")) 


    tbl1 <- reactive({ 
    if(nchar(input$name)>0){ 

     df1[which(tolower(input$name) == tolower(df1$B)),] 
    } 

    }) 


    output$table1 <- renderDataTable({ 
    if(nchar(input$name)>0){ 
    datatable(tbl1(),selection = 'single') 
    } 

    }) 

    review_tbl <- reactive({ 

    df2[which(df1[input$table1_rows_selected,1]==df2$A),] 

    }) 


    observeEvent(input$table1_rows_selected,{ 

    showModal(
     modalDialog(
     renderDataTable({ 
     review_tbl() 
     }) 

     )) 
}) 



} 

# Run the application 
shinyApp(ui = ui, server = server)