We Keep Coding

I need JS code to collapse a box in Shiny/bs4Dash

I try to collapse a box with an action. This code works in shinydashboard how should I change jscode for doing same thing in bs4Dash ? Any idea?
library(shiny)
library(shinydashboard)
library(shinyjs)
jscode <- "
shinyjs.collapse = function(boxid) {
$('#' + boxid).closest('.box').find('[data-widget=collapse]').click();
}
"
ui <- dashboardPage(
dashboardHeader(),
dashboardSidebar(),
dashboardBody(
useShinyjs(),
extendShinyjs(text = jscode, functions = c("collapse")),
actionButton("bt2", "Collapse box2"),
br(), br(),
box(id = "box2", collapsible = TRUE, p("Box 2"))
)
)
server <- function(input, output) {
observeEvent(input$bt2, {
js$collapse("box2")
})
}
shinyApp(ui, server)

bs4Dash lets you do this without any javascript.
observeEvent(input$bt2, {
updateBox('box2', action = 'toggle')
})
App:
library(shiny)
library(bs4Dash)
library(shinyjs)
ui <- dashboardPage(
dashboardHeader(),
dashboardSidebar(),
dashboardBody(
actionButton("bt2", "Collapse box2"),
br(),
br(),
box(
id = "box2",
collapsible = TRUE,
p("Box 2")
)
)
)
server <- function(input, output) {
observeEvent(input$bt2, {
updateBox("box2", action = "toggle")
})
}
shinyApp(ui, server)

R Shiny redirect to two URLs

The Shiny app below redirects to Google as soon as you press the button 'Submit'. I would like a similar app that redirects to two URLs (in sequence). So, for example it would go to "https://www.google.com" first and then to "https://www.stackoverflow.com". Is this possible?
library(shiny)
jscode <- "Shiny.addCustomMessageHandler('mymessage', function(message) { window.location = message;});"
ui <- fluidPage(
tags$head(tags$script(jscode)),
actionButton("submit", "Submit")
)
server <- function(input, output, session) {
observeEvent(input$submit, {
url <- "https://www.google.com"
session$sendCustomMessage("mymessage", url)
})
}
shinyApp(ui,server)

jscode <- "Shiny.addCustomMessageHandler('redirect', function(URLS) {
for (var i = 0; i < URLS.length; i++) {
setTimeout(function() {
var a = document.createElement('a');
a.style.display = 'none';
a.href = URLS[i];
a.target = '_blank';
document.body.appendChild(a);
a.click();
a.remove();
}, i * 500);
}
});"
observeEvent(input$submit, {
urls <- list("https://www.google.com", "https://www.stackoverflow.com")
session$sendCustomMessage("redirect", urls)
})

Embedding javascript file within a shiny app www subdirectory does not work

Seems like shiny cannot recognize my .js file. Question is why?
Inlined js script text runs smoothly:
library(shiny)
header = dashboardHeader(disable = TRUE)
sidebar = dashboardSidebar(disable = TRUE)
body = dashboardBody(
shiny::tags$script(
HTML("document.body.style.backgroundColor = 'skyblue';")),
)
ui = dashboardPage(header = header, sidebar = sidebar, body = body)
server = function(input, output, session){
}
shinyApp(ui, server)
However when i embedd my .js file (myscript.js stored within www subdirectory)
document.body.style.backgroundColor = "skyblue";
$("firstinput").on("keypress", function(){
alert("Pressed");
})
$(document).on('shiny:connected', function(event) {
alert('Connected to the server');
})
...like this:
library(shiny)
header = dashboardHeader(disable = TRUE)
sidebar = dashboardSidebar(disable = TRUE)
body = dashboardBody(
shiny::tags$head(
shiny::tags$script(
src = "myscript.js"
)),
HTML('<input type="button" id="firstinput">')
)
ui = dashboardPage(header = header, sidebar = sidebar, body = body)
server = function(input, output, session){
}
shinyApp(ui, server)
nothing is applied... How comes?

No need of tags$head(). The following works fine.
tags$script(src = "myscript.js")

Is there any way to customize my PDF Output (R Shiny)?

I want to customize my PDF output by :
Centering my data table
Enlarging logo
Writing Data Extraction below the logo
Making the table pretty
I think that we need to work with JavaScript to solve this kind of problem, if anyone knows how to do so, please tell me
Thank you so much for your collaboration!
library(shiny)
library(DT)
library(base64enc)
ui <- fluidPage(
tags$head(
tags$script(src = "https://cdnjs.cloudflare.com/ajax/libs/pdfmake/0.1.53/pdfmake.min.js"),
tags$script(src = "https://cdnjs.cloudflare.com/ajax/libs/pdfmake/0.1.53/vfs_fonts.js")
),
br(),
DTOutput("dtable")
)
server <- function(input, output, session){
output[["dtable"]] <- renderDT({
datatable(
iris[1:5,],
extensions = "Buttons",
options = list(
dom = "Bfrtip",
buttons = list(
list(
extend = "pdfHtml5",
customize = JS(
"function(doc) {",
" doc.content.splice( 1, 0, {",
" margin: [ 0, 0, 0, 12 ],",
" alignment: 'center',",
sprintf(
" image: '%s',",
dataURI(
file = "https://www.r-project.org/logo/Rlogo.png",
mime = "image/png"
)
),
" width: 50",
" })",
"}"
)
)
)
)
)
})
}
shinyApp(ui, server)

How to stop end shiny session by closing the browser

I have a shiny app that I would like to end the session every time, I close the browser. I researched around and most developers proposed adding this snippet on my server.
session$onSessionEnded(function() {
stopApp()
})
A minimal example is provided below;
rm(list=ls())
library(shiny)
doshiny <- function() {
app=shinyApp(
ui = fluidPage(
textInput("textfield", "Insert some text", value = "SomeText")
),
server = function(input, output, session) {
session$onSessionEnded(function() {
stopApp()
})
}
)
runApp(app)
}
openshiny <- function() {
doshiny()
print("Finished.")
}
openshiny()
the problem with this example I keep asking myself where should I place my other the other lines in the server? for instance, if I want to plot a histogram which way do I write my server?
is it
server = function(input, output, session) {
session$onSessionEnded(function() {
hist(data)
stopApp()
})
}
)
or
server = function(input, output, session) {
hist(data)
session$onSessionEnded(function() {
stopApp()
})
}
)
I am just seeking a more working example

If you want to plot your histogram while the session is active, take the second option. As mentioned by #Waldi the first option plots your histogram when the session is ended, and the user will thus never see the histogram. See here an example of the two options:
First option: we never see the table
rm(list=ls())
library(shiny)
doshiny <- function() {
app=shinyApp(
ui = fluidPage(
textInput("textfield", "Insert some text", value = "SomeText"),
dataTableOutput('table')
),
server = function(input, output, session) {
session$onSessionEnded(function() {
output$table <- renderDataTable(iris)
stopApp()
})
}
)
runApp(app)
}
openshiny <- function() {
doshiny()
print("Finished.")
}
openshiny()
Second option: we see the table
rm(list=ls())
library(shiny)
doshiny <- function() {
app=shinyApp(
ui = fluidPage(
textInput("textfield", "Insert some text", value = "SomeText"),
dataTableOutput('table')
),
server = function(input, output, session) {
output$table <- renderDataTable(iris)
session$onSessionEnded(function() {
stopApp()
})
}
)
runApp(app)
}
openshiny <- function() {
doshiny()
print("Finished.")
}
openshiny()