R Shiny：处理“.checkTypos 中的错误”

问题描述 投票：0回答：1

我有一个 

data.table
，有两列：“日期”和“Col2”。为了使用这个 data.table，我构建了一个具有以下两个功能的闪亮应用程序。第一个功能不允许在“日期”列中放入任何类型的字符串，而只能放入日期。第二个功能与 
dateRangeInput()
有关。

当我运行仅包含其中一项功能的 

shinyApp()
时，它运行良好。然而，当我将这两种功能放在一个代码中时，我得到了一个 
Error in .checkTypos: text string does not conform to standard unambiguous format
并且闪亮的应用程序崩溃了。当我在“日期”列中写入一些文本而不是从下拉日历中选择或手动输入正确格式的日期时，会弹出此错误。

我尝试了很多组合和改变，但都无法避免这个错误。 有人可以告诉我代码中缺少什么或做错了什么吗？

您可以在下面找到我的集成了这两种功能的代码。

 library(shiny)
 library(shinydashboard)
 library(rhandsontable)
 library(data.table)
 library(shinyalert)

 DF1 <- data.table(
             "Date" = as.character(NA),
             "Col2" = as.character(NA),
                 stringsAsFactors = FALSE)

 DF2 <- data.table(
             "Date" = as.character(NA),
             "Col2" = as.character(NA),
                 stringsAsFactors = FALSE)

 ui <- fluidPage(
   dashboardPage(
     dashboardHeader(title = NULL),
     dashboardSidebar(
       sidebarMenu(
         menuItem("reprex", tabName = "table1")
     )
   ),
   dashboardBody(
       tabItems(
         tabItem(tabName = "table1",
           fluidRow(
             column(
               width = 6,
               label = NULL,
               rHandsontableOutput("table1Item1")
             ),
             column(
               width = 6,
               "Choose btw Date and Col2",
               selectInput("choices", label=NULL,
                           choices = c("Filter by Date", "Filter by Col2")),
               uiOutput("nested_ui1")
             ),
             column(
               width = 6,
               label=NULL,
               rHandsontableOutput("table1Item2")
             )
           )
         )
       )
     )
   )
 )
 server = function(input, output, session) {

   data <- reactiveValues()

   observe({
     data$df1 <- as.data.table(DF1)
     data$df2 <- as.data.table(DF2)
   })

 observeEvent(input$table1Item1, {
   if (!is.null(input$table1Item1)) {
     data$df1 <- hot_to_r(input$table1Item1)

     if (any(is.character(as.Date(data$df1$`Date`, format = "%Y-%m-%d")))) {
        return()
     }
        data$df1$`Date` <- format(as.Date(data$df1$`Date`, format = "%Y-%m-%d"), "%Y-%m-%d")
     }
 })

 observe({
     if (!is.null(input$table1Item1) && !any(is.na(input$dates1))) {
             data$df1 <- hot_to_r(input$table1Item1) 

     if (!any(is.na(input$dates1)) && input$choices == "Filter by Date") {
         from=as.Date(input$dates1[1L])
         to=as.Date(input$dates1[2L])
         if (from>to) to = from
         selectdates1 <- seq.Date(from=from, to=to, by = "day")
         data$df2 <- data$df1[as.Date(data$df1$"Date") %in% selectdates1, ]
     } else if (!is.null(input$text) && input$choices == "Filter by Col2") {
         data$df2 <- data$df1[data$df1$"Col2" == input$text, ]
     } else {
         selectdates2 <- unique(data$df1$"Date")
         data$df2 <- data$df1[data$df1$"Date" %in% selectdates2, ]
     }
   }
 })  

   output$table1Item1 <- renderRHandsontable({
     rhandsontable(data$df1, stretchH = "all", height = 300) |>
       hot_col(1, dateFormat = "YYYY-MM-DD", type = "date")
  })

   output$nested_ui1 <- renderUI({
     if (input$choices == "Filter by Date") {
         dateRangeInput("dates1", "Filter by Date:", format="yyyy-mm-dd",
                        start = Sys.Date(), end = Sys.Date(), separator = "-")
   } else if (input$choices == "Filter by Col2") {
    textInput("text", "Filter by Col2:")
   }
 })

 output$table1Item2 <- renderRHandsontable({
   rhandsontable(data$df2)
 })

 }

 shinyApp(ui, server)
