Rstudio Crashes after I close the shiny app (using "pool" package) - shiny

I basically have an shiny app like in this example:
library(shiny)
library(DBI)
library(pool)
# create the connection
pool <- dbPool(
drv = RMySQL::MySQL(),
dbname = "shinydemo",
host = "shiny-demo.csa7qlmguqrf.us-east-1.rds.amazonaws.com",
username = "guest",
password = "guest"
)
onStop(function() {
message("closing...")
pool::poolClose(pool)
})
# === UI ====
ui <- fluidPage(
textInput("ID", "Enter your ID:", "5"),
tableOutput("tbl"),
numericInput("nrows", "How many cities to show?", 10),
plotOutput("popPlot")
)
#==== SERVER ====
server <- function(input, output, session) {
output$tbl <- renderTable({
sql <- "SELECT * FROM City WHERE ID = ?id;"
query <- sqlInterpolate(pool, sql, id = input$ID)
dbGetQuery(pool, query)
})
output$popPlot <- renderPlot({
query <- paste0("SELECT * FROM City LIMIT ",
as.integer(input$nrows)[1], ";")
df <- dbGetQuery(pool, query)
pop <- df$Population
names(pop) <- df$Name
barplot(pop)
})
}
#=== Run the App====
shinyApp(ui, server)
And the error has been already asked in this post years ago, but the answer does not solve the issue on my side. (they suggest to get the latest "later" package, but I did and the error remains).
So the error is that: once I click on the Stop bottom on my RStudio Server Session (to stop the shiny App dashboard that runs fine) it does not stop. Instead, a window pop-out appears saying: Terminate R (And no message error appears in the console)
I tried for hours to solve this annoyin behaviour (it makes me recall the system environment variables everytime I restart the Rstudio session) and I found a temporal solution: pressing "Esc" button on the "Console", to Stop the process, avoiding that "Terminate R" pop-out. Then it really stops and I can rerun again the Shiny app. I want to remark that the "Stop" icon (see circle in red, on the attached picture)does not work properly. The "Esc" works instead.
Anybody knows why is this happening? I will also report it in GitHub "pool" issues. Although I am not completely sure if the issue is from the package.
I am using R.4.1.0 (also my connection is to Postgress using a odbc driver, but is not displayed in the code. My session is running in RStudio Workbench 2021.092 (Build 382.pro1). I am ussing "pool" v.0.1.6.

Related

shinyCAPTCHA does not trigger the validation properly

I would like to integrate captcha verification into my shiny app (like this). But it has an unexpected behavior.
If this line:
recaptchaUI("test", sitekey = "6LeIxAcTAAAAAJcZVRqyHh71UMIEGNQ_MXjiZKhI")
is inside the UI, my app works fine (I mean, the validation is triggered when the checkbox and the button are clicked)
However, if it is inside renderUI, the validation is triggered only by clicking the checkbox (there is no need to click the button)
Here is my minimal working example:
library(shiny)
library(shinyCAPTCHA)
ui <- fluidPage(
# With this line, the captcha works perfectly
recaptchaUI("test", sitekey = "6LeIxAcTAAAAAJcZVRqyHh71UMIEGNQ_MXjiZKhI"),
uiOutput("body")
)
server <- function(input, output, session) {
result <- callModule(recaptcha, "test", secret = "6LeIxAcTAAAAAGG-vFI1TnRWxMZNFuojJ4WifJWe")
output$body <- renderUI({
fluidPage(
# Inside renderUI, it does not work properly.
#recaptchaUI("test", sitekey = "6LeIxAcTAAAAAJcZVRqyHh71UMIEGNQ_MXjiZKhI"),
uiOutput("humansOnly")
)
})
output$humansOnly <- renderUI({
req(result()$success)
tags$h1("For human eyes only!")
})
}
shinyApp(ui, server)
I have an app with several modules, that's why I need to use renderUI. What is the error in my code?
I appreciate any help!

Shiny selectInput(multiple = TRUE) problem with mobile devices

I developed a dashboard to monitor covid-19 cases in Brazil using shiny and flexdashboard. It's working fine, but not on mobile devices (at least in some of them). At the sidebar there is a selectinput() with multiple=TRUE, and the problem is that every time the mobile user tries to select a value to update the plots, the screen keyboard is shown and the whole app is realoaded before the selection (for the correct usage the user needs to select the states and click on "Atualizar" button to update).
I tried to solve it by duplicating the siderbar section, and use {.no-mobile} for the first one, and {.mobile) for the second, and using multiple=FALSE in this second selectinput(). Unfortunately it won't work, and both sections were shown overlapping.
I thought about another way (and i don't know how to do it), using something like multiple=ifelse("is mobile test",FALSE,TRUE).
My questions are: Is there a way to test if the browser is mobile? Is there another approach do solve this problem?
Any help will be highly appreciated.
App link (code embed): https://costafilho.shinyapps.io/monitor_covid19/
Github project: https://github.com/sergiocostafh/monitor_covid19
Problematic line:
selectInput("estado",h3("Estados"),choices = est_nome, selected = "Sao Paulo", multiple = TRUE)
Could you try this app on your mobile:
library(shiny)
js <- '
function(){
$(".selectize-input input").attr("readonly", "readonly");
}
'
shinyApp(
ui = fluidPage(
selectizeInput("variable", "Variable:",
c("Cylinders" = "cyl",
"Transmission" = "am",
"Gears" = "gear"),
multiple = TRUE,
options = list(onInitialize = I(js))
),
tableOutput("data")
),
server = function(input, output) {
output$data <- renderTable({
mtcars[, c("mpg", input$variable), drop = FALSE]
}, rownames = TRUE)
}
)
The keyboard should not appear.

shiny app only works on specific browsers / platforms

I have programmed a shiny app in RStudio using R version 3.2.4. The app can be found here: https://koenvandenberge.shinyapps.io/tempConditioning/
Note that there is quite a lot of data to be loaded so it takes a couple of seconds to load.
I have deployed it on my Macbook and it seems as if it only works on Safari and Chromium browsers. It does not seem to work on Chrome or Firefox browsers. With this I mean that the plots which should be generated are not. The drop-down menu is present as it should be, so the app does not crash, but the plots that should be generated by selecting something from the drop-down menu do not.
Is there any way to fix this? You can find the code of my app below:
library(shiny)
library(scales)
load("countMatrix.RData")
countMatrixAllSub = as.data.frame(countMatrix$counts[,-1]) ; rm(countMatrix)
sampleNames = unlist(lapply(strsplit(colnames(countMatrixAllSub),split=".",fixed=TRUE), function(x) x[4]))
sampleNames[28] <- "3c0a"
treat=substr(sampleNames,2,2)
time=substr(sampleNames,3,nchar(sampleNames)-1)
timeC=as.numeric(time)
timeC[timeC==15]=0.25
ui <- shinyUI(fluidPage(
# Application title
titlePanel("Gene expression: conditioning experiment Gust"),
# Sidebar with a
sidebarLayout(
sidebarPanel(
selectInput("gene",
"Pick a gene",
choices = rownames(countMatrixAllSub))
),
# Show a plot of the generated distribution
mainPanel(
plotOutput("genePlot")
)
)
))
# Define server logic required to draw an expression plot
server <- shinyServer(function(input, output) {
output$genePlot <- renderPlot({
par(mar = c(5.1, 4.1, 3, 1))
plot(y=countMatrixAllSub[input$gene,],x=timeC, col=c("black","red")[as.numeric(factor(treat))], pch=19,cex=.6,xaxt="n",xlab="Time", ylab="Expression")
lines(x=unique(timeC[!timeC==0]),y=colMeans(sapply(unique(timeC[!timeC==0]), function(t) as.matrix(countMatrixAllSub[input$gene,treat=="c" & timeC==t]))), col=1)
lines(x=unique(timeC[!timeC==0]),y=colMeans(sapply(unique(timeC[!timeC==0]), function(t) as.matrix(countMatrixAllSub[input$gene,treat=="t" & timeC==t]))), col=2)
axis(1,at=c(0,0.25,1,3,6,9),labels=c("","15m","1h","3h","6h","9h"))
abline(v=c(0,0.25,1,3,6,9),col=alpha("grey",.6))
mtext("Conditioned",side=3, adj=0,col="red")
mtext("Unconditioned",side=3, adj=0.2, col="black")
})
})
# Run the application
shinyApp(ui = ui, server = server)

Disable browsers back button in R shiny App

I am building a shiny app which has a lot of conditional panel. I have a back button in the app itself to navigate between the conditional panel. I would like to disable the web browsers back button as clicking that button goes to previous webpage(away from my app). Is there a way to do this?
You can write some javascript to do this. Here I have two examples, note that I only tested this on Chrome
Example 1 will return a message upon activation of the back button within the browser
rm(list = ls())
library(shiny)
jscode <- 'window.onbeforeunload = function() { return "Please use the button on the webpage"; };'
ui <- basicPage(
mainPanel(tags$head(tags$script(jscode)))
)
server <- function(input, output,session) {}
runApp(list(ui = ui, server = server))
Example 2 will disable navigation altogether. Personally I don't like this method as people might be annoyed that your site doesn't offer standard navigation functionalities
rm(list = ls())
library(shiny)
jscode2 <- "history.pushState(null, null, document.title);
window.addEventListener('popstate', function () {
history.pushState(null, null, document.title);});"
ui <- basicPage(
mainPanel(tags$head(tags$script(jscode2)))
)
server <- function(input, output,session) {}
runApp(list(ui = ui, server = server))

R shiny tab sets simultaneous processing

In my R shiny app, I have many tabPanels in my tabsetPanel.
The charts of a specific tab won't begin to load until I click that tab.
So it takes a long time to just go through the contents of all tabs.
Is there any way to let all tabs process first when the app is launched so all the charts are already there when I go to different tabs?
I created a simple example with two histograms:
server <- function(input, output) {
output$distPlot <- renderPlot({
hist(rnorm(100000000), col = 'darkgray', border = 'white')
})
output$distPlot2 <- renderPlot({
hist(rnorm(100000000), col = 'red', border = 'white')
})
outputOptions(output,"distPlot2",suspendWhenHidden = FALSE)
}
ui <- fluidPage(
tabsetPanel(
tabPanel("1",plotOutput("distPlot")
),
tabPanel("2",plotOutput("distPlot2")
)
)
)
shinyApp(ui = ui, server = server)
I timed the loading of these two histgrams and found that the option suspendWhenHidden = FALSE is not working here. How to fix it?
You can use suspendWhenHidden parameter for shiny::outputOptions to control rendering behavior:
suspendWhenHidden. When ‘TRUE’ (the default), the output
object will be suspended (not execute) when it is hidden on
the web page. When ‘FALSE’, the output object will not
suspend when hidden, and if it was already hidden and
suspended, then it will resume immediately.
If that's not enough you can execute expensive part of you code either when application starts (outside server function), or per user (in server outside render blocks).