Как проверить число c типов данных отредактированных ячеек с блестящими / датированными данными? - PullRequest
Новая
       17

Как проверить число c типов данных отредактированных ячеек с блестящими / датированными данными?

2 голосов
/ 27 апреля 2020

У меня есть дата (DT) со столбцом числового типа c. Пользователи могут редактировать ячейки этого столбца, но я хочу проверить, является ли их ввод действительным числом.

Проблема, с которой я столкнулся: input$myDT_cell_edit в любом случае возвращает строку, например, "25.15" Если я преобразую его с as.numeric() в число, я получаю предупреждение, когда ввод не является действительным числом, например, «25m15». (Может, мне стоит просто отключить это предупреждение?)

Я пробовал три разных решения, но все они довольно сложны. Интересно, не существует ли намного более простого решения, более родного для DT, поскольку проверка правильности типа ввода является стандартной проблемой. Возможно, я мог бы использовать рендеринг столбцов , но мне не хватает необходимых JavaScript знаний.

Я уже решил проблему. Но так как я новичок в программировании на R, Shiny и DT, я хотел бы узнать, что мне чего-то не хватает.

Ниже приведен минимальный пример (REPREX) для демонстрации того, что я пробовал. 

``` r
library(shiny)
library(DT)
#> 
#> Attaching package: 'DT'
#> The following objects are masked from 'package:shiny':
#> 
#>     dataTableOutput, renderDataTable
library(tibble)

df <- tibble::as_tibble(c(20:25))

ui <- fluidPage(
        fluidRow(column(1,DT::DTOutput("myDT")))
)

server <- function(input, output, session) {
    data <- reactiveValues(df = df)

    showData <- reactive({
        DT::datatable(
            data$df,
            options = list(
                dom = 't',
                autoWidth = TRUE,
                columnDefs = list(
                    list(width = '75px', targets = c(0,1)),
                    list(type = 'natural', targets = 0)
                )
            ),
            colnames = c('ID' = 1),
            plugins = 'natural',
            editable = list(
                target = "cell", disable = list(columns = 0))
        )

    })

    output$myDT <- DT::renderDT({showData()})

    #####

    ########################################### first version
    # checkValue <-  function(info) {
    #     k = NULL
    #     i = info$row
    #     j = info$col
    #     k =  tryCatch({
    #         as.numeric(info$value)
    #         }, warning = function(war) {
    #             k <<- as.numeric(data$df[i,j][[1]])
    #         }, finally = {
    #             k = as.numeric(k)
    #         })
    #     data$df[i,j][[1]] = k
    #     data$df
    # }

    ########################################## second version
    # checkValue <- function(info) {
    #     v = "[\\!#$%&()*/:;<=>?@_`|~{}ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz ]"
    #     i = info$row
    #     j = info$col
    #     k = info$value
    #     if (regexec(v, k) == -1) {
    #         data$df[i,j][[1]] = as.numeric(k)
    #     }
    #     data$df
    # }

    ########################################## third version
    checkValue <- function(info) {
        i = info$row
        j = info$col
        oldValue  <-  data$df[i,j][[1]]
        newValue = suppressWarnings(isolate(DT::coerceValue(info$value, as.double(oldValue))))
        if (!is.na(newValue)) {data$df[i,j][[1]] <- newValue}
        data$df
    }

    observeEvent(input$myDT_cell_edit, {
        showData <- DT::replaceData(
            DT::dataTableProxy("myDT"),
            checkValue(input$myDT_cell_edit),
            resetPaging = FALSE
        )
    })


}

shinyApp(ui, server)
#> 
#> Listening on http://127.0.0.1:4640
```

![](https://i.imgur.com/OKAwOKL.png)

<sup>Created on 2020-04-27 by the [reprex package](https://reprex.tidyverse.org) (v0.3.0)</sup>
...