Is there a way to trigger the tab only when the user clicks on action button . Example shown below. So tab2 is hidden, but when the user clicks on action button, the tab should pop up
library(shiny)
ui <- fluidPage(
tabsetPanel(id = "tabs",
tabPanel(value = "tab1", title = "Tab 1",
tableOutput("myTable"),
actionButton("sub","Submit")
),
uiOutput("show_tab1")
# tabPanel(value = "tab2", title = "Tab 2",
# plotOutput("myPlot")
# )
)
)
server <- function(input, output, session) {
observeEvent(input$sub,{
output$show_tab1 <- renderUI({
tabPanel(value = "tab2", title = "Tab 2",
plotOutput("myPlot")
)
})
})
}
shinyApp(ui, server)
Maybe this:
library(shiny)
ui <- fluidPage(
tabsetPanel(id = "tabs",
tabPanel(value = "tab1", title = "Tab 1",
tableOutput("myTable"),
actionButton("sub","Submit")
),
tabPanel(value = "tab2", title = "Tab 2",plotOutput("myPlot"))
)
)
server <- function(input, output, session) {
observe({
hideTab(inputId = "tabs", target = "tab2")
})
observeEvent(input$sub,{
showTab(inputId = "tabs", target = "tab2")
})
}
shinyApp(ui, server)
Related
I have this code:
library(shiny)
library(shinydashboard)
library(shinydashboardPlus)
shinyApp(
ui = dashboardPage(
header = dashboardHeader(userOutput("user")),
sidebar = dashboardSidebar(shinyjs::useShinyjs(),uiOutput("sidebarpanel")),
body = dashboardBody(uiOutput("body")),
title = "DashboardPage"
),
server = function(input, output) {
output$user <- renderUser({
dashboardUser(
name = "Divad Nojnarg",
image = "https://adminlte.io/themes/AdminLTE/dist/img/user2-160x160.jpg",
title = "shinydashboardPlus",
subtitle = "Author",
footer = p("The footer", class = "text-center"),
fluidRow(
actionButton("personalInfo","Personal Info")
)
)
})
observeEvent(input$personalInfo, {
output$body <- renderUI({h4("Personal Info Dahsboard (no menuItem)")})
})
output$sidebarpanel <- renderUI({
sidebarMenu(id="tabs",
menuItem("Dashboard 1", tabName = "dashboard1", icon = icon("dashboard"))
,menuItem("Dashboard 2", tabName = "dashboard2", icon = icon("dashboard"))
)
})
output$body <- renderUI({
tabItems(
tabItem(tabName ="dashboard1",
fluidRow(box(width = 12, h4("Dashboard 1 (menuItem)"))))
,tabItem(tabName ="dashboard2",
fluidRow(box(width = 12, h4("Dashboard 2 (menuItem)"))))
)
})
}
)
I would like to do two things:
First: When I click on "Personal Info" button, then, prevent the menuItem to be shadowed (I assume I need to remove the class "selected" or "active" or something like that)
Second: I want to fix this: After pressing "Personal Info" button, the menuItems do not work:
As already shown in my earlier answer here we can use a hidden menuItem to modify the body content independent from the visibly selected menuItem.
Furthermore, I'd recommend to stop using renderUI in this scenario. In general it is slower to re-render a UI element instead of updating an existing element (here we can switch to the hidden menuItem via updateTabItems - however, this applies also to e.g. using updateSelectInput instead of renderUI({selectInput(...)})). In this context you should also question whether you really need the to create the dashboardUser on the server side.
If you really need a server side generated dashboardSidebar you still should not use renderUI - There are the renderMenu() / sidebarMenuOutput() functions available for this. Please see the related docs here.
library(shiny)
library(shinyjs)
library(shinydashboard)
library(shinydashboardPlus)
shinyApp(
ui = dashboardPage(
header = dashboardHeader(userOutput("user")),
sidebar = dashboardSidebar(shinyjs::useShinyjs(),
sidebarMenu(id="tabs",
menuItem("Tab 1", tabName = "tab1", icon = icon("dashboard")),
menuItem("Tab 2", tabName = "tab2", icon = icon("dashboard")),
hidden(menuItem("Personal Tab", tabName = "personal_tab", icon = icon("dashboard")))
)),
body = dashboardBody(useShinyjs(),
tabItems(
tabItem(tabName ="tab1",
fluidRow(box(width = 12, h4("Tab 1 (menuItem)")))),
tabItem(tabName ="tab2",
fluidRow(box(width = 12, h4("Tab 2 (menuItem)")))),
tabItem(tabName ="personal_tab",
fluidRow(box(width = 12, h4("Personal Info Dahsboard (no menuItem)"))))
)
),
title = "DashboardPage"
),
server = function(input, output, session) {
output$user <- renderUser({
dashboardUser(
name = "Divad Nojnarg",
image = "https://adminlte.io/themes/AdminLTE/dist/img/user2-160x160.jpg",
title = "shinydashboardPlus",
subtitle = "Author",
footer = p("The footer", class = "text-center"),
fluidRow(
actionButton("personalInfo","Personal Info")
)
)
})
observeEvent(input$personalInfo, {
shinydashboard::updateTabItems(session, inputId = "tabs", selected = "personal_tab")
})
}
)
The given R shiny script creates popoup based on clicking of a button in which the text is displayed.
library(shiny)
library(shinyBS)
CR1_BS<-paste("i. This is line 1",
"ii. This is line 2",
"iii. This is line 3", sep = "<br>")
ui <- fluidPage(
actionButton("CR1_S1", "Button"),
bsPopover(id="CR1_S1",title="x",content=CR1_BS ,"right",options =
list(container = "body")))
server <- function(input, output){}
shinyApp(ui, server)
My requirement is to fit the below rpivotTable in the popup upon clicking of the button.
library(rpivotTable)
rpivotTable(mtcars,rows="gear",cols = c("cyl","carb"),width = "100%",
height = "400px")
Something like this do?
rm(list = ls())
library(shiny)
library(shinyBS)
library(rpivotTable)
shinyApp(
ui =
fluidPage(
sidebarLayout(
sidebarPanel(actionButton("CR1_S1", "Button")),
mainPanel(
bsModal("modalExample", "Your Table", "CR1_S1", size = "large",rpivotTableOutput("test"))
)
)
),
server =
function(input, output, session) {
output$test <- rpivotTable::renderRpivotTable({
rpivotTable(mtcars,rows="gear",cols = c("cyl","carb"),width = "100%", height = "400px")
})
}
)
I'd like to display a modal dialog if users click a link. Currently, the modal dialog works if users click on the action button.
Any ideas are appreciated. Thanks.
## app.R ##
server <- function(input, output) {
observeEvent(input$act_guide, {
showModal(modalDialog(
h5("Data Guidelines"),
tags$ol(
tags$li("Must have Resp_ID as the first column, occasion_ID as second and dependent variable as the third"),
tags$li("Must have no missing value in any fields")
), easyClose = TRUE, footer = NULL)
)
})
}
ui <- fluidPage(
h4("Data guidelines"),
br(),
actionButton("act_guide", "Click Here!")
)
shinyApp(ui = ui, server = server)
You can use actionLink instead of actionButton to trigger the pop-up as shown below.
library(shiny)
library(shinyBS)
if(interactive()){
shinyApp(
ui <- fluidPage(
h4("Data guidelines"),
br(),
actionLink(inputId = "link1", label = "Click Here!")
),
server = function(input, output, session){
observeEvent(input$link1, {
showModal(modalDialog(
h5("Data Guidelines"),
tags$ol(
tags$li("Must have Resp_ID as the first column, occasion_ID as second and dependent variable as the third"),
tags$li("Must have no missing value in any fields")
), easyClose = TRUE, footer = NULL)
)
})
}
)
}
An alternate way is to use bsModal inside ui.R to trigger the pop-up as shown below:
library(shiny)
library(shinyBS)
if(interactive()){
shinyApp(
ui <- fluidPage(
h4("Data guidelines"),
br(),
actionLink(inputId = "link1", label = "Click Here!"),
bsModal(id = "modal1", title = "Test Modal", trigger = "link1",
h5("Data Guidelines"),
tags$ol(
tags$li("Must have Resp_ID as the first column, occasion_ID as second and dependent variable as the third"),
tags$li("Must have no missing value in any fields")
), easyClose = TRUE, footer = NULL)
),
server = function(input, output, session){
}
)
}
Is there a built in Shiny attribute that counts the number of times a downloadButton is clicked? I'm not finding it in the function help or web searches. If there's not a built in method how would I go about counting the clicks. Here's a working example:
data <- matrix(1:20, nrow=5)
ui <- fluidPage(title = 'Count Button Clicks',
fluidRow(style = "padding-bottom: 20px;",
column(width=6,
textOutput("actionclickCount"),
br(),
textOutput("downloadclickCount")
),
column(width=6,
actionButton("actionBtn", "Action Button"),
br(),
downloadButton("dwnldBtn", "Download Button")
)
)
)
server <- function(input, output, session) {
output$actionclickCount <- renderText({
paste('Action Button Clicks =',input$actionBtn)
})
output$downloadclickCount <- renderText({
paste('Download Button Clicks =','what variable goes here?')
})
output$dwnldBtn <- downloadHandler(
filename = 'data.csv',
content = function(file){
write.csv(data, file)
},
contentType = 'csv'
)
}
shinyApp(ui = ui, server = server)
I think there is no build-in method. But you could build it yourself.
You can do this by adding a click listener to the button with javascript:
observe({
if(is.null(input$rnd)){
runjs("
var click = 0;
Shiny.onInputChange('rnd', click)
var dwnldBtn = document.getElementById('dwnldBtn')
dwnldBtn.onclick = function() {click += 1; Shiny.onInputChange('rnd', click)};
")
}
})
The output from Shiny.onInputChange('rnd', click) will be accessible in Shiny via input$rnd.
Edit: For multiple buttons you can use:
observe({
for(btn1 in 1:2){
if(is.null(input[[paste0("rnd", btn1)]])){
runjs(
paste0("
var counter", btn1 ,"= 0;
var dwnldBtn = document.getElementById('", paste0("dwnldBtn", btn1), "')
dwnldBtn.onclick = function() {counter", btn1, " +=1; Shiny.onInputChange('", paste0("rnd", btn1), "', counter", btn1,")};
")
)
}
}
})
For a working example see below:
library(shiny)
library(shinyjs)
data <- matrix(1:20, nrow=5)
ui <- fluidPage(title = 'Count Button Clicks',
useShinyjs(),
fluidRow(style = "padding-bottom: 20px;",
column(width=6,
textOutput("actionclickCount"),
br(),
textOutput("downloadclickCount")
),
column(width=6,
actionButton("actionBtn", "Action Button"),
br(),
downloadButton("dwnldBtn", "Download Button")
)
)
)
server <- function(input, output, session) {
output$actionclickCount <- renderText({
paste('Action Button Clicks =',input$actionBtn)
})
output$downloadclickCount <- renderText({
paste('Download Button Clicks =', input$rnd)
})
output$dwnldBtn <- downloadHandler(
filename = 'data.csv',
content = function(file){
write.csv(data, file)
},
contentType = 'csv'
)
observe({
if(is.null(input$rnd)){
runjs("
var click = 0;
Shiny.onInputChange('rnd', click)
var dwnldBtn = document.getElementById('dwnldBtn')
dwnldBtn.onclick = function() {click += 1; Shiny.onInputChange('rnd', click)};
")
}
})
}
runApp(shinyApp(ui = ui, server = server), launch.browser = TRUE)
I would like to hide/show a tabpanel given certain conditions. When selecting "source 2", I would like to hide tab2, but the code that I used have a bug.
If I first selected "source 1", and then clicked "tab2", and changed the data source to "source 2", the "tab2" tabpanel indeed hided, but the content of "tab2" covered the contents of "tab1". How can I remove the resudual of the hided tab? Any thoughts would be highly appreciated.
library(shiny)
library(shinyjs)
runApp(list(
ui = fluidPage(
useShinyjs(),
selectInput('dataSource',h5("Please choose the data source:"), c("source 1", "source 2"), "source 1"),
tabsetPanel(
id = "navbar",
tabPanel(title = "tab1",
value = "tab1",
h1("Tab 1")
),
tabPanel(id="id2", title = "tab2",
value = "tab2",
h1("Tab 2")
)
)
),
server = function(input, output) {
observeEvent(input$dataSource,{
toggle(condition = (input$dataSource !='source 2'), selector = "#navbar li a[data-value=tab2]")
})
}
))
[the bug looks like this][1] [1]: http://i.stack.imgur.com/eOHLS.png
I could reproduce the error on my laptop.
My advice would be to use a renderUI function to create dynamically a tabsetPanel.
library(shiny)
# library(shinyjs)
runApp(list(
ui = fluidPage(
#useShinyjs(),
selectInput('dataSource',h5("Please choose the data source:"), c("source 1", "source 2"), "source 1"),
uiOutput("dynamic")
),
server = function(input, output) {
output$dynamic <- renderUI({
if (input$dataSource == "source 1") {
tabsetPanel(
id = "navbar",
tabPanel(title = "tab1",
value = "tab1",
h1("Tab 1")
),
tabPanel(id="id2", title = "tab2",
value = "tab2",
h1("Tab 2")
)
)
} else {
tabsetPanel(
id = "navbar",
tabPanel(title = "tab1",
value = "tab1",
h1("Tab 1")
)
)
}
})
}
))