r - 如何允许用户在闪亮的数据表中将表格内容编辑为全新的值（例如数字到文本）

Question

我试图让用户在闪亮的数据表的某些单元格中编辑信息。在需要将数字更改为文本或添加新文本的情况下，如何防止新输入被强制转换为 NA？

我遇到的另一个问题是，如何允许用户编辑反应表（示例代码中的 table1）？

library(shiny)
library(datasets)
library(dplyr)
library(ggplot2)
library(plotly)
library(DT)
library(crosstalk)
library(tibble)

######I generated a random list using the mpg data set 

data('mpg')
mpg = data.frame(mpg)

nmpg = c()
for (i in 1:dim(mpg)[2]) {
  nmpg = cbind(nmpg, sample(x = mpg[, i], size = 2000, replace = T))
  i = i+1
}
nmpg = data.frame(nmpg)
colnames(nmpg) = c('Manufacturer', 'Model', 'Engine.Displacement', 
                   'Manufacture.Year', 'Cylinder', 'Transmission', 
                   'Drive.Model', 'City.MPG', 'Highway.MPG', 'Fuel.Type',
                   'Class')

nmpg$Milage = sample(50000:300000, dim(nmpg)[1], replace = T)
nmpg$Life.Time = sample(seq(0.2, 20, by=0.1), dim(nmpg[1]), replace = T)
nmpg$For.Commercial = sample(c(0, 1), dim(nmpg)[1], replace = T )


for(i in 1:dim(nmpg)[2]){
  nmpg[, i] =type.convert(nmpg[,i])
  i = i+1
}


runApp( list(
  ui = fluidPage(

   # Application title
   titlePanel("MPG analysis"),

   # Sidebar with dropdown menu seletion input for key measuring component
   sidebarLayout(
      sidebarPanel(
        br(),
        br(),
        selectInput('inputM', 'Measuring: ', 
                    colnames(nmpg), selected = colnames(nmpg)[9]),
        selectInput('inputC1', 'Grouping Category: ', 
                    colnames(nmpg), selected = colnames(nmpg)[1]),
        selectInput('inputF1', 'Filtering Column: ',
                    colnames(nmpg), selected = colnames(nmpg)[2]),
        uiOutput('filter'),
        p(downloadButton('x0', 'Download Selected Data', class = 'text-center'))
      ),

      # Mainpanel is seprated into several tabs using the tablsetPanel function
      mainPanel(
        tabsetPanel(
          tabPanel('Plots', plotlyOutput('barPlot1')),
          tabPanel('Different Plots', plotlyOutput('barPlot2')),
          tabPanel('Table1', DTOutput('table1')),
          tabPanel('Table2', DTOutput('table2'))

          )
        )
      )
   ), #right ) for ui


  # Define server logic required to analzye the data and generate outputs
  server = function(input, output) {


    output$filter = renderUI({
      selectInput('inputF2', 'Filter Item: ', 
                  c('No Filter', unique(nmpg %>% select(input$inputF1))))
      })


    nmpg_sub = reactive({

      if (req(input$inputF2) != 'No Filter'){
        nmpg_sub = nmpg %>% filter_at(vars(input$inputF1), 
                                    any_vars(. == input$F2))
        }
      else{ 
        nmpg_sub = nmpg
        }
      return(nmpg_sub)

      })


    nmpg_grouped = reactive({
      nmpg_sub() %>% 
        group_by_at(input$inputC1) %>%
        summarize(Total.Cars = n(), 
                  Commercial.Cars = sum(For.Commercial),
                  Ave = mean(!!rlang::sym(input$inputM)),
                  Trip.Total = sum(Milage),
                  Year.Total = sum(Life.Time)
                  ) %>% 
        mutate(Ave.Annual.Milage = Trip.Total / Year.Total,
               ) %>%
        arrange(desc(Total.Cars))
      })




    output$table1 = renderDT({
      datatable(nmpg_grouped(), editable = 'cell', 
                class = 'cell-border stripe hover responsive compact', 
                caption = htmltools::tags$caption(
                  stype = 'caption-side: top; text-align: left;',
                  htmltools::strong('Table 1: '), 
                  htmltools::em('this is testing data'))
                )  %>% 
        formatStyle('Ave', backgroundColor= styleInterval(15, c('default', 'yellow')),
                  fontWeight = styleInterval(15, c('normal', 'bold'))
                  )
      })


    options(DT.options = list(pageLength = 25))

    output$table2 = renderDT({
      datatable(nmpg, editable = 'cell', 
                class = 'cell-border stripe hover responsive compact', 
                caption = htmltools::tags$caption(
                  stype = 'caption-side: top; text-align: left;',
                  htmltools::strong('Table 1: '), 
                  htmltools::em('this is testing data'))
                ) 
      })


    observeEvent(input$table2_cell_edit, {
      nmpg <<- editData(nmpg, input$table2_cell_edit, 
                                'table2')
      save(nmpg, file = 'InteractiveTable.RData')

    })






    } #server right ) 



))  #right )) for runApp and list

标签： rshinydt