I am developing a Shiny App, where the user can upload data, do some manipulations & create new df from selected rows. I have got till where I can add actionButtons per row in DT but cant make selections work. Selections work as expected if actionButtons are not included in the DT rows. What am I looking for?
1. To be able to toggle between two colors on click within each of the DT row (Orange = not selected; Green = selected, when clicked)
2. Create new data frame from selected rows of the datatable on another actionButton click (Ex: Category 01 or Category 02).
Once any of the Category 01 or Category 02 actionButton is clicked. I get this error Error: incorrect number of dimensions.
As shown at the bottom of Image 2.
I have added reproducible code below.
Any help is much appreciated
As in screenshot1, actionbuttons are Orange And in screenshot2 they are Green ,
Data
data <- data.frame(Name = rep(paste("RIS", 1:20, sep = "_")),
Gender = rep(c("Male", "Female"), each = 10),
CDC = rnorm(20),
FDC = rnorm(20),
RDC = rnorm(20),
LDC = rnorm(20)
)
Example Code
library(shiny)
library(DT)
ui <- fluidPage(
titlePanel("simpleApp"),
sidebarLayout(
sidebarPanel(fileInput("file1", "Upload Input file", accept = ".csv"), width = 2,
actionButton("calc", "Calculate"),
hr(style = "border-color: red; height: 5px"),
actionButton("gen1", "Category 01"),
actionButton("gen2", "Category 02")),
mainPanel (
dataTableOutput("table"),
dataTableOutput("table2"),
dataTableOutput("select_table1"),
dataTableOutput("select_table2"))))
server <- function(input, output, session) {
addButtonColumn <- function(df, id, ...) {
f <- function(i) {
as.character(
actionButton(paste(id, i, sep = "_"), class = "btn-warning btn-sm", label = tags$strong("Select"),
onclick = 'Shiny.setInputValue(\"addPressed\", this.id, {priority: "event"})'))
}
addCol <- unlist(lapply(seq_len(nrow(df)), f))
DT::datatable(cbind(Decision = addCol, df),
escape = FALSE, filter = "top", options = list(columnDefs = list(list(targets = 1, sortable = FALSE))))
}
data <- reactive({
df <- input$file1
if(is.null(df))
return(NULL)
df <- read.csv(df$datapath, header = TRUE, sep = ",", row.names = NULL)
return(df)
})
output$table <- DT::renderDataTable(data(), options = list(paging = t, pageLength = 6))
table2 <- eventReactive(input$calc, {
df2 <- input$file1
if(is.null(df2))
return(NULL)
table2 <- data() %>%
mutate("Selection" = CDC * RDC + FDC * LDC) %>%
mutate(across(where(is.numeric), round, 3)) %>%
addButtonColumn("Button")
})
output$table2 <- DT::renderDataTable(table2(), options = list(paging = t, pageLength = 6))
select_table1 <- eventReactive(input$gen1, {
if(is.null(table2)){
return(NULL)
} else {
select_table1 <- table2()[input$table2_rows_selected,]
}
})
select_table2 <- eventReactive(input$gen2, {
if(is.null(table2)){
return(NULL)
} else {
select_table2 <- table2()[input$table2_rows_selected,]
}
})
output$select_table1 <- DT::renderDataTable(select_table1(), options = list(paging = t, pageLength = 6))
output$select_table2 <- DT::renderDataTable(select_table2(), options = list(paging = t, pageLength = 6))
}
shinyApp(ui = ui, server = server)
DT::datatable
too early in the eventReactive
. You need to call it within renderDataTable
, otherwise, the render function can't recognize it properly (it can, but table2_rows_selected
will not work).df <- data.frame(Name = rep(paste("RIS", 1:20, sep = "_")),
Gender = rep(c("Male", "Female"), each = 10),
CDC = rnorm(20),
FDC = rnorm(20),
RDC = rnorm(20),
LDC = rnorm(20)
)
library(shiny)
library(DT)
ui <- fluidPage(
titlePanel("simpleApp"),
sidebarLayout(
sidebarPanel(fileInput("file1", "Upload Input file", accept = ".csv"), width = 2,
actionButton("calc", "Calculate"),
hr(style = "border-color: red; height: 5px"),
actionButton("gen1", "Category 01"),
actionButton("gen2", "Category 02")),
mainPanel (
dataTableOutput("table"),
dataTableOutput("table2"),
dataTableOutput("select_table1"),
dataTableOutput("select_table2"))),
tags$style(
'
table.dataTable tr.selected button {
background-color: green;
border-color: green;
}
'
)
)
server <- function(input, output, session) {
addButtonColumn <- function(df, id, ...) {
f <- function(i) {
as.character(
actionButton(paste(id, i, sep = "_"), class = "btn-warning btn-sm", label = tags$strong("Select"),
onclick = 'Shiny.setInputValue(\"addPressed\", this.id, {priority: "event"})'))
}
addCol <- unlist(lapply(seq_len(nrow(df)), f))
cbind(Decision = addCol, df)
}
data <- reactive({
df
})
output$table <- DT::renderDataTable(data(), options = list(paging = t, pageLength = 6))
table2 <- eventReactive(input$calc, {
df2 <- df
if(is.null(df2))
return(NULL)
data() %>%
mutate("Selection" = CDC * RDC + FDC * LDC) %>%
mutate(across(where(is.numeric), round, 3)) %>%
addButtonColumn("Button")
})
output$table2 <- DT::renderDataTable(DT::datatable(
table2(), escape = FALSE, filter = "top",
options = list(columnDefs = list(list(targets = 1, sortable = FALSE, paging = t, pageLength = 6)))
))
select_table1 <- eventReactive(input$gen1, {
if(is.null(table2)){
return(NULL)
} else {
print(input$table2_rows_selected)
select_table1 <- table2()[input$table2_rows_selected,]
}
})
select_table2 <- eventReactive(input$gen2, {
if(is.null(table2)){
return(NULL)
} else {
select_table2 <- table2()[input$table2_rows_selected,]
}
})
output$select_table1 <- DT::renderDataTable(DT::datatable(select_table1(), escape = FALSE, options = list(paging = t, pageLength = 6)))
output$select_table2 <- DT::renderDataTable(select_table2(), escape = FALSE, options = list(paging = t, pageLength = 6))
}
shinyApp(ui = ui, server = server)
Disabled your uploading part. You need to change it back.