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.

The post Adding Action Buttons in Rows of DT Data Table in R Shiny appeared first on .