I want to display a spreadsheet with some information in shinyWidgets dropdown, sometimes spanning multiple pages.
If you click on the next page, the dropdown closes again.
How can I avoid this?
library(shiny)
library(shinyWidgets)
ui <- fluidPage(
br(),br(),br(),
p("How to go to the next page, without collapsing?"),
uiOutput("irisdrop", inline = TRUE)
)
server <- function(input, output, session) {
output$irisdrop <- renderUI({
dropdown(circle = FALSE, inputId = "iris",
label = "iris", status = "primary",
datatable(iris, rownames = NULL,
height = "100%",
selection = "none"
)
)
})
}
shinyApp(ui, server)
You can do something like this -
library(shiny)
library(shinyWidgets)
library(DT)
ui <- fluidPage(
dropdownButton(
inputId = "iris",
label = "iris",
icon = icon("sliders"),
status = "primary",
circle = FALSE,
DT::dataTableOutput("iris_tb")
)
)
server <- function(input, output, session) {
output$iris_tb <- DT::renderDataTable({
datatable(iris, rownames = NULL,
height = "100%",
selection = "none"
)
})
}
shinyApp(ui, server)
Note: You can even use dropdown() instead of dropdownButton() from shinyWidgets package.
dropdown() is similar to dropdownButton() but it don't use Bootstrap, so you can put pickerInput in it. Moreover you can add animations on the appearance / disappearance of the dropdown with animate.css.
For more detail, you can look at the page 30 of the following document -
https://cran.r-project.org/web/packages/shinyWidgets/shinyWidgets.pdf
Related
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 have the following code:
library(shiny)
library(shinydashboard)
library(rhandsontable)
header <- dashboardHeader(title = "Sample", titleWidth = 375)
sidebar <- dashboardSidebar(width = 270,
sidebarMenu(id="mymenu",
menuItem(text = "Home", tabName = "tabCars", icon = icon("home", class="home"))
))
body <- dashboardBody (
tabItems(
tabItem(tabName = "tabCars",
fluidRow(
column(width = 2,
selectInput(
inputId = "selected_CarCylinders",
label = "Car Cylinders",
choices = mtcars$cyl,
selectize = TRUE,
width = "250px",
multiple = FALSE
)),
column(width = 2, style = "margin-top: 25px",
actionButton("deleteBtn", "Delete Selected Cylinders")),
column(width = 1, style = "margin-top: 25px",
actionButton("refreshBtn", "Refresh Filter/Chart")),
rHandsontableOutput("carDT")
)
)
)
)
ui <- dashboardPage(header, sidebar, body)
server <- function(input, output, session) {
output$carDT <- renderRHandsontable({
df <- mtcars
rhandsontable(df, stretchH = "all")
})
observeEvent(input$deleteBtn, {
# need help here
})
observeEvent(input$refreshBtn, {
# need help here
})
}
shinyApp(ui, server)
I need help writing what would go into the input$deleteBtn and input$refreshBtn sections of the server side. If you run the code as is, the idea is to select the number of cylinders from mtcars, then click the Delete button to remove all those entries from the table and filter; however, the filter and table would only update after clicking the refresh button.
While permanently delete screams a SQLite database to me, you could achieve this by using a reactiveVal to store the dataframe and call req to only refresh the table when you click the refreshBtn (in this case, you also have to click it to display the table at the start of the app).
server <- function(input, output, session) {
# Create a `reactiveVal` and set a value to it
df <- reactiveVal()
df(mtcars)
output$carDT <- renderRHandsontable({
req(input$refreshBtn)
rhandsontable(df(), stretchH = "all")
})
observeEvent(input$deleteBtn, {
data <- dplyr::filter(df(), cyl != input$selected_CarCylinders)
# Update `selectInput` to filter out the choices too (for good measure)
updateSelectInput(session, "selected_CarCylinders", choices = data$cyl)
# Update the `reactiveVal` value
df(data)
})
}
I'm looking for a way to fire this line of code:
onevent('click', '???' ,{ print( 'hey1!!') })
or
onclick('DateRange' ,{ print( 'hey1!!') })
but ONLY when the user clicks on the calendar icon of an airDatepickerInput
but I don't know how to target the icon since it has no ID of its own.
Targeting 'DateRange' will not work as it will also trigger when clicking in the date range field, and that's unwanted.
The reason I want this is because I want the option to open a modal dialog that shows a plot with the date distribution of my data files the user is filtering for in my app.
library(shiny)
library(shinyWidgets)
ui <- fluidPage(
airDatepickerInput(
inputId = "DateRange",
label = "Select multiple dates:",
placeholder = "You can pick 5 dates",
multiple = 5, clearButton = TRUE
),
verbatimTextOutput("res")
)
server <- function(input, output, session) {
output$res <- renderPrint(input$DateRange)
}
shinyApp(ui, server)
The author of the shinywidget package has updated the airDatepickerInput so that the button on the side can now be observed.
library(shiny)
library(shinyWidgets)
ui <- fluidPage(
airDatepickerInput(
inputId = "DateRange",
label = "Select multiple dates:",
placeholder = "You can pick 5 dates",
multiple = 5, clearButton = TRUE
),
verbatimTextOutput("res_date"),
verbatimTextOutput("res_button")
)
server <- function(input, output, session) {
output$res_date <- renderPrint(input$DateRange)
output$res_button <- renderPrint(input$DateRange_button)
observeEvent(input$DateRange_button, {
print(input$DateRange_button)
})
}
shinyApp(ui, server)
Context
I'm building an app whith Rshiny. I created a dynamic navbar. Now, i would like to insert a datatable at each navbar's item (tabPanel). But i don't want to create a table per item in navbar. So i would like to know if it's possible to create only 1 table which update itself with the navbar's selected item ??
Code to create dynamical navbar
runApp(list(
ui = fluidPage(
navbarPage(theme=shinytheme("paper"),title="test",
tabPanel(uiOutput('mytabs'))
)
),
server = function(input, output, session){
output$mytabs = renderUI({
nTabs = length(unique(iris$Species))
myTabs = lapply(unique(iris$Species)[1:nTabs], tabPanel)
do.call(tabsetPanel, myTabs)
})
}
))
Now i woulk like to display datatable(subset(iris,Species=="value of navbar")) at each navbar's item
Can someone explain me how to do ?
Using question here, you can define a function and call it as below. Note that csv button will only work in a browser.
library(shiny)
library(shinythemes)
runApp(list(
ui = fluidPage(
navbarPage(theme=shinytheme("paper"),title="test",
tabPanel(uiOutput('mytabs'))
)
),
server = function(input, output, session){
createTabs <- function(species_r){
tabPanel(title = paste("Data", species_r, sep=" "),
datatable(subset(iris,Species==species_r),rownames = FALSE,
extensions = 'Buttons', options = list(dom = 'Bfrtip', buttons = c('copy', 'csv',I('colvis'))))
)
}
output$mytabs = renderUI({
nTabs = length(unique(iris$Species))
myTabs = lapply(unique(iris$Species)[1:nTabs], createTabs)
do.call(tabsetPanel, myTabs)
})
}
))
I am currently trying to limit my selection in a DataTable in Shiny to just two rows - I want the table to not allow the user to click on more than rows (but also to have the ability to deselect them afterwards).
library(DT)
shinyApp(
ui = fluidPage(
fluidRow(
column(12,
dataTableOutput('table')
)
)
),
server = function(input, output) {
output$table <- DT::renderDataTable(iris,
options = list(selection = "multiple")
)
}
)
The row selection is currently on multiple mode, which works, but I don't want the selection to exceed two rows.
Update: Does not seem to work anymore, since 04.2022 or earlier.
You could either solve it via javascript, which you may have seen already:
Limit row selection to 3 in datatables
Or you update the datatable in Shiny:
library(DT)
library(shiny)
shinyApp(
ui = fluidPage(
fluidRow(
column(12,dataTableOutput('tbl'))
)
),
server = function(input, output) {
reset <- reactiveValues(sel = "")
output$tbl <- DT::renderDataTable({
input$tbl_rows_selected
datatable(iris, selection = list(mode = 'multiple', selected = reset$sel))
})
observe({
if(length(input$tbl_rows_selected) > 2){
reset$sel <- setdiff(input$tbl_rows_selected, input$tbl_row_last_clicked)
}else{
reset$sel <- input$tbl_rows_selected
}
})
}
)
This solution might be less clean, but a bit easier to understand.
It's not exactly what you want but I've changed a bit Tonio's answer, it may help someone else.
library(DT)
library(shiny)
shinyApp(
ui = fluidPage(
fluidRow(
column(12,dataTableOutput('tbl'))
),
textOutput('selected_rows')
),
server = function(input, output) {
reset <- reactiveValues(sel = "")
output$tbl <- DT::renderDataTable({
datatable(iris, selection = list(mode = 'multiple', selected = reset$sel))
})
observe({
if(length(input$tbl_rows_selected) > 2){
reset$sel <- NULL
}else{
reset$sel <- input$tbl_rows_selected
}
})
output$selected_rows <- renderText({input$tbl_rows_selected})
}
)