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)
I am using below code and try to do below action.
Click on action button to go to next table. How can I do this?
library(shiny)
library(shinydashboard)
library(ggplot2)
ui <- fluidPage(
fluidRow(box(
actionButton("btn1", "Go to Next Table"),
tableOutput("tbl1")
)),
fluidRow(box(
tableOutput("tbl2")
))
)
server <- function(input, output, session) {
output$tbl1 <- renderTable(mtcars)
output$tbl2 <- renderTable(mpg)
}
shinyApp(ui, server)
Here's one solution:
library(shiny)
library(shinydashboard)
library(ggplot2)
ui <- fluidPage(
fluidRow(box(
actionButton("btn1", "Go to Next Table",
onclick = "location.href='#table2';"),
tableOutput("tbl1")
)),
fluidRow(id = "table2", box(
tableOutput("tbl2")
))
)
server <- function(input, output, session) {
output$tbl1 <- renderTable(mtcars)
output$tbl2 <- renderTable(mpg)
}
shinyApp(ui, server)
I've added a unique ID to the location in the UI - here the 2nd fluidRow, then added an onclick javascript function to the actionButton also in the UI. No server function means all the work is done by the user's browser which is handy sometimes.
You can add infinite complexity to the Javascript here to customise it to fit your needs.
I am using shinydashboardplus.
I'd like to use the to do list but the example in the gallery is limited to just showing a list without any functionality.
To track a todo list for a user I am reading and writing to a csv for the moment.
I can read the csv to dynamically populate the list. Now I'd like to be able to strike through an item to indicate it is completed using the checked parameter.
The checked items should be removed from the csv.
Ill work on the adding items another day I think....
Here is my example (not reading from csv but from iris for this example).
library(shiny)
library(shinydashboardPlus)
# Define UI for application that draws a histogram
ui <- fluidPage(
# Application title
titlePanel("Old Faithful Geyser Data"),
useShinydashboardPlus(),
# Sidebar with a slider input for number of bins
sidebarLayout(
sidebarPanel(
),
# Show a plot of the generated distribution
mainPanel(
box(
"Sortable todo list demo",
status = "warning",
todoList(
apply(mtcars,1, function(x)
todoListItem(
label = x[1],
x[2]
)
)
)
)
)
)
)
# Define server logic required to draw a histogram
server <- function(input, output) {
}
# Run the application
shinyApp(ui = ui, server = server)
Here is an approach using renderUI and a reactive data.frame:
library(shiny)
library(shinydashboardPlus)
library(shinyWidgets)
css <- "
.inlinecheckbox .shiny-input-container {
display: inline-block;
width: auto;
}
"
ui <- fluidPage(
tags$style(css),
titlePanel("Dynamic to do list"),
useShinydashboardPlus(),
sidebarLayout(
sidebarPanel(),
mainPanel(
box(
"Sortable todo list demo",
status = "warning",
uiOutput("myToDoList")
)
)
)
)
checkboxIDs <- paste0("checkbox", seq_len(nrow(mtcars)))
mtcars$checked <- FALSE
# Define server logic required to draw a histogram
server <- function(input, output) {
reactiveMtcars <- reactiveVal(mtcars)
observe({
for (i in seq_along(checkboxIDs)) {
if(!is.null(input[[checkboxIDs[1]]])){
mtcars$checked[i] <- input[[checkboxIDs[i]]]
}
}
reactiveMtcars(mtcars)
})
output$myToDoList <- renderUI({
req(reactiveMtcars())
todoListItems <- list()
for(i in seq_len(nrow(reactiveMtcars()))){
todoListItems[[i]] <- todoListItem(
label = div(rownames(reactiveMtcars())[i], style = ""),
span(class = "inlinecheckbox", checkboxInput(inputId = paste0("checkbox", i), label = NULL, value = reactiveMtcars()$checked[i])),
checked = reactiveMtcars()$checked[i],
)
}
todoList(todoListItems)
})
}
shinyApp(ui = ui, server = server)
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)
I'm experimenting a Shiny App to show dynamic contexts, but I cannot get renderDataTable working into a renderUi component.
Below two simple replicable tests: the first one is not working, the second one without renderUi works fine, of course.
What is the conceptually difference between this two, and why the first one cannot work in Shiny?
This one not works: note that the uiOutput myTable, contains two reactive component, a selectInput and a renderDataTable, but only the selectInput is rendered.
library(shiny)
runApp(list(
ui = fluidPage(
fluidRow(h2("where is the table?")),
uiOutput('myTable')
),
server = function(input, output) {
output$myTable <- renderUI({
fluidPage(
fluidRow(selectInput("test", "test", c(1,2,3))),
fluidRow(renderDataTable(iris))
)
})
}
))
This is fine, both selectInput and renderDataTable are rendered:
library(shiny)
runApp(list(
ui = fluidPage(
fluidRow(h2("where is the table?")),
fluidRow(selectInput("test", "test", c(1,2,3))),
fluidRow(dataTableOutput('myTable'))
),
server = function(input, output) {
output$myTable = renderDataTable(iris)
}
))
How to get the first scenario working?
Thanks.
EDITING after Yihui comment (thanks Yihui):
In renderUi has to be used some ui function, and not some render function:
changed the sample code in the correct way, the result does not change: still no data is shown.
library(shiny)
runApp(list(
ui = basicPage(
uiOutput('myTable')
),
server = function(input, output) {
output$myTable <- renderUI({dataTableOutput(iris)
})
}
))
EDIT n.2
Just solved, got it working so:
library(shiny)
runApp(list(
ui = fluidPage(
mainPanel(
uiOutput('myTable')
)
),
server = function(input, output) {
output$myTable <- renderUI({
output$aa <- renderDataTable(iris)
dataTableOutput("aa")
})
}
))
I have to save the renderTableOutput in a output variable first, and then feeding it to dataTableOutput.
Thanks for pointing me to: here
It would be clearer if you split the part of datatable generation and ui generation :
library(shiny)
runApp(list(
ui = fluidPage(
mainPanel(
uiOutput('myTable')
)
),
server = function(input, output) {
output$aa <- renderDataTable({iris})
output$myTable <- renderUI({
dataTableOutput("aa")
})
}
))