Vertically align text in reactable cells in shiny app - r

Is there a way to vertically align (middle) the text in the cells in a reactable rendered within a shiny app?
minimal example below. I tried some CSS options but no luck so far.
library(shiny)
library(reactable)
ui <- fluidPage(
titlePanel("reactable example"),
reactableOutput("table")
)
server <- function(input, output, session) {
output$table <- renderReactable({
reactable(iris)
})
}
shinyApp(ui, server)
thank you


You can use defaultColDef to set default attributes. Below code snippet should vertically align text centrally:
library(shiny)
library(reactable)
ui <- fluidPage(
titlePanel("reactable example"),
reactableOutput("table")
)
server <- function(input, output, session) {
output$table <- renderReactable({
reactable(iris,
defaultColDef = colDef(
align = "center")
)
})
}
shinyApp(ui, server)
Below is the output after running the code. The output is both centrally & horizontally aligned

Related

Fixing top section in shiny

Is there a way to fix the top section of the dashboard here. Right now, the widgets (selectinput) are fixed, but when the user scroll down, it gets covered by the datatable. Can we not make sure this does not get covered and only datatable moves down?
library(shiny)
library(DT)
ui <- shinyUI(fluidPage(
titlePanel(fluidRow(
div(column(12, align="center",
selectInput("rmd1", "RMDw", choices = c(1,2)),
selectInput("rmd2", "RMD2", choices = c(1,2))
), style = "position:fixed; width:inherit;")
)),
br(),br(),br(),br(),br(),br(),br(),br(),br(),br(),br(),br(),br(),br(),br(),
dataTableOutput("uioutput", height = "2000px")
))
server <- function(input, output, session) {
output$uioutput <- renderDataTable({
datatable(iris)
})
}
shinyApp(ui, server)

You can use the CSS z-index property to control the stack order the HTML elements:
library(shiny)
library(DT)
ui <- shinyUI(fluidPage(
titlePanel(fluidRow(
div(column(12, align="center",
selectInput("rmd1", "RMDw", choices = c(1,2)),
selectInput("rmd2", "RMD2", choices = c(1,2))
), style = "position:fixed; width:inherit; z-index: 1; background-color: white;")
)),
br(),br(),br(),br(),br(),br(),br(),br(),br(),br(),br(),br(),br(),br(),br(),
dataTableOutput("uioutput", height = "2000px")
))
server <- function(input, output, session) {
output$uioutput <- renderDataTable({
datatable(iris)
})
}
shinyApp(ui, server)
Another approach is using position: sticky;.

Changing the style line to position:absolute makes it so that the selection boxes scroll up and out of the page when you scroll down, if that's what you were looking for.
library(shiny)
library(DT)
ui <- shinyUI(fluidPage(
titlePanel(fluidRow(
div(column(12, align="center",
selectInput("rmd1", "RMDw", choices = c(1,2)),
selectInput("rmd2", "RMD2", choices = c(1,2))
), style = "position:absolute; width:inherit;")
)),
br(),br(),br(),br(),br(),br(),br(),br(),br(),br(),br(),br(),br(),br(),br(),
dataTableOutput("uioutput", height = "2000px")
))
server <- function(input, output, session) {
output$uioutput <- renderDataTable({
datatable(iris)
})
}
shinyApp(ui, server)
If you're trying to make the table stay in place and scroll down through the table, use DTOutput() and renderDataTable() instead of dataTableOutput() and renderDataTable(). Then, get rid of datatable() inside renderDT() and just use 'iris'. Finally, you can add the Scroller extension and an options list with scrollY and scroller. Others may be able to explain the difference between DT and DataTable (this page might help as well: https://rstudio.github.io/DT/shiny.html), but I believe DTOutput and renderDT are more flexible. Note: you can add horizontal scrollbars as well with scrollX if you use a table with more fields in the future.
Updated code is below.
Hope either of these helps!
library(shiny)
library(DT)
ui <- shinyUI(fluidPage(
titlePanel(fluidRow(
div(column(12, align="center",
selectInput("rmd1", "RMDw", choices = c(1,2)),
selectInput("rmd2", "RMD2", choices = c(1,2))
), style = "position:absolute; width:inherit;")
)),
br(),br(),br(),br(),br(),br(),br(),br(),br(),br(),br(),br(),br(),br(),br(),
DTOutput("uioutput", height = "600px")
))
server <- function(input, output, session) {
output$uioutput <- renderDT({
iris
},
extensions = c('Scroller'),
fillContainer = T,
options = list(deferRender = T,
scrollY = 400,
scroller = T)
)
}
shinyApp(ui, server)

