В пустом столбце типы столбцов меняются в зависимости от способа добавления первой строки.

Question

Я занимаюсь разработкой приложения Shiny, часть которого должна редактировать (изменять существующие значения, добавлять новые строки) в различные фрагменты. Необходимо отредактировать ряд элементов, каждый с разными именами столбцов и типами данных. Я хотел бы использовать универсальный редактор c. Каждый тиббл начинается пустым.

Я создаю тиббл с нулевыми строками и набранными столбцами. Это работает хорошо.

makeTibble <- function() {
  tibble(W=character(), X=numeric(), Y=logical(), Z=structure(NA_real_, class = "Date"))
}
v <- reactiveValues(data=makeTibble())

Когда я добавляю строку и манипулирую каждым столбцом напрямую, по имени, типы столбцов сохраняются:

observeEvent(input$addDirect, {
    v$data <- v$data %>% add_row(W="Testing...", X=pi, Y=TRUE, Z=as.Date("2020-04-29", origin="1970-01-01"))
  })

Но это будет означать наличие отдельного редактора для каждого столбца, и необходимость редактировать каждый редактор каждый раз, когда изменяется структура соответствующего элемента (что он и будет). Поэтому я попытался автоматизировать добавление новой строки:

newValues <- c("W"="Testing...", "X"=pi, "Y"=TRUE, "Z"=as.Date("2020-04-29")) 
observeEvent(input$addLoop, {
  columns <- v$data %>% dplyr::summarise_all(class) %>% tidyr::gather(variable, class)
  v$data <- v$data %>% add_row()
  for (f in columns$variable) {
    v$data <- v$data %>% mutate(!!f := newValues[f])
  }
})

Но это преобразует тип каждого столбца в таблице в символ. Не то, что я хочу. Поэтому я пытаюсь сохранить тип каждого столбца:

asTypedValue <- function(value, type) {
  print(paste0("type: ", type, "; value: ", value))
  switch(type, 
         "character"="Testing...",
         "logical"=TRUE,
         "numeric"=pi,
         "Date"=as.Date("2020-04-29", origin="1970-01-01")
   )
}

observeEvent(input$addTypedLoop, {
  columns <- v$data %>% summarise_all(class) %>% gather(variable, class)
  v$data <- v$data %>% add_row()
  targetRow <- nrow(v$data)
  for (col in columns$variable) {
    colClass <- (columns %>% filter(variable  == col))$class
    v$data <- v$data %>% mutate(!! col := ifelse(row_number() == targetRow, asTypedValue(newValues[col], colClass), !! col)) 
  }
})

Это работает для столбцов character, logical и numeric, но столбец Date преобразуется в dbl. Что я делаю не так?

Вот блестящее приложение foo, чтобы продемонстрировать, что происходит.

library(shiny)
library(tidyverse)

ui <- fluidPage(
  wellPanel(
    actionButton("reset", "Reset"),
    actionButton("addDirect", "Add row (direct manipulation)"),
    actionButton("addLoop", "Add row (apply loop)"),
    actionButton("addTypedLoop", "Add row (apply loop with typing)")
  ),
  wellPanel(
    verbatimTextOutput("tibble")
  )
)

server <- function(input, output) {
  newValues <- c("W"="Testing...", "X"=pi, "Y"=TRUE, "Z"=as.Date("2020-04-29"))

  makeTibble <- function() {
    tibble(W=character(), X=numeric(), Y=logical(), Z=structure(NA_real_, class = "Date"))
  }

  v <- reactiveValues(
    data=makeTibble()
  )

  output$tibble <- renderPrint({
    v$data
  })

  observeEvent(input$reset, {
    v$data <- makeTibble()
  })

  observeEvent(input$addDirect, {
    v$data <- v$data %>% add_row(W="Testing...", X=pi, Y=TRUE, Z=as.Date("2020-04-29", origin="1970-01-01"))
  })

  observeEvent(input$addLoop, {
    columns <- v$data %>% dplyr::summarise_all(class) %>% tidyr::gather(variable, class)
    v$data <- v$data %>% add_row()
    for (f in columns$variable) {
      v$data <- v$data %>% mutate(!!f := newValues[f])
    }
  })

  asTypedValue <- function(value, type) {
    print(paste0("type: ", type, "; value: ", value))
    switch(type, 
           "character"="Testing...",
           "logical"=TRUE,
           "numeric"=pi,
           "Date"=as.Date("2020-04-29", origin="1970-01-01")
    )
  }

  observeEvent(input$addTypedLoop, {
    columns <- v$data %>% summarise_all(class) %>% gather(variable, class)
    v$data <- v$data %>% add_row()
    targetRow <- nrow(v$data)
    for (col in columns$variable) {
      colClass <- (columns %>% filter(variable  == col))$class
      v$data <- v$data %>% mutate(!! col := ifelse(row_number() == targetRow, asTypedValue(newValues[col], colClass), !! col)) 
    }
  })
}

shinyApp(ui, server)

Заранее спасибо за помощь.

Answer 1

Здесь вы объединяете вектор атома c:

newValues <- c("W"="Testing...", "X"=pi, "Y"=TRUE, "Z"=as.Date("2020-04-29"))

Вектор атома c содержит элементы одного и того же режима, поэтому все приводится в символьный режим:

> newValues
                 W                  X                  Y                  Z 
      "Testing..." "3.14159265358979"             "TRUE"            "18381" 

Вместо этого используйте список:

newValues <- list("W"="Testing...", "X"=pi, "Y"=TRUE, "Z"=as.Date("2020-04-29"))

(а затем используйте newValues[[f]]).