- On rendering output table the input box should be collapsed. Is there any way I can achieve this ?
I don't immediately see an R method that can be called or a javascript id that can be used to collapse the box at will. There could be a method, but I don't know of it.
- When I want to print table from "Second Box" after "First Box" eventReactive of second submit button is not responding. What needs to be done in order to fix this ?
My approach is to use a middle dataset. Then this new data should be printed. If a button is pressed, the middle data is set to that buttons data. Since it is a reactiveVal, same values do not update reactively.
- Progress Bar is shown on loading of page but it should be shown only on rendering output table. How to fix this ?
At the beginning of renderDataTable, be sure to req (require) all variables that are necessary to function. If any of the req arguments are falsey, then computation will stop for that method.
Updated code below.
library(shiny)
library(shinyjs)
library(shinydashboard)
library(DT)
ui <- fluidPage(
dashboardPage(title = "My Page",
dashboardHeader(
title = "My Header",
titleWidth = 200
),
dashboardSidebar(
width = 200,
sidebarMenu(
menuItem("My Data", selected = FALSE,
menuSubItem(text = "My Data", tabName = "my_data", newtab = TRUE, selected = FALSE)
)
)
),
dashboardBody(
useShinyjs(),
tabItems(
# First tab content
tabItem(tabName = "my_data",
h2("Please select fields"),
div(
fluidRow
(
box(title = 'First Box', background = 'green', collapsible = TRUE, collapsed = TRUE,
column(2,
actionButton("sub_mt", "Show MT Cars")
)),
box(title = 'Second Box', background = 'yellow', collapsible = TRUE, collapsed = TRUE,
column(2,
actionButton("sub_iris","Show Iris Data")
))
)
)
)
),
DT::dataTableOutput('optable'),
textOutput('message')
)
))
server <- function(session,input,output) {
# initialize the data to nothing
data_to_show <- reactiveVal(NULL)
# set susspend to TRUE to NOT run the first time
observe(suspended = TRUE, {
input$sub_mt
# set data to mtcars
data_to_show(mtcars)
})
observe(suspended = TRUE, {
input$sub_iris
# set data to iris
data_to_show(iris)
})
output$optable <- DT::renderDataTable({
# require that the data exist
req(data_to_show())
withProgress(message = 'Data Loading...',value = 0, {
for (i in 1:15) {
incProgress(1/15)
Sys.sleep(0.25)
}
})
datatable(data_to_show(), rownames = FALSE, filter = 'top',
style = 'bootstrap', selection = 'single')}
)
}
shinyApp(ui, server)
library(shiny)
library(shinyjs)
library(shinydashboard)
library(DT)
ui <- fluidPage(
dashboardPage(title = "My Page",
dashboardHeader(
title = "My Header",
titleWidth = 200
),
dashboardSidebar(
width = 200,
sidebarMenu(
menuItem("My Data", selected = FALSE,
menuSubItem(text = "My Data", tabName = "my_data", newtab = TRUE, selected = FALSE)
)
)
),
dashboardBody(
useShinyjs(),
tabItems(
# First tab content
tabItem(tabName = "my_data",
h2("Please select fields"),
div(
fluidRow
(
box(title = 'First Box', background = 'green', collapsible = TRUE, collapsed = TRUE,
column(2,
actionButton("sub_mt", "Show MT Cars")
)),
box(title = 'Second Box', background = 'yellow', collapsible = TRUE, collapsed = TRUE,
column(2,
actionButton("sub_iris","Show Iris Data")
))
)
)
)
),
DT::dataTableOutput('optable'),
textOutput('message')
)
))
server <- function(session,input,output) {
# initialize the data to nothing
data_to_show <- reactiveVal(NULL)
# set susspend to TRUE to NOT run the first time
observe(suspended = TRUE, {
input$sub_mt
# set data to mtcars
data_to_show(mtcars)
})
observe(suspended = TRUE, {
input$sub_iris
# set data to iris
data_to_show(iris)
})
output$optable <- DT::renderDataTable({
# require that the data exist
req(data_to_show())
withProgress(message = 'Data Loading...',value = 0, {
for (i in 1:15) {
incProgress(1/15)
Sys.sleep(0.25)
}
})
datatable(data_to_show(), rownames = FALSE, filter = 'top',
style = 'bootstrap', selection = 'single')}
)
}
shinyApp(ui, server)