I want to control the position of a DT table output within a tabBox():
This example app gives this:
library(shiny)
library(bs4Dash)
library(DT)
shinyApp(
ui = dashboardPage(
header = dashboardHeader(),
sidebar = dashboardSidebar(),
body = dashboardBody(
tabBox(
id = "tabset1",
height = 750,
tabPanel("Hello", "This is the hello tab",
DT::DTOutput("myTable")
))
)
),
server = function(input, output, session) {
output$myTable <- DT::renderDT({
DT::datatable(
mtcars)
})
}
)
As you can see the DT table is exceeding the borders of tabBox panel. How can we force DT to keep inside tabBox panel (width and height).
Desired output:
You can include in your tabBox the width parameter, in shiny max allowed is 12. Then, your ui part is:
ui = dashboardPage(
header = dashboardHeader(),
sidebar = dashboardSidebar(),
body = dashboardBody(
tabBox(
id = "tabset1",
height = 750,
width = 12,
tabPanel("Hello", "This is the hello tab",
DT::DTOutput("myTable")
))
)
),
That look like this:
Another option its include an horizontal scroll to your tabBox:
shinyApp(
ui = dashboardPage(
header = dashboardHeader(),
sidebar = dashboardSidebar(),
body = dashboardBody(
tabBox(
id = "tabset1",
height = 750,
#width = 12,
tabPanel("Hello", "This is the hello tab",
div(style = 'overflow-x: scroll', DT::dataTableOutput('myTable'))
))
)
),
server = function(input, output, session) {
output$myTable <- DT::renderDT({
DT::datatable(
mtcars)
})
}
)
That look like this:
We can also use scrollX option:
output$myTable <- DT::renderDT({
DT::datatable(
mtcars,
options = list(
scrollX = TRUE
)
)
})
Related
Is it possible to add a common scroll Y for more than one datatables which are side to side?
## app.R ##
library(shiny)
library(shinydashboard)
library(DT)
ui <- dashboardPage(
dashboardHeader(title = "My Chart"),
dashboardSidebar(
width = 0
),
dashboardBody(
column(width = 6,
DT::dataTableOutput("trace_table"),style = "height:500px; overflow-y: scroll;overflow-x: scroll;",
),
column(width = 6,
DT::dataTableOutput("trace_table2"),style = "height:500px; overflow-y: scroll;overflow-x: scroll;",
)
))
server <- function(input, output) {
#Plot for Trace Explorer
output$trace_table <- renderDataTable({
datatable(cbind(mtcars,mtcars), options = list(paging = FALSE))
})
output$trace_table2 <- renderDataTable({
datatable(cbind(mtcars,mtcars), options = list(paging = FALSE))
})
}
shinyApp(ui, server)
ui <- dashboardPage(
dashboardHeader(title = "My Chart"),
dashboardSidebar(
width = 0
),
dashboardBody(
column(
width = 12,
tags$div(
style = "max-height:500px; overflow-y: scroll; overflow-x: scroll;",
splitLayout(
DTOutput("trace_table"),
DTOutput("trace_table2")
)
)
)
)
)
How can I select multiple items in selectInput() when selectize=F?
library(shiny)
library(shinydashboard)
shinyApp(
ui = dashboardPage(
header = dashboardHeader(),
sidebar = dashboardSidebar(),
body = dashboardBody(
uiOutput("box1")
),
title = "DashboardPage"
),
server = function(input, output) {
output$box1<-renderUI({
box(
selectInput(inputId = "in", label = "Choose", choices = c('Short','A very short sentence.'),
selectize = F,multiple=T, size = 5, width = "150px")
)
})
}
)
What you have is allowing multiple selections.
You may see it more clearly if you add this (even if it's temporary)
Add verbatimTextOutput(outputId = "res") after the uiOutput("box1") (don't forget to add a comma) and add output$res <- renderPrint({input$`in`}) after output$box1 in server
library(shiny)
library(shinydashboard)
shinyApp(
ui = dashboardPage(
header = dashboardHeader(),
sidebar = dashboardSidebar(),
body = dashboardBody(
uiOutput("box1"), # comma added here
verbatimTextOutput(outputId = "res") # this is added
),
title = "DashboardPage"
),
server = function(input, output) {
output$box1 <- renderUI({
box(
selectInput(inputId = "in", label = "Choose", choices = c('Short','A very short sentence.'),
selectize = F,multiple=T, size = 5, width = "150px")
)# ends the box
}) # ends output$box1
output$res <- renderPrint({input$`in`}) # this is added here - since 'in' is a keyword I would suggest a different id...
} # ends server call
) # ends shinyApp
I have the shiny dashboard below and I would like to know if I could make the cells of the column Species interactive in a way that if the user clicks on a word of that column ,for example 'setosa', to move to the tab Species.
library(shiny)
library(shinydashboard)
library(shinydashboardPlus)
library(DT)
shinyApp(
ui = dashboardPagePlus(
header = dashboardHeaderPlus(
),
sidebar = dashboardSidebar(),
body = dashboardBody(
tabsetPanel(
tabPanel("Documents",
DTOutput("dt1")),
tabPanel("Species")
)
),
),
server = function(input, output) {
library(readxl)
output$dt1<-renderDT(
iris,filter = "top",
options = list(
pageLength = 5
)
)
}
)
Please check the following:
library(shiny)
library(shinydashboard)
library(shinydashboardPlus)
library(DT)
shinyApp(
ui = dashboardPagePlus(
header = dashboardHeaderPlus(),
sidebar = dashboardSidebar(),
body = dashboardBody(tabsetPanel(
id = "myTabsetPanel",
tabPanel("Documents",
DTOutput("dt1")),
tabPanel("Species")
)),
),
server = function(input, output, session) {
output$dt1 <- renderDT(
iris,
filter = "top",
options = list(pageLength = 5),
selection = list(mode = 'single', target = 'cell')
)
observeEvent(input$dt1_cell_clicked, {
# alternative: input$dt1_cells_selected
if (req(input$dt1_cell_clicked$value) == "setosa") {
updateTabsetPanel(session, inputId = "myTabsetPanel", selected = "Species")
}
})
}
)
Please check the data table "Case Analyses Details" on the right. I want to fit the data table within the box, such that it aligns from right and bottom border in the box, such that we add a horizontal and vertical scroll bar to the DT which can be used to span the rows that overshoot the box.
## app.R ##
library(shiny)
library(shinydashboard)
library(DT)
ui <- dashboardPage(
dashboardHeader(title = "My Chart"),
dashboardSidebar(
width = 0
),
dashboardBody(
box(title = "Data Path", status = "primary",height = "595" ,solidHeader = T,
plotOutput("trace_plot")),
box( title = "Case Analyses Details", status = "primary", height =
"595",width = "6",solidHeader = T,
div(DT::dataTableOutput("trace_table",width = 220)))
))
server <- function(input, output)
{
#Plot for Trace Explorer
output$trace_plot <- renderPlot({
plot(iris$Sepal.Length,iris$Sepal.Width)
})
output$trace_table <- renderDataTable({
mtcars
})
}
shinyApp(ui, server)
Something like this do?
rm(list = ls())
## app.R ##
library(shiny)
library(shinydashboard)
library(DT)
ui <- dashboardPage(
dashboardHeader(title = "My Chart"),
dashboardSidebar(
width = 0
),
dashboardBody(
box(title = "Data Path", status = "primary",height = "595" ,solidHeader = T,
plotOutput("trace_plot")),
box( title = "Case Analyses Details", status = "primary", height =
"595",width = "6",solidHeader = T,
column(width = 12,
DT::dataTableOutput("trace_table"),style = "height:500px; overflow-y: scroll;overflow-x: scroll;"
)
)))
server <- function(input, output) {
#Plot for Trace Explorer
output$trace_plot <- renderPlot({
plot(iris$Sepal.Length,iris$Sepal.Width)
})
output$trace_table <- renderDataTable({
datatable(cbind(mtcars,mtcars), options = list(paging = FALSE))
})
}
shinyApp(ui, server)
This is an old question, but we can also use the dedicated options scrollX and scrollY to add scrollbars to the datatable:
library(shiny)
library(shinydashboard)
library(DT)
ui <- dashboardPage(
dashboardHeader(title = "My Chart"),
dashboardSidebar(
width = 0
),
dashboardBody(
box(title = "Data Path", height = 450,
plotOutput("trace_plot")),
box(title = "Case Analyses Details", height = 450,
DTOutput("trace_table")
))
)
server <- function(input, output) {
output$trace_plot <- renderPlot({
plot(iris$Sepal.Length,iris$Sepal.Width)
})
output$trace_table <- renderDataTable({
datatable(
cbind(mtcars, mtcars),
options = list(
scrollX = TRUE,
scrollY = "250px"
)
)
})
}
shinyApp(ui, server)
I am working in an application similar to one below. I have my input panel in sidebar under a menu which is initally expanded. I want to collapse the menu and hide all the input panel so that my sidebar will be clean. But It should appear when I expand (not permanently hide). I tried the following solution but it is not working. Please help me to find a solution or any alternative approach.
library(shiny)
library(shinydashboard)
library(shinyjs)
ui <- dashboardPage(
header = dashboardHeader(),
sidebar = dashboardSidebar(
sidebarMenu(
menuItem(
startExpanded = TRUE,
"Menu 1",
column(
width = 12,
actionButton("hideMe", label = "Collapse Me", icon = icon("close"))
)
)
)
),
body = dashboardBody()
)
server <- function(input, output, server){
observeEvent(input$hideMe, {
shinyjs::hide(selector = "ul.menu-open");
})
}
runApp(shinyApp(ui, server))
You need to add useShinyjs() into ui part
library(shiny)
library(shinydashboard)
library(shinyjs)
ui <- dashboardPage(
header = dashboardHeader(),
sidebar = dashboardSidebar(
useShinyjs(),
sidebarMenu(
menuItem(
startExpanded = TRUE,
"Menu 1",
column(
width = 12,
actionButton("hideMe", label = "Collapse Me", icon = icon("close"))
)
)
)
),
body = dashboardBody()
)
server <- function(input, output, server){
observeEvent(input$hideMe, {
shinyjs::hide(selector = "ul.menu-open");
})
}
runApp(shinyApp(ui, server))