Hi I feel like this should be simple but I can't find a solution anywhere.
In the code below I have made the navbarpage collapsible but can't find a way to achieve the same thing for a tabsetpanel so the app ends up looking messy on e.g. a mobile device.
library(shiny)
# Define UI
ui <- fluidPage(
navbarPage("Hello",
collapsible=T,
tabPanel("a",
tabsetPanel(type = "tabs",
tabPanel("1"),
tabPanel("2"),
tabPanel("3"),
tabPanel("4"),
tabPanel("5"))),
tabPanel("b"),
tabPanel("c"),
tabPanel("d"),
tabPanel("e")
)
)
server <- function(session,input, output) {
}
shinyApp(ui = ui, server = server)
Thanks for your help!
You can use the bootstrap-tabcollapse library. Download the js file and put it in the www subfolder.
library(shiny)
js <- "$(document).ready(function(){$('#tabset').tabCollapse();});"
ui <- fluidPage(
tags$head(
tags$style(
HTML(
"a.js-tabcollapse-panel-heading {
display: block;
text-align: center;
}"
)
),
tags$script(src = "bootstrap-tabcollapse.js"),
tags$script(HTML(js))
),
navbarPage("Hello",
collapsible=T,
tabPanel("a",
tabsetPanel(type = "tabs",
tabPanel("1", tags$p("hello")),
tabPanel("2", tags$p("hi")),
tabPanel("3"),
tabPanel("4"),
tabPanel("5"),
id = "tabset")),
tabPanel("b"),
tabPanel("c"),
tabPanel("d"),
tabPanel("e")
)
)
server <- function(session,input, output) {
}
shinyApp(ui = ui, server = server)
Related
The toy app in the example below contains an R/Shiny actionGroupButtons element. I am looking for guidance please on how to start the actionGroupButtons with button ‘btn_edit’ disabled, which can then become enabled on a click of the button ‘btn_enable’.
Button ‘btn_duplicate’ should remain enabled at all times.
#DeanAttali mentions the use of the ‘disabled’ attribute here (Shiny: how to start application with action button disabled?), though I think that it is one of the inputs that it doesn’t work with.
Any ideas please? TIA
library(shiny)
library(shinyWidgets)
library(shinyjs)
ui <- fluidPage(
useShinyjs(),
fluidRow(
actionGroupButtons(
inputIds = c("btn_edit", "btn_duplicate"),
labels = list("Edit", "Duplicate")
)
),
br(),
fluidRow(
actionButton('btn_enable', 'enable edit')
),
br(),
fluidRow(
verbatimTextOutput('btns')
),
br(),
fluidRow(
verbatimTextOutput('btn_enable')
)
)
server <- function(input, output) {
observeEvent((input$btn_edit|input$btn_duplicate),{
output$btns <- renderPrint({paste(input$btn_edit, 'and', input$btn_duplicate)})
})
observeEvent(input$btn_enable,{
output$btn_enable <- renderPrint({input$btn_enable})
if(input$btn_enable > 0) {
shinyjs::enable("btn_edit")
} else {
shinyjs::disable("btn_edit")
}
}, ignoreInit = TRUE)
}
shinyApp(ui = ui, server = server)
You need to set ignoreNULL = FALSE in your observeEvent call, otherwise it will run only after btn_enable was pressed:
library(shiny)
library(shinyWidgets)
library(shinyjs)
ui <- fluidPage(
useShinyjs(),
fluidRow(
actionGroupButtons(
inputIds = c("btn_edit", "btn_duplicate"),
labels = list("Edit", "Duplicate")
)
),
br(),
fluidRow(
actionButton('btn_enable', 'enable edit')
),
br(),
fluidRow(
verbatimTextOutput('btns')
),
br(),
fluidRow(
verbatimTextOutput('btn_enable')
)
)
server <- function(input, output, session) {
observeEvent((input$btn_edit|input$btn_duplicate),{
output$btns <- renderPrint({paste(input$btn_edit, 'and', input$btn_duplicate)})
})
observeEvent(input$btn_enable, {
output$btn_enable <- renderPrint({input$btn_enable})
if(input$btn_enable > 0) {
shinyjs::enable("btn_edit")
} else {
shinyjs::disable("btn_edit")
}
}, ignoreInit = FALSE, ignoreNULL = FALSE)
}
shinyApp(ui = ui, server = server)
Another approach would be to disable the button outside of the observer:
library(shiny)
library(shinyWidgets)
library(shinyjs)
ui <- fluidPage(
useShinyjs(),
fluidRow(
actionGroupButtons(
inputIds = c("btn_edit", "btn_duplicate"),
labels = list("Edit", "Duplicate")
)
),
br(),
fluidRow(
actionButton('btn_enable', 'enable edit')
),
br(),
fluidRow(
verbatimTextOutput('btns')
),
br(),
fluidRow(
verbatimTextOutput('btn_enable')
)
)
server <- function(input, output, session) {
shinyjs::disable("btn_edit")
observeEvent((input$btn_edit|input$btn_duplicate),{
output$btns <- renderPrint({paste(input$btn_edit, 'and', input$btn_duplicate)})
})
observeEvent(input$btn_enable, {
output$btn_enable <- renderPrint({input$btn_enable})
shinyjs::enable("btn_edit")
})
}
shinyApp(ui = ui, server = server)
What I am trying to do is to use an if statement to prevent 'Analyse' button to perform an action twice, I want to disable the button when the button is clicked on one selection once already.
I have simplified the code to isolate the if statement area. Anyone know what's going on here? Thanks
library(shiny)
library(shinyjs)
ui <- fluidPage(
navbarPage(title = "Test",
tabPanel("Home",
sidebarPanel(
actionButton("append", "Analyse")
),
mainPanel()
)
)
)
server <- function(input, output, session) {
observeEvent(input$append,{
disbut<-1
if(disbut==1)
{
disable("append")
}
else {
enable("append")
}
})
}
shinyApp(ui, server)
You have to call useShinyjs() in the ui as shown below.
library(shiny)
library(shinyjs)
ui <- fluidPage(
useShinyjs(),
navbarPage(title = "Test",
tabPanel("Home",
sidebarPanel(
actionButton("append", "Analyse")
),
mainPanel()
)
)
)
server <- function(input, output, session) {
observeEvent(input$append,{
disbut<-1
if(disbut==1)
{
shinyjs::disable("append")
}
else {
shinyjs::enable("append")
}
})
}
shinyApp(ui, server)
You have to initialise shinyjs with useShinyjs()
ui <- fluidPage(
useShinyjs(),
navbarPage(title = "Test",
tabPanel("Home",
sidebarPanel(
actionButton("append", "Analyse")
),
mainPanel()
)
)
)
I am using auth0 package for authentication in shiny. The package contains auth0::logoutButton(). I would like to put these button on the right side of the NavbarPage in Shiny app. Here is a simple app:
library(shiny)
library(markdown)
ui <- navbarPage("Navbar!",
tabPanel("Plot",
sidebarLayout(
sidebarPanel(
radioButtons("plotType", "Plot type",
c("Scatter"="p", "Line"="l")
)
),
mainPanel(
plotOutput("plot")
)
)
),
tabPanel("Summary",
verbatimTextOutput("summary")
)
###
# HERE ADD loginButton() in new panel that will be on the right side for test any actionbutton
###
)
server <- function(input, output, session) {
output$plot <- renderPlot({
plot(cars, type=input$plotType)
})
output$summary <- renderPrint({
summary(cars)
})
output$table <- DT::renderDataTable({
DT::datatable(cars)
})
}
shinyApp(ui = ui, server = server)
You can try with actionbutton instead of loginButton. The solution will be the same.
I'm not sure exactly what the HTML would be for auth0:logoutButton(), but you can add an action button to the upper right side of the navbarPage by adding an HTML script after your last tabPanel like this:
library(shiny)
library(markdown)
ui <- navbarPage("Navbar!",
tabPanel("Plot",
sidebarLayout(
sidebarPanel(
radioButtons("plotType", "Plot type",
c("Scatter"="p", "Line"="l")
)
),
mainPanel(
plotOutput("plot")
)
)
),
tabPanel("Summary",
verbatimTextOutput("summary")
),
tags$script(
HTML("var header = $('.navbar > .container-fluid');
header.append('<div style=\"float:right; padding-top: 8px\"><button id=\"signin\" type=\"button\" class=\"btn btn-primary action-button\" onclick=\"signIn()\">Sign In</button></div>')")
)
)
server <- function(input, output, session) {
output$plot <- renderPlot({
plot(cars, type=input$plotType)
})
output$summary <- renderPrint({
summary(cars)
})
output$table <- DT::renderDataTable({
DT::datatable(cars)
})
}
Note: this code calls an undefined signIn() function, so you would want to alter the onclick behavior to match what you're trying to do.
If you prefer sticking with shiny functions actionButton or actionLink, you may find this helpful:
ui <- navbarPage("Navbar!",
tabPanel("Plot",
sidebarLayout(
sidebarPanel(
radioButtons("plotType", "Plot type",
c("Scatter"="p", "Line"="l")
)
),
mainPanel(
plotOutput("plot")
)
)
),
tabPanel("Summary",
verbatimTextOutput("summary")
),
actionLink("signing", "", icon = icon("sign-in-alt"),
style = "position: absolute; right: 20px; top: -3px")
)
I'm not familiar with auth0 but here's a generic solution. You can add a reactive expression to the server or an onclick argument to actionButton.
library(shiny)
ui <- fluidPage(
style = "padding: 0px;", # no gap in navbar
actionButton("logout", "Log Out", icon = icon("user"),
style = "position: absolute; top: 5px; right: 5px; z-index:10000;"),
navbarPage(
title = "My App",
tabPanel("Panel 1", h1("Hi there"))
)
)
server <- function(input, output, session) {
observeEvent(input$logout, {
# do something
})
}
shinyApp(ui, server)
I have created the following application template in R shiny :
library(shiny)
library(shinyjs)
ui <- fluidPage(
useShinyjs(),
navbarPage("",actionButton("toggleSidebar", "toggle", icon =
icon("database")),
tabPanel("tab",
div( id ="Sidebar",sidebarPanel(
)),mainPanel() ))))
server <-function(input, output, session) {
observeEvent(input$toggleSidebar, {
shinyjs::toggle(id = "Sidebar")
}) }
shinyApp(ui, server)
The App will create a toggle button in the sidebar. The button should appear in the navbar and not above the sidebar. The actual toggle button appears above next to the word tab. It is however, not visible.
The part that is not visible that you mention is in fact the empty title parameter that you have "". Leaving this out as below places the toggle button in the title position:
library(shiny)
library(shinyjs)
ui <- fluidPage(
useShinyjs(),
navbarPage(actionButton("toggleSidebar", "toggle", icon =
icon("database")),
tabPanel("tab",
div( id ="Sidebar",sidebarPanel(
)),mainPanel() )))
server <-function(input, output, session) {
observeEvent(input$toggleSidebar, {
shinyjs::toggle(id = "Sidebar")
}) }
shinyApp(ui, server)
I made an example with multiple tabPanels.
library(shiny)
library(shinyjs)
ui <- fluidPage(
useShinyjs(),
navbarPage(title = tagList("title",actionLink("sidebar_button","",icon = icon("bars"))),
id = "navbarID",
tabPanel("tab1",
div(class="sidebar"
,sidebarPanel("sidebar1")
),
mainPanel(
"MainPanel1"
)
),
tabPanel("tab2",
div(class="sidebar"
,sidebarPanel("sidebar2")
),
mainPanel(
"MainPanel2"
)
)
)
)
server <-function(input, output, session) {
observeEvent(input$sidebar_button,{
shinyjs::toggle(selector = ".sidebar")
})
}
shinyApp(ui, server)
=======================================
I have created a simpler example that does not use the sidepanel class, but I am not sure if it will work in all environments.
library(shiny)
library(shinyjs)
ui <- fluidPage(
useShinyjs(),
navbarPage(title = tagList("title",actionLink("sidebar_button","",icon = icon("bars"))),
tabPanel("tab1",
sidebarPanel("sidebar1"),
mainPanel("MainPanel1")
),
tabPanel("tab2",
sidebarPanel("sidebar2"),
mainPanel("MainPanel2")
)
)
)
server <-function(input, output, session) {
observeEvent(input$sidebar_button,{
shinyjs::toggle(selector = ".tab-pane.active div:has(> [role='complementary'])")
})
}
shinyApp(ui, server)
i need to give flexibility to app user so that they can edit/modify a table . I am using the below codes
UI code:
tabItem(tabName = "manual_override",
fluidRow(
editableDTUI("table1")
Server Codes:
callModule(editableDT,"table1",data=reactive(bigtable),inputwidth=reactive(100))
but the problem is that bigtable has more than 15 columns to display and the horizontal scroll is not appearing
I have tried the same with library(DT) with 20 col.
If that solves your problem.
ui.r
library(shiny)
library(DT)
shinyUI(
fluidPage(
navbarPage("Big file upload + Horizental Scrolling",
tabPanel("Data Import",
fluidRow(
fileInput("file","Upload Your CSV",multiple = FALSE),
column(6,
div(style = 'overflow-x: scroll', DT::dataTableOutput('csv_data')))
)
)
)
)
)
server.r
library(shiny)
shinyServer(function(input, output) {
csv_data_fun<-eventReactive(input$file,{
df<-read.csv(input$file$datapath,
header =TRUE)
return(df)
})
output$csv_data<-DT::renderDataTable({
DT::datatable(csv_data_fun(),rownames = FALSE)%>%formatStyle(columns=colnames(csv_data_fun()),background = 'white',color='black')
})
})
output Screen
Please check whether you want this
I have done with editDT, But this time with default mtcars dataset.
Added the code in UI part
div(style = 'overflow-x: scroll',editableDTUI("table1"))
New Code
library(shiny)
library(editData)
if (interactive()) {
ui <- fluidPage(
textInput("mydata","Enter data name",value="mtcars"),
column(6,
div(style = 'overflow-x: scroll',editableDTUI("table1")
)
)
)
server <- function(input, output) {
df=callModule(editableDT,"table1",dataname=reactive(input$mydata),inputwidth=reactive(170))
output$test=renderPrint({
str(df())
})
}
shinyApp(ui, server)
}
Please check this time if this solves your problem. You can tweak the things to change according to your requirements.
Please accept the answer if solves your issue.