Show pop up from Datatable in shiny with subset of other dataframe - r

Question

I have a shiny app that displays a number of products depending on the search.
It subsets a large dataset and shows me the products I want that match.
I have another dataframe that has the reviews of said products.
I would like that when a specific row is clicked the review information appears in a different datatable.
The second datatable also needs to be a subset based on the Catalog Number (here is Acolumn.
All help appreciated.
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
))
})
})
)
I have tried a few methods but cant make it work.
This is my last atempt, no box popup, no error message nothing.
best

Answer 1

I took some liberties with your formatting to make it simpler to recreate.
This should give you the jist of how the modalDialogfunction works with DT.
Here's a working example:
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)