Change the title by pressing a shiny button Shiny R

library(shiny)
ui <- fluidPage(
h1("Free",align = "center"),
actionButton("go", "Go")
)
server <- function(input, output) {
observeEvent(input$go,{
#change the h1 title for
code("Busy",align="center")
}
}
shinyApp(ui, server)
How to change the title when pressing a button? the idea is to change the word free to busy when the button is pressed.

Would make the h1 header using uiOutput in the ui. Then, you can dynamically change this text to whatever you want in server. Perhaps for your example, you can have a reactiveVal that contains the text you want in the header, which can be modified in your case when the actionButton is pressed.
library(shiny)
ui <- fluidPage(
uiOutput("text_header"),
actionButton("go", "Go")
)
server <- function(input, output) {
rv <- reactiveVal("Free")
observeEvent(input$go, {
rv("Busy")
})
output$text_header <- renderUI({
h1(rv(), align = "center")
})
}
shinyApp(ui, server)

Show box only when tableoutput is ready in shiny app

I want to generate a boxPlus around my DT-Output. Now when I start my APP, the frame of the box is already there. How do I manage that the box is only displayed when the tableoutput is finished? As input I use a text input.
In my UI I use for the Input:
textInput("name", "Insert Number:")
the final box I create with:
uiOutput("box")
On Serverside I do:
output$name <- renderText(input$name)
New_input <- reactive({
list(input$name)
})
and the box I create like this:
output$box <- renderUI({
boxPlus(
div(style = 'overflow-x: scroll;'), dataTableOutput("table")
)
})
I tried it with: Similar Problem but I can not resolve the problem. Without the box everything works fine.

Never use reactive expressions inside a renderText function.
You have to wrap tagList around your two elements to return a SINGLE element (a list in your case).
Here is a reproduceable example.
library(shiny)
library(shinydashboardPlus)
library(dplyr)
# Define UI for application that draws a histogram
ui <- fluidPage(
# Application title
titlePanel("Hide box"),
# Sidebar with a slider input for number of bins
sidebarLayout(
sidebarPanel(
textInput("name", "Insert Number to filter cyl:")
),
mainPanel(
uiOutput("box")
)
)
)
server <- function(input, output) {
resultdf <- reactive({
mtcars %>%
filter(cyl > input$name)
})
output$box <- renderUI({
output$table <- renderDataTable({
resultdf()
})
if(input$name == "") {
return(NULL)
} else {
return(
tagList(
boxPlus(
div(style = 'overflow-x: scroll;'), dataTableOutput("table")
)
)
)
}
})
}
# Run the application
shinyApp(ui = ui, server = server)

Adjust the position of actionButton widget in R shiny DT table

The given R shiny script creates a simple data table as in the snapshot with an actionButton in the center. I want to place the button a little below it's current position such that it is in perfect horizontal inline position to the search bar. Thanks and please help.
library(DT)
library(shiny)
library(shinyBS)
library(rpivotTable)
library(bupaR)
ui <- basicPage(
h2("The mtcars data"),
column(5,offset = 5,actionButton("CR1_S1", "Button")),
dataTableOutput("mytable1")
)
server <- function(input, output) {
output$mytable1 <- DT::renderDataTable({
DT::datatable(iris)
})
}
shinyApp(ui, server)

You can put the button inside the datatable in this way:
ui <- basicPage(
h2("The mtcars data"),
actionButton("CR1_S1", "Button"),
DTOutput("mytable1")
)
server <- function(input, output) {
output$mytable1 <- renderDT({
datatable(iris, callback = JS("$('div.button').append($('#CR1_S1'));"),
options = list(
dom = '<"row"<"col-sm-4"l><"col-sm-4 text-center"<"button">><"col-sm-4"f>>tip'
))
})
}
shinyApp(ui, server)

Fix width of a DT in shiny

I'm trying to fix the width of very wide table in shiny but haven't mange to do it. I try the answer here Shrink DT::dataTableOutput Size but it didn't work, I also tried the answer from here https://github.com/rstudio/DT/issues/29 with percentage and pixels for all the columns and it didn't work neither. This is an example of the table and problem I have:
shinyApp(
ui = fluidPage(
DT::dataTableOutput("table")
),
server <- function(input, output) {
x <- cbind(iris,iris,iris,iris)
output$table <- DT::renderDataTable(x)
}
)

I think this does what you want:
library(shiny)
shinyApp(
ui = fluidPage(
DT::dataTableOutput("table",width='500px')
),
server <- function(input, output) {
x <- cbind(iris,iris,iris,iris)
output$table <- DT::renderDataTable(x,options=list(scrollX=T))
}
)

Resources