R Shiny Build Links Between Tabs

R shiny build links between tabs

It is easier to have the click function on the row of the first table. You can add a callback that
looks for a click on the rows of the table. When a click is observed the row index is sent to a shiny reactive input:

library(shiny)

server <- function(input, output) {
output$iris_type <- renderDataTable({
data.frame(Species=paste0("<a href='#filtered_data'>", unique(iris$Species), "</a>"))
},
callback = "function(table) {
table.on('click.dt', 'tr', function() {
Shiny.onInputChange('rows', table.row( this ).index());
tabs = $('.tabbable .nav.nav-tabs li a');
$(tabs[1]).click();
});
}")
output$filtered_data <- renderDataTable({
if(is.null(input$rows)){
iris
}else{
iris[iris$Species %in% unique(iris$Species)[as.integer(input$rows)+1], ]
}
})
}

ui <- shinyUI(fluidPage(
mainPanel(
tabsetPanel(
tabPanel("Iris Type", dataTableOutput("iris_type")),
tabPanel("Filtered Data", dataTableOutput("filtered_data"))
)
)
))

shinyApp(ui = ui, server = server)

Internal link between tabs to specific section in R Shiny app

Using K. Rohde's answer as starting point, their JavaScript was extended by a second argument for the given id and a command, that scrolls to it (document.getElementById(anchorName).scrollIntoView()), allows to move to a certain section within a given tabPanel after switching to it.

library(shiny)

