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)
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 really need help on the following code, I use 2 nested modules to display sampledata in multiple tabPanels (inside tabsetPanel) by certain columns, but the table is not display, I cant found any bugs inside yet.
PS: this is just an reproducible example, the sampledata is uploaded by user in real scenario
library(shiny)
library(shinydashboard)
library(DT)
ui <- function() {
dashboardPage(
dashboardHeader(title = "abc"),
dashboardSidebar(uiOutput("sidebarpanel")),
dashboardBody(uiOutput("body")))
}
server <- function(input, output, session) {
output$sidebarpanel <- renderUI({
tags$div(
sidebarMenu(id = "tabs",
menuItem("Data", tabName = "data"))
)
})
output$body <- renderUI({
tabItems(ui_data1("data1", tabName = "data"))
})
input_data1 <- new.env()
input_data1$a <- reactive(1)
input_data1$b <- reactive(2)
input_data2 <- server_data1("data1", input_data1)
}
ui_data1 <- function(id, tabName){
ns <- NS(id)
tabItem(tabName = tabName,
uiOutput(ns("body")))
}
server_data1 <- function(id, input_data1) {
ns <- NS(id)
moduleServer(id, function(input, output, session) {
output$body <- renderUI({
tabsetPanel(
ui_data2(ns("info1"), "Info1")
)
})
data2 <- new.env()
data2$input_data2 <- server_data2("info1", input_data1)
return(data2)
})
}
ui_data2 <- function(id, title) {
ns <- NS(id)
tabPanel(title = title,
uiOutput(ns("body")))
}
server_data2 <- function(id, input_data1) {
ns <- NS(id)
moduleServer(id, function(input, output, session) {
c <- eventReactive(input_data1$a(), {
2
})
sampledata <- reactive(mtcars)
output$body <- renderUI({
all_cyl <- unique(sampledata()$cyl)
tbl_by_cyl <- lapply(seq_along(all_cyl), function(i) {
tabPanel(all_cyl[i],
column(12, br(),
box(width = "auto",
DT::dataTableOutput(ns(paste0("cyl", i)),
width = "100%"))))
})
do.call(tabsetPanel, tbl_by_cyl)
})
observe({
sampledata <- sampledata()
all_cyl <- unique(sampledata$cyl)
lapply(seq_along(all_cyl), function(i) {
output[[paste0("cyl", i)]] <- DT::renderDataTable({
datatable(sampledata[sampledata$cyl == all_cyl[i], ])
})
})
})
return(sampledata)
})
}
shinyApp(ui, server)
output:
output of above code
You were very close. You just needed ns <- session$ns in server_data1 and server_data2. Try this
library(shiny)
library(shinydashboard)
library(DT)
ui <- function() {
dashboardPage(
dashboardHeader(title = "abc"),
dashboardSidebar(uiOutput("sidebarpanel")),
dashboardBody(uiOutput("body")))
}
server <- function(input, output, session) {
output$sidebarpanel <- renderUI({
tags$div(
sidebarMenu(id = "tabs",
menuItem("Data", tabName = "data"))
)
})
output$body <- renderUI({
tabItems(ui_data1("data1", tabName = "data"))
})
input_data1 <- new.env()
input_data1$a <- reactive(1)
input_data1$b <- reactive(2)
input_data2 <- server_data1("data1", input_data1)
}
ui_data1 <- function(id, tabName){
ns <- NS(id)
tabItem(tabName = tabName,
uiOutput(ns("body1")))
}
server_data1 <- function(id, input_data1) {
#ns <- NS(id)
moduleServer(id, function(input, output, session) {
ns <- session$ns
output$body1 <- renderUI({
tabsetPanel(
ui_data2(ns("info1"), "Info1")
)
})
data2 <- new.env()
data2$input_data2 <- server_data2("info1", input_data1)
return(data2)
})
}
ui_data2 <- function(id, title) {
ns <- NS(id)
tabPanel(title = title,
uiOutput(ns("body2")))
}
server_data2 <- function(id, input_data1) {
#ns <- NS(id)
moduleServer(id, function(input, output, session) {
ns <- session$ns
c <- eventReactive(input_data1$a(), {
2
})
sampledata <- reactive(mtcars)
output$body2 <- renderUI({
all_cyl <- unique(sampledata()$cyl)
tbl_by_cyl <- lapply(seq_along(all_cyl), function(i) {
tabPanel(all_cyl[i],
fluidRow(column(12, br(),
shinydashboard::box( width = "auto",
DTOutput(ns(paste0("cyl", i)),width = "100%")))))
})
do.call(tabsetPanel, tbl_by_cyl)
})
observe({
sampledata <- sampledata()
all_cyl <- unique(sampledata$cyl)
lapply(seq_along(all_cyl), function(i) {
output[[paste0("cyl", i)]] <- renderDT({
datatable(sampledata[sampledata$cyl == all_cyl[i], ])
})
})
})
return(sampledata)
})
}
shinyApp(ui, server)
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))
}
I am unable to print table rownames in Shiny using the code below:
library(shinydashboard)
library(shiny)
myData <- matrix(
data=c('13,867','$229,153','30,128','$16.53','98.17%','39.69%'),
nrow = 6, ncol = 1, dimnames = list(letters[1:6], c("Metrics"))
)
ui <- dashboardPage(
dashboardHeader(),
dashboardSidebar(),
dashboardBody(
box(dataTableOutput("table"))
)
)
server <- function(input, output) {
output$table <- renderDataTable({
myData
})
}
shinyApp(ui, server)
And the output I get is shown below. Could someone please point out the mistake?
Output
You can add rownames with the DT package. rownames is an argument of DT::datatable which can also be used in DT::renderDT via the the options parameter.
library(shinydashboard)
library(shiny)
library(DT)
myData <- matrix(
data=c('13,867','$229,153','30,128','$16.53','98.17%','39.69%'),
nrow = 6, ncol = 1, dimnames = list(letters[1:6], c("Metrics"))
)
ui <- dashboardPage(
dashboardHeader(),
dashboardSidebar(),
dashboardBody(
box(DTOutput("table"))
)
)
server <- function(input, output) {
output$table <- renderDT({
myData
}, options = list(rownames = TRUE))
}
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