I would like to clear a datatable with an actionButton.
The chunk does work, but the table is still there. How can I update the content of the table when the actionButton is pressed?
Please find the toy sampel as following.
library(shiny)
library(shinydashboard)
library(DT)
DT1 <- iris
shinyApp(
ui <-
dashboardPage(
dashboardHeader(title = ""),
dashboardSidebar(),
dashboardBody(
DTOutput("DT"),
actionButton("clear", "clear")
)
),
server <-
function(input, output, session) {
output$DT <- renderDT(datatable(DT1))
observeEvent(input$clear, {
DT1 <- data.frame()
})
}
)
This is what you need -
server <- function(input, output, session) {
dt_data <- reactiveValues(dt_data = iris)
observeEvent(input$clear, {
dt_data$dt_data <- data.frame() # use iris[0, ] if you want empty df
})
output$DT <- renderDT(datatable(dt_data$dt_data))
}
Related
I have the shiny app below in which when the user starts typing a word in search textInput(). Then the user press Search and the dataframe is subseted according to this search. Then I would like the table to be reseted after clicking the Reset actionButton().
## app.R ##
library(shiny)
library(shinydashboard)
library(DT)
col1<-c("sd fgg","df dfg","fgh gdfg")
col2<-c("sd fgg","df dgfg","fgh gdfg")
col3<-c("sd fggg","dfg dfgg","fgghol gdfg")
df<-data.frame(col1,col2,col3)
ui <- dashboardPage(
dashboardHeader(title = "Dataset Inventory"),
dashboardSidebar(
textInput("tt","search",""),
actionButton("ser","Search"),
actionButton("res","Reset")
),
dashboardBody(
dataTableOutput("table")
)
)
server <- function(input, output) {
output$table<-renderDataTable({
input$res
datatable(
d_new <- df[apply(df, 1, function(x) any(grepl(isolate(input$tt), x))), ]
)
})
}
shinyApp(ui, server)
We may use observeEvent
server <- function(input, output, session) {
cntrl <- reactiveValues(n = 0)
output$table <- renderDataTable({
datatable(df)
})
observeEvent(input$ser,
{
cntrl$n <- cntrl$n + 1
output$table<-renderDataTable({
datatable(
d_new <- df[apply(df, 1, function(x) any(grepl(isolate(input$tt), x))), ]
)
})
}
)
observeEvent(input$res,
{
cntrl$n <- 0
updateTextInput(session, "tt", value = "")
output$table <- renderDataTable(datatable(df))
})
}
I created a matrix, and I want to input an action button to enable the user to control the view.
please use this dataset and here is the error message as after clicking "transpose" button nothing happens:
Here is the code
library(shiny)
library(DT)
ui <- basicPage(
h2("India cities"),
DT::dataTableOutput("mytable"),
actionButton("go", "Transpose"),
dataTableOutput("mytabletranspose")
)
server <- function(input, output,session)
{output$mytable = DT::renderDataTable({
indiacities
})
observeEvent(input$go, {
})
output$mytabletranspose<-renderDataTable({
t(mytable)
})
}
Unsure what is the expected output. One option is to have the transposed table show up when the button is clicked in a new data table. This is relatively straight forward.
If you want the transposed table to appear as a new data table,
library(shiny)
library(DT)
ui <- basicPage(
h2("India cities"),
DT::dataTableOutput("mytable"),
actionButton("go", "Transpose"),
dataTableOutput("mytabletranspose")
)
server <- function(input, output,session){
indiacities <- data.frame(city = c("Mumbai","Bangalore"),population = c(18,8.4),area_code = c("+91-22","+91-080"))
output$mytable <- DT::renderDataTable({
indiacities
})
output$mytabletranspose <- DT::renderDataTable({
req(input$go)
t(indiacities)
})
}
shinyApp(ui = ui,server = server)
If you want to transpose the same table we will need to edit the original table indiacities. Because observer and reactive execute functions in their own environment we need to use the global assignment operator <<-
library(shiny)
library(DT)
ui <- basicPage(
h2("India cities"),
DT::dataTableOutput("mytable"),
actionButton("go", "Transpose"),
)
server <- function(input, output,session){
indiacities <- data.frame(city = c("Mumbai","Bangalore"),population = c(18,8.4),area_code = c("+91-22","+91-080"))
data <- reactive({
if(length(input$go) == 0){
#Executed when the app is initializes
return(indiacities)
}else{
indiacities <<- t(indiacities)
}
})
output$mytable <- DT::renderDataTable({
req(data())
data()
})
}
shinyApp(ui = ui,server = server)
I'm using the attached code to generate sub-tables based on groups. For some reason only the last portion of the data is rendered for every table.
It would be great if someone can tell me what is going wrong.
BR
library(shiny)
library(shinydashboard)
library(DT)
library(data.table)
tabnames <- LETTERS[1:6]
DT <- data.table(mtcars[1:30,], keep.rownames=TRUE)
DT[, grp:=rep(tabnames, each=trunc(nrow(mtcars)/length(tabnames)))]
ui = dashboardPage(
dashboardHeader(title = "Dynamic DTs"),
dashboardSidebar(),
dashboardBody(
uiOutput("tables"),
p(),
verbatimTextOutput("selectedCells")
)
)
server <- function(input, output, session) {
output$tables <- renderUI({
output_list <- list()
for(i in seq(tabnames)){
output_list[[i]] <- column(4, DT::dataTableOutput(outputId=tabnames[i]))
}
print(fluidRow(output_list))
return(fluidRow(output_list))
})
for(i in seq(tabnames)){
tabname <- tabnames[i]
local({
print(DT[grp %in% tabname, 1:3])
output[[tabname]] <- DT::renderDataTable({
DT[grp %in% tabname, 1:3]
}, selection=list(mode="multiple", target="cell"))
})
}
output$selectedCells <- renderPrint(input$A_cells_selected)
}
shinyApp(ui = ui, server = server)
Ok, found a solution: needed to pass it in a separate variable:
library(shiny)
library(shinydashboard)
library(DT)
library(data.table)
tabnames <- LETTERS[1:6]
DT <- data.table(mtcars[1:30,], keep.rownames=TRUE)
DT[, grp:=rep(tabnames, each=trunc(nrow(mtcars)/length(tabnames)))]
ui = dashboardPage(
dashboardHeader(title = "Dynamic DTs"),
dashboardSidebar(),
dashboardBody(
uiOutput("tables"),
p(),
verbatimTextOutput("selectedCells")
)
)
server <- function(input, output, session) {
output$tables <- renderUI({
output_list <- list()
for(i in seq(tabnames)){
output_list[[i]] <- column(4, DT::dataTableOutput(outputId=tabnames[i]))
}
print(fluidRow(output_list))
return(fluidRow(output_list))
})
for(i in seq(tabnames)){
tabname <- tabnames[i]
local({
subDT <- DT[grp %in% tabname, 1:3]
output[[tabname]] <- DT::renderDataTable({
subDT
}, selection=list(mode="multiple", target="cell"))
})
}
output$selectedCells <- renderPrint(input$A_cells_selected)
}
shinyApp(ui = ui, server = server)
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)
I am using Shiny and I am trying to make a set of tabPanels appear dynamically based on a set of parameters. In the code below, I would like to make the first tabPanel appear only when showTab1 <- T and so on.
I tried with simple if statements and conditionalPanels but it fails. Below there is an example of code:
rm(list = ls())
library(shiny)
library(shinydashboard)
showTab1 <- T
showTab2 <- F
showTab3 <- T
ui <- dashboardPage(
dashboardHeader(),
dashboardSidebar(
),
dashboardBody(
uiOutput("tabs")
)
)
server <- function(input, output) {
output$tabs <- renderUI({
tabBox(width = 1000,height = 500,
if (showTab1 == T) { tabPanel("tab1") },
if (showTab2 == T) { tabPanel("tab2") },
if (showTab3 == T) { tabPanel("tab3") }
)
})
}
shinyApp(ui, server)
Thanks for your help.
Cheers,
Kostas
You can dynamically create them:
rm(list = ls())
library(shiny)
library(shinydashboard)
showTab1 <- T
showTab2 <- F
showTab3 <- T
ShowTotal <- which(c(showTab1,showTab2,showTab3))
ui <- dashboardPage(
dashboardHeader(),
dashboardSidebar(),
dashboardBody(uiOutput("ui"))
)
server <- function(input, output) {
output$ui <- renderUI({
myTabs = lapply(paste('tab', ShowTotal), tabPanel)
do.call(tabsetPanel, myTabs)
})
}
shinyApp(ui, server)
Thanks for your answer earlier. Following your suggestion I think the following example can work for my case. The only issue I have is that in the end I cannot adjust the width and height of the tabBox.
library(shiny)
library(shinydashboard)
showTab1 <- T
showTab2 <- F
showTab3 <- T
ShowTotal <- which(c(showTab1,showTab2,showTab3))
ui <- dashboardPage(
dashboardHeader(),
dashboardSidebar(),
dashboardBody(uiOutput("ui"))
)
server <- function(input, output) {
output$ui <- renderUI({
tabs <- list()
k <- 0
if (showTab1 == T){
k <- k+1
tabs[[k]] <- tabPanel("Tab1", p("A phrase"), br(""), p("I can place a chart here"))
}
if (showTab2 == T){
k <- k+1
tabs[[k]] <- tabPanel("Tab2", p("B phrase"), br(""), p("I can place a chart here"))
}
if (showTab3 == T){
k <- k+1
tabs[[k]] <- tabPanel("Tab3", p("C phrase"), br(""), p("I can place a chart here"))
}
do.call(tabBox, tabs)
})
}
shinyApp(ui, server)
Thanks,
Kostas