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)
Related
Using shiny 1.6.0 and bslib 0.3.0.
This work as expected:
library(shiny)
ui <- navbarPage(
title = "Minimal Example Issue",
id = "tabs",
header = conditionalPanel(
condition = "input.tabs == 'tab_1'",
HTML("Special tab 1")
),
tabPanel("tab_1", "Hello"),
tabPanel("tab_2", "Hi")
)
server <- function(input, output) {}
shinyApp(ui = ui, server = server)
This doesn't as the condition isn't met on selection of tab_1:
library(shiny)
library(bslib)
ui <- page_navbar(
title = "Minimal Example Issue",
id = "tabs",
header = conditionalPanel(
condition = "input.tabs == 'tab_1'",
HTML("Special tab 1")
),
nav("tab_1", "Hello"),
nav("tab_2", "Hi")
)
server <- function(input, output) {}
shinyApp(ui = ui, server = server)
I would like to understand which JS element has replaced the input.tabs in the second example.
upgrading shiny to 1.7.0 (now on CRAN) fix it
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)
})
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")
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)
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()