r shiny error-handling
1个回答
0
投票

一个简单的修复方法是在 

allowInvalid = FALSE
调用中设置 
rhandsontable
：

library(shiny)
library(shinydashboard)
library(rhandsontable)
library(data.table)
library(shinyalert)

DF1 <- data.table(
  "Date" = as.character(NA),
  "Col2" = as.character(NA),
  stringsAsFactors = FALSE)

DF2 <- data.table(
  "Date" = as.character(NA),
  "Col2" = as.character(NA),
  stringsAsFactors = FALSE)

ui <- fluidPage(
  dashboardPage(
    dashboardHeader(title = NULL),
    dashboardSidebar(
      sidebarMenu(
        menuItem("reprex", tabName = "table1")
      )
    ),
    dashboardBody(
      tabItems(
        tabItem(tabName = "table1",
                fluidRow(
                  column(
                    width = 6,
                    label = NULL,
                    rHandsontableOutput("table1Item1")
                  ),
                  column(
                    width = 6,
                    "Choose btw Date and Col2",
                    selectInput("choices", label=NULL,
                                choices = c("Filter by Date", "Filter by Col2")),
                    uiOutput("nested_ui1")
                  ),
                  column(
                    width = 6,
                    label=NULL,
                    rHandsontableOutput("table1Item2")
                  )
                )
        )
      )
    )
  )
)
server = function(input, output, session) {
  
  data <- reactiveValues()
  
  observe({
    data$df1 <- as.data.table(DF1)
    data$df2 <- as.data.table(DF2)
  })
  
  observeEvent(input$table1Item1, {
    if (!is.null(input$table1Item1)) {
      data$df1 <- hot_to_r(input$table1Item1)
      
      if (any(is.character(as.Date(data$df1$`Date`, format = "%Y-%m-%d")))) {
        return()
      }
      data$df1$`Date` <- format(as.Date(data$df1$`Date`, format = "%Y-%m-%d"), "%Y-%m-%d")
    }
  })
  
  observe({
    if (!is.null(input$table1Item1) && !any(is.na(input$dates1))) {
      data$df1 <- hot_to_r(input$table1Item1) 
      
      if (!any(is.na(input$dates1)) && input$choices == "Filter by Date") {
        from=as.Date(input$dates1[1L])
        to=as.Date(input$dates1[2L])
        if (from>to) to = from
        selectdates1 <- seq.Date(from=from, to=to, by = "day")
        data$df2 <- data$df1[as.Date(data$df1$"Date") %in% selectdates1, ]
      } else if (!is.null(input$text) && input$choices == "Filter by Col2") {
        data$df2 <- data$df1[data$df1$"Col2" == input$text, ]
      } else {
        selectdates2 <- unique(data$df1$"Date")
        data$df2 <- data$df1[data$df1$"Date" %in% selectdates2, ]
      }
    }
  })  
  
  output$table1Item1 <- renderRHandsontable({
    rhandsontable(data$df1, stretchH = "all", height = 300, allowInvalid = FALSE) |>
      hot_col(1, dateFormat = "YYYY-MM-DD", type = "date")
  })
  
  output$nested_ui1 <- renderUI({
    if (input$choices == "Filter by Date") {
      dateRangeInput("dates1", "Filter by Date:", format="yyyy-mm-dd",
                     start = Sys.Date(), end = Sys.Date(), separator = "-")
    } else if (input$choices == "Filter by Col2") {
      textInput("text", "Filter by Col2:")
    }
  })
  
  output$table1Item2 <- renderRHandsontable({
    rhandsontable(data$df2)
  })
  
}

shinyApp(ui, server)
最新问题
© www.soinside.com 2019 - 2024. All rights reserved.