在shinydashboard中创建javascript按钮

Question

我正在尝试遵循这个优秀的教程：https://thatdatatho.com/adding-action-buttons-in-rows-of-dt-data-table-in-r-shiny/将操作按钮添加到shinydashboard 中的 DT 表，但shinydashboard 中的某些内容似乎与 javascript 冲突，而是将按钮呈现为 html 文本而不是可点击的操作按钮。 有没有办法解决这个冲突？

library(shiny)
library(shinydashboard)
library(shinythemes)
library(tidyverse)
library(DT)

ui <- dashboardPage(
  
  dashboardHeader(
    title="Test"
  ),
  dashboardSidebar(),

  dashboardBody(
    
    column(12,    
  
    
    box(
      title = "Available",
      status = "primary",
      solidHeader = TRUE,
      collapsible = TRUE,
      DTOutput("table1", height = "300px")
    ), # Close box
  
    fluidRow(

    box(
      title = "Current",
      status = "primary",
      background = "green",
      solidHeader = TRUE,
      collapsible = TRUE,
      DTOutput('table2')
    ), # Close box
    
    box(
      title = "Past",
      status = "primary",
      background = "red",
      solidHeader = TRUE,
      collapsible = TRUE,
      DTOutput('table3')
    ) # Close box
    ) # Close row
  )
  )# Close fluid row
) # Close UI


shiny::includeScript("script.js")


# Create button function
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>'
                     ))
}

# Add buttons to the data frame

x = create_btns(1:32)
mtcars = mtcars  %>%
  dplyr::bind_cols(tibble("Buttons" = x))

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$table1 <- renderDT(mtcars, options =
                              list(scrollX = TRUE, pageLength = 25), editable = FALSE, rownames = FALSE)

  output$table2 = renderDT(mtcars, options =
                             list(scrollX = TRUE), editable = FALSE, rownames = FALSE)
  
  output$table3 = renderDT(mtcars, options =
                             list(scrollX = TRUE), editable = FALSE, rownames = FALSE)
}

# Run the application
shinyApp(ui = ui, server = server)

Answer 1

在renderDT中，添加escape = FALSE:

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$table1 <- renderDT(mtcars, options =
                              list(scrollX = TRUE, pageLength = 25), editable = FALSE, rownames = FALSE, escape = F)
  
  output$table2 = renderDT(mtcars, options =
                             list(scrollX = TRUE), editable = FALSE, rownames = FALSE, escape = F)
  
  output$table3 = renderDT(mtcars, options =
                             list(scrollX = TRUE), editable = FALSE, rownames = FALSE, escape = F)
}