It is possible to use a tabPanel id into a link ? I speak of id like #tab-6584-1 or #tab-6985-1 that shows when your cursor is over a tab in a Shiny app running in a browser :
Image of dynamic tabPanel() id example with Firefox
I would like to use this to put a top left link in a Shiny app to redirect on app "home" page.
From your question, I'm not sure, but it seems like you want to mimic navigation to "subpages" in your app. If that's the case, there's a way of doing that in Shiny by reading and writing the value of the hash string at the end of the app's URL (link to gist):
library(shiny)
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
tags$a("Go to Panel 1", href = "#panel1"), br(),
tags$a("Go to Panel 2", href = "#panel2"), br(),
tags$a("Go to Panel 3", href = "#panel3")
),
mainPanel(
tabsetPanel(id = "tabs",
tabPanel("Panel 1", h1("Panel 1"), value = "#panel1"),
tabPanel("Panel 2", h1("Panel 2"), value = "#panel2"),
tabPanel("Panel 3", h1("Panel 3"), value = "#panel3")
)
)
)
)
server <- function(input, output, session) {
# When we change from one `tabPanel` to another, update the URL hash
observeEvent(input$tabs, {
# No work to be done if input$tabs and the hash are already the same
if (getUrlHash() == input$tabs) return()
# The 'push' argument is necessary so that the hash change event occurs and
# so that the other observer is triggered.
updateQueryString(
paste0(getQueryString(), input$tabs),
"push"
)
# Don't run the first time so as to not generate a circular dependency
# between the two observers
}, ignoreInit = TRUE)
# When the hash changes (due to clicking on the link in the sidebar or switching
# between the `tabPanel`s), switch tabs and update an input. Note that clicking
# another `tabPanel` already switches tabs.
observeEvent(getUrlHash(), {
hash <- getUrlHash()
# No work to be done if input$tabs and the hash are already the same
if (hash == input$tabs) return()
valid <- c("#panel1", "#panel2", "#panel3")
if (hash %in% valid) {
updateTabsetPanel(session, "tabs", hash)
}
})
}
shinyApp(ui, server)
Related
I've been able to create a working Shiny app with the datatables searchPanes extension. The problem is that my table is huge, which makes searchPanes go too slow; plus I have the cascadePanes option turned on, which slows down my table row filtering even more. Currently the data processing is done on the client side but I have read that it is more efficient on the server side, therefore I would like to change the configuration of my app to work on the server side.
This link on the datatables website explains how to configure searchPanes with server processing, but I don't know how to apply this information to my shiny application.
I attach a minimal example of my application with the iris data:
library(shiny)
library(DT)
ui <- fluidPage(
DTOutput("table")
)
server <- function(input, output) {
output$table <- renderDT({
datatable(
iris,
class = 'white-space: nowrap cell-border',
extensions = c("SearchPanes", "Select", "Buttons", "Scroller"),
selection = "none", rownames = F, filter = "none",
options = list(
select = "multiple",
scrollY = "497px", scrollCollapse = TRUE, searching = TRUE,
scrollX = FALSE, autoWidth = FALSE,
info = TRUE,
paging = TRUE,
dom = "Brtip",
buttons = list(
# searchPanes button
list(
extend="searchPanes",
config = list(cascadePanes = T,combiner="and")
),
# clear filters button
list(
extend="searchPanes",
text="clear filters",
action=JS(
"function(e, table, node, config){",
" table.searchPanes.clearSelections();",
"}"
)
),
# select all rows
list(
extend='selectAll',
className='selectAll',
text="select all",
action = JS(
"function(e, table, node, config) {",
" table.rows({ search: 'applied'}).deselect();",
" table.rows({ search: 'applied'}).select();",
"}"
)
),
# deselect all rows
"selectNone",
# page length button
"pageLength"
),
language = list(
# show number of active filters in button text
searchPanes = list(collapse = paste("Filter rows: ",'Filters Selected - %d'))
)
)
)
},server = F)
}
shinyApp(ui, server)
I have read this post where the user Kraggle uses the function dataTableProxy() from the DT package, but I don't know how to capture the button input from searchpanes since I have defined it inside a custom button.
I use the package shinyjs to allow the user to reload the page by clicking on "Reload the page" button in Tab 2 and I would like to stay on Tab 2 after reloading the page. But after realoading, the page is taking to Tab1 instead of Tab2
How can we fix it ? This is my code below :
library(shiny)
library(shinyjs)
jscode <- "shinyjs.refresh = function() { history.go(0); }"
ui <- fluidPage(
useShinyjs(),
extendShinyjs(text = jscode, functions = "refresh"),
tabsetPanel(
tabPanel("Tab 1"),
tabPanel("Tab 2", actionButton("mybutton", "Reload the page",
onclick ="javascript:window.location.reload(true)")))
)
server <- function(input, output, session) {
}
shinyApp(ui = ui, server = server)
Some help would be appreciated
You can resort to plain JavaScript. The idea is that you provide an id to tabsetPanel such that you can use updateTabsetPanel in the server.
All you have to do then is to let the reloaded page know that you want to start on the second tab. As a refresh typically resets all of the inputs and reactives (you are aware of that, right?), you cannot use reactives and you have to rely on another way of communication. The query string would be one possibility.
With these ingredients you can:
Write a simple JavaScript function that reloads the page and adds a parameter to the url.
Parse the query string in the server and if the parameter is found, react on it accordingly.
library(shiny)
js <- HTML("
function doReload(tab_index) {
let loc = window.location;
let params = new URLSearchParams(loc.search);
params.set('tab_index', tab_index);
loc.replace(loc.origin + loc.pathname + '?' + params.toString());
}")
ui <- fluidPage(
tags$head(tags$script(js, type ="text/javascript")),
tabsetPanel(
tabPanel("Tab 1", value = "tab1"),
tabPanel("Tab 2", value = "tab2",
actionButton("mybutton", "Reload the page",
onclick = "doReload('tab2')")),
id = "tabsets"
)
)
server <- function(input, output, session) {
observe({
params <- parseQueryString(session$clientData$url_search)
if ("tab_index" %in% names(params)) {
updateTabsetPanel(session, "tabsets", selected = params$tab_index)
}
})
}
shinyApp(ui = ui, server = server)
I am new to R and RShiny. Am building an application to compare two rtf files where a user can choose the two files dynamically. Is there a reactive function that I can use to read an rtf file before I pass it on to renderDiffr? Here is one version of the code I generated but the issue I am having is for these two rtf files I pick under folder1 and folder2 should be passed to renderDiffr below. I am sure there is a simple solution that I am yet to figure out. Would appreciate your help.
library(diffr)
library(shiny)
ui <- fluidPage(
# Main title of the page
titlePanel(HTML("<center>Comparison of two files</center>")),
# Browse buttons to select files
sidebarLayout(position="left",
sidebarPanel(
#fileInput("selectfolder1","Select file from folder 1"),
#fileInput("selectfolder2","Select file from folder 2"),
# Submit button to perform the compare
actionButton("goButton", "Compare", class = "btn-success")
),
mainPanel(
verbatimTextOutput("folder1"),
verbatimTextOutput("folder2"),
diffrOutput("value")
)))
shinyServer(
server <- function(input, output, session){
re1<-reactive({
file1<-file.choose()
})
output$folder1<-renderText({
re1()
})
re2<-reactive({
file2<-file.choose()
})
output$folder2<-renderText({
re2()
})
re3<-reactive({
input$goButton
x<-diffr(folder1,folder2, before="Folder 1",after="Folder 2")
})
output$value<-renderDiffr({
re3()
})
}
)
shinyApp(ui, server)
According to this documentation you pass the result of diffr() to diffrOutput().
What I changed:
When you use a reactive function make sure that you return the result at the end of it. I use return() for clarity (though it's not necessary).
In diffr(folder1,folder2, ...) I used diffr(re1(), re2(), ...) for obvious reasons.
I also skipped the re3 reactive In this sample and used diffr() directly in renderDiffr. But that is merely to reduce complexity.
library(diffr)
library(shiny)
ui <- fluidPage(
# Main title of the page
titlePanel(HTML("<center>Comparison of two files</center>")),
# Browse buttons to select files
sidebarLayout(position="left",
sidebarPanel(
#fileInput("selectfolder1","Select file from folder 1"),
#fileInput("selectfolder2","Select file from folder 2"),
# Submit button to perform the compare
actionButton("goButton", "Compare", class = "btn-success")
),
mainPanel(
verbatimTextOutput("folder1"),
verbatimTextOutput("folder2"),
diffrOutput("FileDiff", width="600px", height="auto")
)))
shinyServer(
server <- function(input, output, session){
re1<-reactive({
file1<-file.choose()
file1
})
output$folder1<-renderText({
re1()
})
re2<-reactive({
file2<-file.choose()
file2
})
output$folder2<-renderText({
re2()
})
# re3<-reactive({
# input$goButton
# x<-diffr(folder1,folder2, before="Folder 1",after="Folder 2")
# return(x)
# })
output$FileDiff <- renderDiffr({
input$goButton
diffr(re1(), re2(), before="Folder 1", after="Folder 2")
})
}
)
shinyApp(ui, server)
I am building a shiny app and I am using two sidebarLayouts. I’m looking for a way to minimize them. I have try put each sidebarLayout into a box.
Example code:
library(shiny)
library(shinyjs)
ui <- fluidPage(
useShinyjs(),
headerPanel("Here goes the heder"),
box(sidebarLayout(
sidebarPanel(textOutput("someinputs")),
mainPanel(textOutput("someoutputs"))),
width = 12,
title = "BB",
collapsible = T,
collapsed = F
)
)
server <- function(input, output) {
output$someinputs <- renderText({
"Here will go the inputs"
})
output$someoutputs <- renderText({
"Here will go the outputs"
})
}
shinyApp(ui, server)
Output:
When I press the collapsible button the Layout does not collapse. Why is this happening? What should I do? Is there other way to do this?
Because you didn't use shinydashboard. The box comes from shinydashboard package. You need to use shinydashboard::dashboardPage instead of fluidPage.
dashboardPage Loads required javascripts and CSS files to toggle the button.
library(shiny)
ui <- shinydashboard::dashboardPage(
shinydashboard::dashboardHeader(),
shinydashboard::dashboardSidebar(),
shinydashboard::dashboardBody(
headerPanel("Here goes the heder"),
shinydashboard::box(
width = 12,
title = "BB",
collapsible = TRUE,
collapsed = FALSE,
sidebarLayout(
sidebarPanel(textOutput("someinputs")),
mainPanel(textOutput("someoutputs")))
)
)
)
If you don't want to use dashboardPage, you can write your own scripts to control the button:
library(magrittr)
library(shiny)
ui <- fluidPage(
headerPanel("Here goes the heder"),
shinydashboard::box(
width = 12,
title = "BB",
collapsible = TRUE,
collapsed = FALSE,
sidebarLayout(
sidebarPanel(textOutput("someinputs")),
mainPanel(textOutput("someoutputs")))
)%>% {.$attribs[['id']] <- 'example-box'; .},
tags$head(tags$script(
"$(document).ready(function(){
$('#example-box button').attr({
'data-toggle':'collapse',
'data-target':'#example-box .box-body',
'aria-expanded':false
})
})"
))
)
I used a hack to assign an ID to the box %>% {.$attribs[['id']] <- 'example-box'; .}, and use some jquery to control the button. Be sure the ID in the script matches the ID you assign in UI, example-box in this case. In javascript, you add # for ID searching, so #example-box.
I wouldn't recommend you to use the second way. You can see in your UI, it's not really a box. It has no border and the button is not at the right place. If you use dashboardPage, you can see the difference.
I'm trying to collapse a box programmatically when an input changes. It seems that I only need to add the class "collapsed-box" to the box, I tried to use the shinyjs function addClass, but I don't know how to do that becuase a box doesn't have an id. Here as simple basic code that can be used to test possible solutions:
library(shinydashboard)
ui <- dashboardPage(
dashboardHeader(),
dashboardSidebar(),
dashboardBody(
box(collapsible = TRUE,p("Test")),
actionButton("bt1", "Collapse")
)
)
server <- function(input, output) {
observeEvent(input$bt1, {
# collapse the box
})
}
shinyApp(ui, server)
I've never tried using boxes before so keep in mind that my answer might be very narrow minded. But I took a quick look and it looks like simply setting the "collapsed-box" class on the box does not actually make the box collapse. So instead my next thought was to actually click the collapse button programatically.
As you said, there isn't an identifier associated with the box, so my solution was to add an id argument to box. I initially expected that to be the id of the box, but instead it looks like that id is given to an element inside the box. No problem - it just means that in order to select the collapse button, we need to take the id, look up the DOM tree to find the box element, and then look back down the DOM tree to find the button.
I hope everything I said makes sense. Even if it doesn't, this code should still work and will hopefully make things a little more clear :)
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 = "collapse"),
actionButton("bt1", "Collapse box1"),
actionButton("bt2", "Collapse box2"),
br(), br(),
box(id = "box1", collapsible = TRUE, p("Box 1")),
box(id = "box2", collapsible = TRUE, p("Box 2"))
)
)
server <- function(input, output) {
observeEvent(input$bt1, {
js$collapse("box1")
})
observeEvent(input$bt2, {
js$collapse("box2")
})
}
shinyApp(ui, server)