I am trying to implement shiny popup as described in this post on shinyBS popup.
My app is wrapped in an observeEvent() based on the Enter key and isolate() to prevent the table from changing as we type the name of cars before pressing Enter key.
The issue is that first time works well and I able to view the popup window, but consecutive searches with different car names and pressing Enter, the pop ups do not work. In fact, after a few attempts, the app greys out.
How to implement these 3 (pop up modal, observe event based on Enter key and isolate to prevent reactivity) in tandem seamlessly?
My code is as below
library(DT)
library(shiny)
library(shinyBS)
library(shinyjs)
library(shinydashboard)
library(tidyverse)
shinyInput <- function(FUN, len, id, ...) {inputs <- character(len)
for (i in seq_len(len)) {
inputs[i] <- as.character(FUN(paste0(id, i), ...))}
inputs
}
mtcarsDf <- mtcars %>%
mutate(car_name = row.names(mtcars)) %>%
select(car_name, cyl, mpg, gear)
ui <- dashboardPage(
dashboardHeader(),
dashboardSidebar(
sidebarMenu(
menuItem("Tab1", tabName = "Tab1", icon = icon("dashboard"))
)),
dashboardBody(
tags$script('
$(document).on("keyup", function(e) {
if(e.keyCode == 13){
Shiny.onInputChange("keyPressed", Math.random());
}
});
'),
tabItems(
tabItem(tabName = "Tab1",
div("try typing mazda, ferrari, volvo, camaro,
lotus, maserati, porsche, fiat, dodge, toyota, honda, merc"),
textInput("name", "Car Name"),
uiOutput("popup1"),
DT::dataTableOutput('table1'))
)))
server <- function(input, output, session) {
observeEvent(input[["keyPressed"]], {
data <- reactive({
if (input$name != "") {
reactiveDf <- reactive({
if (input$name != "") {
mtcarsDf <- mtcarsDf %>%
filter(grepl(input$name, car_name, ignore.case = TRUE))
}
})
testdata <- reactiveDf()
as.data.frame(cbind(View = shinyInput(actionButton, nrow(testdata),
'button_', label = "View",
onclick = 'Shiny.onInputChange(\"select_button\", this.id)' ),
testdata))
}
})
isolate(data <- data())#### this is required to avoid the table changing as we type the name
output$table1 <- DT::renderDataTable(data,
selection = 'single',
options = list(searching = FALSE,pageLength = 10),
server = FALSE, escape = FALSE,rownames= FALSE)
SelectedRow <- eventReactive(input$select_button,{
as.numeric(strsplit(input$select_button, "_")[[1]][2])
})
observeEvent(input$select_button, {
toggleModal(session, "modal1", "open")
})
DataRow <- eventReactive(input$select_button,{
data[SelectedRow(),2:ncol(data)]
})
output$popup1 <- renderUI({
bsModal("modal1", paste0("Data for Row Number: ",SelectedRow()), "", size = "large",
column(12,
DT::renderDataTable(DataRow())
))
})
})
}
shinyApp(ui, server)
library(shiny)
library(shinydashboard)
library(sqldf)
library(statquotes)
library(DT)
library(shinyBS)
library(shinyjs)
library(tidyverse)
shinyInput <- function(FUN, len, id, ...) {inputs <- character(len)
for (i in seq_len(len)) {
inputs[i] <- as.character(FUN(paste0(id, i), ...))}
inputs
}
data(quotes)
quotes
ui <- dashboardPage(
dashboardHeader(),
dashboardSidebar(
sidebarMenu(
menuItem("TexSearch", tabName = "Tabs", icon = icon("object-ungroup"))) ),
dashboardBody(
tags$script('
$(document).on("keyup", function(e) {
if(e.keyCode == 13){
Shiny.onInputChange("keyPressed", Math.random());
}
});
'),
shinyjs::useShinyjs(),
#js function to reset a button, variableName is the button name whose value we want to reset
tags$script("Shiny.addCustomMessageHandler('resetInputValue', function(variableName){
Shiny.onInputChange(variableName, null);
});
"),
tabItem(tabName = "Tabs",
fluidRow(
column(width=3,
box(
title="Search ",
solidHeader=TRUE,
collapsible=TRUE,
width=NULL,
div("try typing data, history, visualization, graph, method, value"),
textInput("wordsearch", "Search"))),
column( width=9,
tabBox(
width="100%",
tabPanel("tab1",
uiOutput("quotepopup"),
DT::dataTableOutput('table')
)))))))
server <- function(input, output, session) {
#detach("package:RMySQL", unload=TRUE)
observeEvent(input[["keyPressed"]], {
###get data from sql queries
results <- reactive({
if (input$wordsearch != "") {
searches <- reactive({
if (input$wordsearch != "") {
sqldf(paste0("SELECT qid, topic
FROM quotes
WHERE text LIKE '%",input$wordsearch,"%'"))
}
})
#### add view button
testdata <- searches()
as.data.frame(cbind(View = shinyInput(actionButton, nrow(testdata),
'button_', label = "View",
onclick = 'Shiny.onInputChange(\"select_button\", this.id)' ),
testdata))
}
})
results_ <<- results()
####pass data to datatable
output$table <- DT::renderDataTable(results_,
selection = 'single',
options = list(searching = FALSE,pageLength = 10),
server = FALSE, escape = FALSE,rownames= FALSE)
})
###update modal on clicking view button
observeEvent(input$select_button, {
s <- as.numeric(strsplit(input$select_button, "_")[[1]][2])
rowselected <<- results_[input$table_rows_selected, "qid"]
output$quotepopup <- renderUI({
bsModal(paste('model', s ,sep=''), "Quote Details", "", size = "large",
column(12,
htmlOutput("clickedquotedetails")
# HTML("Hello")
)
)
})
toggleModal(session, paste('model', s ,sep=''), toggle = "Assessment")
session$sendCustomMessage(type = 'resetInputValue', message = "select_button")
})
output$clickedquotedetails <- renderUI({
selectedd <- stringr::str_c(stringr::str_c("'", rowselected, "'"), collapse = ',')
print(rowselected)
print(selectedd)
quotesearch <- reactive({
sqldf(paste0("SELECT *
FROM quotes
WHERE qid IN (",
selectedd,
")"))
})
output = ""
relevantquotes <- quotesearch()
output <-
paste(output,
"<b>Number of quotes: ",
as.character(dim(relevantquotes)[1]),
"</b>.<br/>")
for (i in seq(from = 1,
to = dim(relevantquotes)[1])) {
output <- paste(output,
paste("qid: ", relevantquotes[i, "qid"]),
sep = "<br/><br/>")
output <- paste(output,
paste("topic: ", relevantquotes[i, "topic"]),
sep = "<br/><br/>")
output <- paste(output,
paste("text: ", relevantquotes[i, "text"]),
sep = "<br/><br/><br/>")
}
HTML(output)
})
#end of observe ENTER event
}
shinyApp(ui, server)
Just copy paste this code..😉