Adding Action Buttons in Rows of DT Data Table in R Shiny
January 19, 2021 By Pascal Schmidt R R Shiny
In this tutorial, we will be showing how to add action buttons to a DT data table in an R Shiny application. We will also be showing how to delete rows in a DT data table one by one in R Shiny, how to edit rows and how to add rows. We do all that without re-rendering the entire table. We will be using a proxy that replaces the data without rendering the table every time we update the data.
This little tutorial got inspired by this great application: https://tychobra.shinyapps.io/crud_traditional/
My application can be found here: https://pascal-schmidt.shinyapps.io/datatable-action-buttons/
First, we need to load the necessary libraries.
library(shiny) library(tidyverse) library(DT)
We then move on by creating the UI for the application. First, we are creating an action button that allows us to add cars later.
Creating the R Shiny UI
div( class = "container", div( style = "margin-top: 50px;", shiny::actionButton( inputId = "add_car", label = "Add Row", icon = shiny::icon("plus"), class = "btn-success" ) ) )
We give it a bit of styling, a green color, and an icon.
Next, we will be creating the DT data table in R Shiny.
div( class = "container", style = "margin-top: 50px;", DT::DTOutput(outputId = "dt_table", width = "100%") )
Again, we give it a little bit of styling. And that is it. The UI is done. Now we have to insert two buttons in every row of the R Shiny data table. One action button is used for deleting rows and the other one is used to edit rows. We will be creating the buttons with pure HTML code. When we are looking what the output looks like from an action button we can just copy and paste the result.
shiny::actionButton( inputId = "edit", label = "", icon = shiny::icon("trash"), class = "btn-danger" ) # <button class="btn btn-default action-button btn-danger" id="edit" type="button"> # <i class="fa fa-trash"></i> # </button>
We then copy paste the result and make a function out of it where we can create as many buttons as possible.
DT Data Table Action Buttons
create_btns <- function(x) { x %>% purrr::map_chr(~ paste0( '<div class = "btn-group"> <button class="btn btn-default action-button btn-info action_button" id="edit_', .x, '" type="button" onclick=get_id(this.id)><i class="fas fa-edit"></i></button> <button class="btn btn-default action-button btn-danger action_button" id="delete_', .x, '" type="button" onclick=get_id(this.id)><i class="fa fa-trash-alt"></i></button></div>' )) }
You can see that we changed some things here. First, we added a bootstrap class so the two buttons are next to each other. Then, we have to make sure that every id in the HTML is unique so we can identify the clicked row. I also added onlick=get_id(this.id)
inside the button. We have not created the function get_id()
yet, however, we will be creating it soon. It is going to be a JavaScript function that gives us back the id that we clicked. I also added a second button that is able to return a modal which lets us edit the specific DT data table row in R Shiny.
Next, we will be creating all the buttons and cbind
the character vector to the mtcars
data frame.
x <- create_btns(1:32) mtcars <- mtcars %>% tibble::rownames_to_column(var = "Car") %>% dplyr::bind_cols(tibble("Buttons" = x)) %>% dplyr::mutate(vs = ifelse(vs == 0, "V-shaped", "Straight")) %>% dplyr::mutate(am = ifelse(am == 0, "automatic", "manual"))
Let’s create the JavaScript function now.
R Shiny and JavaScript Communication
function get_id(clicked_id) { Shiny.setInputValue("current_id", clicked_id, {priority: "event"}); }
All we do is that we get the clicked id and send it to R with Shiny.setInputValue(“current_id”, clicked_id, {priority: “event”});
. We use {priority: “event”}
so that we get the id every time a button is clicked. If we would not include it, then we would only get the clicked id when the id changes. So when we click the button a second, third, … time, we won’t get any id back from JavaScript. That is why {priority: “event”}
is included.
Creating the DT Data Table in R Shiny With a Proxy
First we need to create some reactive values. df
is will be the data frame, dt_row
is showing us which row was clicked, add_or_edit
shows us if the user clicked adding a new row or just wants to modify it, edit_button
shows us if the user clicked on the edit button or trash button and keep_track_id
keeps track of the ids and makes sure there is no duplicate.
Then we use isolate
in the renderDT
function so the table is only rendered when we start the application. We then create a proxy where we only replace data and where there will not be any flickering when we update the data. This makes our application more efficient.
“`{r}
rv <- shiny::reactiveValues( df = mtcars, dt_row = NULL, add_or_edit = NULL, edit_button = NULL, keep_track_id = nrow(mtcars) + 1 ) output$dt_table <- DT::renderDT( { shiny::isolate(rv$df) }, escape = F, rownames = FALSE, options = list(processing = FALSE) ) proxy <- DT::dataTableProxy("dt_table") shiny::observe({ DT::replaceData(proxy, rv$df, resetPaging = FALSE, rownames = FALSE) })
Deleting Rows in DT Data Table R Shiny
Next, we will be deleting rows when the delete button is clicked. So input$current_id
is triggered when either the edit button or trash button is clicked. Therefore, I am saying that a requirement to run the observer is that delete
is contained in the id. If it is the case and the id is not NULL, then we can run the observer. With the help of the which function, we detect in which row the id is located. Then we remove that row with rv$df <- rv$df[-rv$dt_row, ]
.
### delete row shiny::observeEvent(input$current_id, { shiny::req(!is.null(input$current_id) & stringr::str_detect(input$current_id, pattern = "delete")) rv$dt_row <- which(stringr::str_detect(rv$df$Buttons, pattern = paste0("\\b", input$current_id, "\\b"))) rv$df <- rv$df[-rv$dt_row, ] })
Editing DT Data Table Button in R Shiny
# when edit button is clicked, modal dialog shows current editable row filled out shiny::observeEvent(input$current_id, { shiny::req(!is.null(input$current_id) & stringr::str_detect(input$current_id, pattern = "edit")) rv$dt_row <- which(stringr::str_detect(rv$df$Buttons, pattern = paste0("\\b", input$current_id, "\\b"))) df <- rv$df[rv$dt_row, ] modal_dialog( car = df$Car, mpg = df$mpg, cyl = df$cyl, hp = df$hp, disp = df$disp, drat = df$drat, wt = df$wt, qsec = df$qsec, vs = mtcars$vs, am = mtcars$am, gear = df$gear, carb = df$carb, selected_am = df$am, selected_vs = df$vs, edit = TRUE ) rv$add_or_edit <- NULL })
Now when the pattern of the id matches edit
then we run the observer above. We again get the row that was clicked with the which
function and then save that row in df
. Then a modal dialog pops up with the values of the row that was clicked. From there we can edit it and click the submit button. The modal function look like that:
modal_dialog <- function(car, mpg, cyl, hp, disp, drat, selected_vs, wt, qsec, vs, am, gear, carb, selected_am, edit) { if (edit) { x <- "Submit Edits" } else { x <- "Add New Car" } shiny::modalDialog( title = "Edit Car", div( class = "text-center", div( style = "display: inline-block;", shiny::textInput( inputId = "car_name", label = "Car Type", value = car, placeholder = "Input Car Type", width = "200px" ) ), div( style = "display: inline-block;", shiny::numericInput( inputId = "mpg", label = "Miles Per Gallon", value = mpg, width = "200px" ) ), div( style = "display: inline-block;", shiny::numericInput( inputId = "cyl", label = "Cylinders", value = cyl, width = "200px" ) ), div( style = "display: inline-block;", shiny::numericInput( inputId = "hp", label = "Horesepower", value = hp, width = "200px" ) ), div( style = "display: inline-block;", shiny::numericInput( inputId = "disp", label = "Displacement", value = disp, width = "200px" ) ), div( style = "display: inline-block;", shiny::numericInput( inputId = "drat", label = "Rear Axle Ratio", value = drat, width = "200px" ) ), div( style = "display: inline-block;", shiny::numericInput( inputId = "wt", label = "Weight", value = wt, width = "200px" ) ), div( style = "display: inline-block;", shiny::numericInput( inputId = "qsec", label = "1/4 Mile Time", value = qsec, width = "200px" ) ), div( style = "display: inline-block;", shiny::selectInput( inputId = "vs", label = "Engine", width = "200px", selected = selected_vs, choices = unique(vs) ) ), div( style = "display: inline-block;", shiny::selectInput( inputId = "am", label = "Transmission", width = "200px", selected = selected_am, choices = unique(am) ) ), div( style = "display: inline-block;", shiny::numericInput( inputId = "gear", label = "Number of Forward Gears", value = gear, width = "200px" ) ), div( style = "display: inline-block;", shiny::numericInput( inputId = "carb", label = "Number of Carburetors", value = carb, width = "200px" ) ) ), size = "m", easyClose = TRUE, footer = div( class = "pull-right container", shiny::actionButton( inputId = "final_edit", label = x, icon = shiny::icon("edit"), class = "btn-info" ), shiny::actionButton( inputId = "dismiss_modal", label = "Close", class = "btn-danger" ) ) ) %>% shiny::showModal() }
We then go on to submit the changes. We can see that this code chunk runs when rv$add_or_edit <- NULL
. This is because input$final_edit
is being used in two observers at the same time. We are using the same modal for adding and editing rows. Hence, the same submit button is used for adding and editing the table. In the code below we just get the text input values and put them in a tibble
. We then overwrite the current row with the new edited inputs by the user.
# when final edit button is clicked, table will be changed shiny::observeEvent(input$final_edit, { shiny::req(!is.null(input$current_id) & stringr::str_detect(input$current_id, pattern = "edit") & is.null(rv$add_or_edit)) rv$edited_row <- dplyr::tibble( Car = input$car_name, mpg = input$mpg, cyl = input$cyl, disp = input$disp, hp = input$hp, drat = input$drat, wt = input$wt, qsec = input$qsec, vs = input$vs, am = input$am, gear = input$gear, carb = input$carb, Buttons = rv$df$Buttons[rv$dt_row] ) rv$df[rv$dt_row, ] <- rv$edited_row })
Adding a New Row in DT Data Table and R Shiny
Now, when we add the car we will be using the same modal. However, the action for adding a car and editing a car is different. Therefore, rv$add_or_edit <- 1
. This ensures that the edit observer will not get triggered.
shiny::observeEvent(input$add_car, { modal_dialog( car = "", mpg = "", cyl = "", hp = "", disp = "", drat = "", wt = "", qsec = "", vs = mtcars$vs, am = mtcars$am, gear = "", carb = "", selected_am = NULL, selected_vs = NULL, edit = FALSE ) rv$add_or_edit <- 1 })
Instead, the observer below gets triggered.
shiny::observeEvent(input$final_edit, { shiny::req(rv$add_or_edit == 1) add_row <- dplyr::tibble( Car = input$car_name, mpg = input$mpg, cyl = input$cyl, disp = input$disp, hp = input$hp, drat = input$drat, wt = input$wt, qsec = input$qsec, vs = input$vs, am = input$am, gear = input$gear, carb = input$carb, Buttons = create_btns(rv$keep_track_id) ) rv$df <- add_row %>% dplyr::bind_rows(rv$df) rv$keep_track_id <- rv$keep_track_id + 1 })
The observer above gets triggered when rv$add_or_edit == 1
. There are ways where we could have solved the the modal button issue differently. We could have for example used an if else statement where we control the flow by checking which button was pressed, edit or add button. However, this solution works as well.
Lastly, we will be removing the modal when requested.
shiny::observeEvent(input$dismiss_modal, { shiny::removeModal() }) shiny::observeEvent(input$final_edit, { shiny::removeModal() })
The Entire Application
library(shiny) library(tidyverse) library(DT) source(here::here("datatable/modal_dialog.R")) ui <- fluidPage( # div(style = "display: none;", icon("refresh")), div( class = "container", div( style = "margin-top: 50px;", shiny::actionButton( inputId = "add_car", label = "Add Row", icon = shiny::icon("plus"), class = "btn-success" ) ) ), div( class = "container", style = "margin-top: 50px;", DT::DTOutput(outputId = "dt_table", width = "100%") ), shiny::includeScript("script.js") ) create_btns <- function(x) { x %>% purrr::map_chr(~ paste0( '<div class = "btn-group"> <button class="btn btn-default action-button btn-info action_button" id="edit_', .x, '" type="button" onclick=get_id(this.id)><i class="fas fa-edit"></i></button> <button class="btn btn-default action-button btn-danger action_button" id="delete_', .x, '" type="button" onclick=get_id(this.id)><i class="fa fa-trash-alt"></i></button></div>' )) } x <- create_btns(1:32) mtcars <- mtcars %>% tibble::rownames_to_column(var = "Car") %>% dplyr::bind_cols(tibble("Buttons" = x)) %>% dplyr::mutate(vs = ifelse(vs == 0, "V-shaped", "Straight")) %>% dplyr::mutate(am = ifelse(am == 0, "automatic", "manual")) # Define server logic required to draw a histogram server <- function(input, output, session) { rv <- shiny::reactiveValues( df = mtcars, dt_row = NULL, add_or_edit = NULL, edit_button = NULL, keep_track_id = nrow(mtcars) + 1 ) output$dt_table <- DT::renderDT( { shiny::isolate(rv$df) }, escape = F, rownames = FALSE, options = list(processing = FALSE) ) proxy <- DT::dataTableProxy("dt_table") shiny::observe({ DT::replaceData(proxy, rv$df, resetPaging = FALSE, rownames = FALSE) }) ### delete row shiny::observeEvent(input$current_id, { shiny::req(!is.null(input$current_id) & stringr::str_detect(input$current_id, pattern = "delete")) rv$dt_row <- which(stringr::str_detect(rv$df$Buttons, pattern = paste0("\\b", input$current_id, "\\b"))) rv$df <- rv$df[-rv$dt_row, ] }) # when edit button is clicked, modal dialog shows current editable row filled out shiny::observeEvent(input$current_id, { shiny::req(!is.null(input$current_id) & stringr::str_detect(input$current_id, pattern = "edit")) rv$dt_row <- which(stringr::str_detect(rv$df$Buttons, pattern = paste0("\\b", input$current_id, "\\b"))) df <- rv$df[rv$dt_row, ] modal_dialog( car = df$Car, mpg = df$mpg, cyl = df$cyl, hp = df$hp, disp = df$disp, drat = df$drat, wt = df$wt, qsec = df$qsec, vs = mtcars$vs, am = mtcars$am, gear = df$gear, carb = df$carb, selected_am = df$am, selected_vs = df$vs, edit = TRUE ) rv$add_or_edit <- NULL }) # when final edit button is clicked, table will be changed shiny::observeEvent(input$final_edit, { shiny::req(!is.null(input$current_id) & stringr::str_detect(input$current_id, pattern = "edit") & is.null(rv$add_or_edit)) rv$edited_row <- dplyr::tibble( Car = input$car_name, mpg = input$mpg, cyl = input$cyl, disp = input$disp, hp = input$hp, drat = input$drat, wt = input$wt, qsec = input$qsec, vs = input$vs, am = input$am, gear = input$gear, carb = input$carb, Buttons = rv$df$Buttons[rv$dt_row] ) rv$df[rv$dt_row, ] <- rv$edited_row }) shiny::observeEvent(input$add_car, { modal_dialog( car = "", mpg = "", cyl = "", hp = "", disp = "", drat = "", wt = "", qsec = "", vs = mtcars$vs, am = mtcars$am, gear = "", carb = "", selected_am = NULL, selected_vs = NULL, edit = FALSE ) rv$add_or_edit <- 1 }) shiny::observeEvent(input$final_edit, { shiny::req(rv$add_or_edit == 1) add_row <- dplyr::tibble( Car = input$car_name, mpg = input$mpg, cyl = input$cyl, disp = input$disp, hp = input$hp, drat = input$drat, wt = input$wt, qsec = input$qsec, vs = input$vs, am = input$am, gear = input$gear, carb = input$carb, Buttons = create_btns(rv$keep_track_id) ) rv$df <- add_row %>% dplyr::bind_rows(rv$df) rv$keep_track_id <- rv$keep_track_id + 1 }) ### remove edit modal when close button is clicked or submit button shiny::observeEvent(input$dismiss_modal, { shiny::removeModal() }) shiny::observeEvent(input$final_edit, { shiny::removeModal() }) } # Run the application shinyApp(ui = ui, server = server)
Additional Resources
If you liked this Shiny tutorial, you can check out some other cool tutorials that will make your R Shiny application more efficient.
- Dynamic tabs with insertTab and removeTab
- Dynamic tabs with plotly plots
- Communicating between R Shiny modules
- A reactive data table without the need to re-render the table when the data updates
Also, you can check out my website with my personal projects and shiny application at https://pascal-schmidt-ds.com/ The website was entirely build with Shiny.
Recent Posts
Recent Comments
- Kardiana on The Lasso – R Tutorial (Part 3)
- Pascal Schmidt on RSelenium Tutorial: A Tutorial to Basic Web Scraping With RSelenium
- Pascal Schmidt on Dynamic Tabs, insertTab, and removeTab For More efficient R Shiny Applications
- Gisa on Persistent Data Storage With a MySQL Database in R Shiny – An Example App
- Nicholas on Dynamic Tabs, insertTab, and removeTab For More efficient R Shiny Applications
Comments (12)
It’s a very nice one…. there is the Missing script.js information. please, paste to the article.. thanks
It is in there. Look at
function get_id(clicked_id) {
Shiny.setInputValue(“current_id”, clicked_id, {priority: “event”});
}
Also, the code is on my GitHub: https://github.com/Pascal-Schmidt/blog_posts/tree/master/datatable
thank you very much, appreciate it…it is working now
I am glad it helped
Great code and well explained. Thanks a lot!
Any way to get this to work in shinydashboard? I keep getting sourcing errors.
If anyone else is following this tutorial and using modules, the script.js file can be changed to:
function get_id(clicked_id) {
var new_id = clicked_id.substring(0, clicked_id.indexOf(“-“) + 1) + “current_id”;
Shiny.setInputValue(new_id, clicked_id, {priority: “event”});
}
To add the namespace in front of “current_id” 🙂
So this app only creates pre-defined, hardcoded number of buttons. Here:
x <- create_btns(1:32)
This makes that example pretty useless.
What if the number of records in the data table is greater than 32, like, it might be 10 000 000?
Then you can use the create_btns() function and do 1:10 000 000 and put the buttons in the table
Here is the correct approach:
https://levelup.gitconnected.com/how-to-add-custom-actionable-to-a-shiny-datatable-ffe26e22747b
and with some improvements:
query_data %>%
mutate(edit_col = glue(‘‘),
.before=1,
del_col=glue(‘‘)
)
improvements compared to source:
switched from Shiny.onInputChange to Shiny.setInputValue, added priority:event clause
this allows buttons to work every time, not only the first time.
Thanks for the comment
unable to insert full line of code
mutate(edit_col = glue(‘‘)