ui = shinyUI(
navbarPage("Header",
tabPanel("Home",
tags$head(tags$script(HTML('
var fakeClick = function(tabName, anchorName) {
var dropdownList = document.getElementsByTagName("a");
for (var i = 0; i < dropdownList.length; i++) {
var link = dropdownList[i];
if(link.getAttribute("data-value") == tabName) {
link.click();
document.getElementById(anchorName).scrollIntoView({
behavior: "smooth"
});
};
}
};
'))),
fluidPage(
span("bring me to end of tab2",
onclick = "fakeClick('Tab2', 'visitme')"))),
tabPanel("Tab2",
"Some Text inside Tab 2.",
div("This is a long div to visualize the redirection",
style = "background-color: gray;
height: 1000px;
width: 100px;"),
div(id = "visitme",
"This is the part where the redirection shall land."),
div("Another long div",
style = "background-color: gray;
height: 1000px;
width: 100px;"))))

server = function(input, output, session){}

runApp(shinyApp(ui, server), launch.browser = TRUE)

R Shiny build links between tabs WITH sidepanels/conditional panel

If I understood your question correct, I guess you can just add "Shiny.onInputChange('dataset', 'Filtered Data');", to your javascript.

Full code:


library(shiny)
library(DT)

server <- function(input, output) {
output$iris_type <- DT::renderDataTable({
datatable(data.frame(Species=paste0("<a href='#filtered_data'",
"alt='",unique(iris$Species),"'",
"onclick=\"",
"tabs = $('.tabbable .nav.nav-tabs li');",
"tabs.each(function() {",
"$(this).removeClass('active')",
"});",
"$(tabs[1]).addClass('active');",
"tabsContents = $('.tabbable .tab-content .tab-pane');",
"tabsContents.each(function() {",
"$(this).removeClass('active')",
"});",
"$(tabsContents[1]).addClass('active');",
"$('#filtered_data').trigger('change').trigger('shown');",
"Shiny.onInputChange('species', getAttribute('alt'));",
"Shiny.onInputChange('dataset', 'Filtered Data');",
"\">",
unique(iris$Species),
"</a>")),
escape = FALSE)
})

output$filtered_data <- DT::renderDataTable({
if(is.null(input$species)){
datatable(iris)
}else{
datatable(iris[iris$Species %in% input$species, ])
}
})
}

ui <- fluidPage(
sidebarLayout(
sidebarPanel(
conditionalPanel(
'input.dataset === "Iris Type"',
helpText("This is the full Iris panel")
),
conditionalPanel(
'input.dataset === "Filtered Data"',
helpText("This is the filtered panel")
),
width = 2
),
mainPanel(
tabsetPanel(
id = 'dataset',
tabPanel("Iris Type", DT::dataTableOutput("iris_type")),
tabPanel("Filtered Data", DT::dataTableOutput("filtered_data"))
)
))
)

shinyApp(ui = ui, server = server)

R shiny build links between apps

Amending my earlier response, (because, agreed, a simpler solution should be available)

Instead, here's a solution built on mining the session object:

if you open the second shiny app via

<a href="http://server.com/app2?Species=setosa">

(change server.com/app2 to your actual link)
then in that second app, include this for the select object:

EDIT: Note, since this relies on the session object, your server function will change from function(input,output) to function(input,output,session)

ui.R:

htmlOutput('selectSpecies')

server.R:

output$selectSpecies <- renderUI({
URLvars <- session$clientData$url_search
# NOTE: the following regex is not one-size-fits-all
# if you use multiple inputs, you'll probably need to adjust it
# also remove special characters, because I want to sanitize our inputs

Species <- gsub('[[:punct:]]','',URLvars)
Species <- sub('^.*Species(.*$)','\\1',URLvars)

selectInput("select", label=h3("Iris Type"), choices=list('setosa', 'versicolor', 'virginica'),
selected=ifelse(Species=="",'setosa',Species), multiple=FALSE)
})

So the session object does contain the portion of the url it was opened with, so it's just a matter of converting that info to a variable we can use.

[Shiny]: Add link to another tabPanel in another tabPanel

This answer is purely JavaScripted, but very minimal, I guess. Since Shiny creates tabs with random number Ids, and does not give access to the Ids it used, this has do be done client-sided. But there is no knowledge of JavaScript needed to implement this to other scenarios. The JavaScript part is just for Copy/Paste and the trigger command is easy to understand.

What did I do? I installed a function, that finds the Navbar link corresponding to the desired tab, and just clicks it. This utility can be added to any element with the "onclick" attribute. There are no special tags (e.g. no "a" tag) required.

The code below should make it easy to customize this solution to fit your needs.

Note: I used the original Code with the box, although it does not have any visual effect.

Code:

library(shiny)
library(shinydashboard)

ui = shinyUI(

navbarPage("Header",
tabPanel("home",
tags$head(tags$script(HTML('
var fakeClick = function(tabName) {
var dropdownList = document.getElementsByTagName("a");
for (var i = 0; i < dropdownList.length; i++) {
var link = dropdownList[i];
if(link.getAttribute("data-value") == tabName) {
link.click();
};
}
};
'))),
fluidPage(
fluidRow(box("this 1st box should lead me to tab1a", onclick = "fakeClick('tab1a')")),
fluidRow(box("this 2nd box should lead me to tab1b", onclick = "fakeClick('tab1b')")),
fluidRow(box("this 2nd box should lead me to tab2", onclick = "fakeClick('tab2')"))
)
),
navbarMenu("tab1",
tabPanel("tab1a", "Some Text inside Tab 1a."),
tabPanel("tab1b", "Some Text inside Tab 1b.")
),

tabPanel("tab2", "Some Text inside Tab 2.")
)
)

server = function(input, output, session){}

runApp(shinyApp(ui, server), launch.browser = TRUE)

Have fun!

Externally link to specific tabPanel in Shiny App

You could add a search query parameter to the URL (eg. href='www.myapp.com?tab=tab2), and in the app that is being linked you would have to add a bit of logic that changes to a specified tab on initialization if the search string is present (eg. look at session$clientData$url_search and if it exists and there's a tab variable, then use updateTabsetPanel() to go to that tab)

navigate to next tab post clicking on link

When adding inputs (like the actionLink) to a datatable you need to bind them manually, here is why.

Please check the following:

library(shiny)
library(shinydashboard)
library(DT)

# UI ---------------------------------------------------------------------

ui <- fluidPage(tabsetPanel(
id = "panels",
tabPanel("A",
p(),
DTOutput("tab")),
tabPanel("B",
h3("Some information"),
tags$li("Item 1"),
tags$li("Item 2"),
actionLink("link_to_tabpanel_a", "Link to panel A")
)
))

# Server ------------------------------------------------------------------

server <- function(input, output, session) {

DF <- data.frame(a = c(1))
DF$b <- HTML('<a id="Iclickehase" class="action-button" href="#">I clicked</a>')

output$tab <- renderDataTable({
datatable(
DF,
escape = FALSE,
selection = 'none',
options = list(
preDrawCallback = JS('function() { Shiny.unbindAll(this.api().table().node()); }'),
drawCallback = JS('function() { Shiny.bindAll(this.api().table().node()); } ')
)
)
})

observeEvent(input$Iclickehase, {
newvalue <- "B"
updateTabItems(session, "panels", newvalue)
})
observeEvent(input$link_to_tabpanel_a, {
newvalue <- "A"
updateTabsetPanel(session, "panels", newvalue)
})
}

shinyApp(ui, server)

share some ui between tabs with different output on shiny

You can use the function observe({}) to link your radioButtons. It will create javascript that watches for changes to the input$variables you reference and then performs an action, like updating the other button choice to match.

library(shiny)
# UI ----------------------------------------------------------
ui <- navbarPage("Navbar!",
tabPanel("Plot", sidebarLayout(sidebarPanel(
radioButtons("yaxis1", "y-axis", c("speed"="speed", "dist"="dist"),
selected = "speed"
)),
mainPanel( plotOutput("plot"),
textOutput("test2")))), # for input checking

tabPanel("Summary", sidebarLayout(sidebarPanel(
radioButtons("yaxis2", "grouping-var", c("speed"="speed", "dist"="dist")
)),
mainPanel(
verbatimTextOutput("summary"),
textOutput("test1")
)))
)
# Server ------------------------------------------
server <- function(input, output, session) {

observe({
x <- input$yaxis1
updateRadioButtons(session, "yaxis2", selected = x)
})

observe({
y <- input$yaxis2
updateRadioButtons(session, "yaxis1", selected = y)
})

output$test1 <- renderPrint({cat("yaxis1", input$yaxis1)})
output$test2 <- renderPrint({cat("yaxis2", input$yaxis2)})
output$plot <- renderPlot({ plot(cars[['speed']], cars[[input$yaxis1]]) })
output$summary <- renderPrint({ summary(cars[[input$yaxis2]]) })
}
shinyApp(ui, server)


Related Topics



Leave a reply



Submit