Add common vertical scroll for more than one dt::datatables - r

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")
)
)
)
)
)

Related

How to keep DT table borders within tabBox()

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
)
)
})

Select multiple choices in selectInput() when selectize=F

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

Align widget inside shinydashboard box?

Is there a way of aligning a widget inside a shinydashboard box? For example, in the following app:
library(shiny)
library(shinydashboard)
library(shinyWidgets)
ui <- dashboardPage(
dashboardHeader(),
dashboardSidebar(),
dashboardBody(box(
title = "Test", width = 4, solidHeader = TRUE, status = "primary",
dropdownButton(
inputId = "mydropdown",
label = "Controls",
icon = icon("sliders"),
status = "primary",
circle = FALSE,
numericInput("obs", "Observations:", 10, min = 1, max = 100)
),
plotOutput('plot')
))
)
server <- function(input, output) {
output$plot <- renderPlot({
hist(runif(input$obs))
})
}
shinyApp(ui, server)
I would like to align the dropdownButton widget to the bottom right corner of the Test box. How can I do that?
Just put the dropdownButton after the plot and inside a div with a class "pull-right"
library(shiny)
library(shinydashboard)
library(shinyWidgets)
ui <- dashboardPage(
dashboardHeader(),
dashboardSidebar(),
dashboardBody(box(
title = "Test", width = 4, solidHeader = TRUE, status = "primary",
plotOutput('plot'),
div(class = "pull-right",
dropdownButton(
inputId = "mydropdown",
label = "Controls",
icon = icon("sliders"),
status = "primary",
circle = FALSE,
numericInput("obs", "Observations:", 10, min = 1, max = 100)
)
)
))
)
server <- function(input, output) {
output$plot <- renderPlot({
hist(runif(input$obs))
})
}
shinyApp(ui, server)

Adding a vertical and horizontal scroll bar to the DT table in R shiny

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)

R Shiny tabsetPanel displaying strange tab name?

I am working with shinydashboard and using tabsetPanel, however strange name/number appears on the each tabPanel in the upper-left corner (like: tab-4750-1 and the number changes).
Does anyone know how i can remove it?
Hint: The problem appears in the menuItem: Tabelle & Plots
Code:
library(shiny)
library(shinydashboard)
library(ggplot2)
library(scales)
library(reshape2)
library(plyr)
library(dplyr)
library(DT)
ui <- dashboardPage(
dashboardHeader(),
dashboardSidebar(
sidebarMenu(
menuItem("Dashboard", tabName = "dashboard", icon = icon("dashboard")),
menuItem("Tabelle & Plots", icon = icon("area-chart"), tabName = "tabelle")
)
),
dashboardBody(
tabItems(
tabItem(tabName = "dashboard"
),
tabItem(tabName = "tabelle",
tabsetPanel(id="tabs",width = NULL, height = "800px", selected = 1,
tabPanel(value=1,title="Tabelle filtern",
fluidRow(
column(12,
box(width = NULL, div(style = 'overflow-y: scroll; overflow-x: scroll;max-height: 650px; position:relative;',
dataTableOutput("tabelle")))))),
tabPanel("Plots", value = 2,
fluidRow(
column(12,
box(width = NULL, plotOutput("plot", height=650)),
box(status = "danger",width = NULL,div(style = 'overflow-x: scroll;position:relative;',
dataTableOutput("tabelle2")))))))
)
)
)
)
server <- function(input, output) {
}
shinyApp(ui, server)
Thanks for help!
Cheers

Resources