Автоматически определять столбцы даты при чтении файла в data.frame

При чтении файла функция read.table использует type.convert, чтобы различать логические, целочисленные, числовые, сложные или столбцы факторов и сохранять их соответственно.

Я хотел бы добавить даты в микс, чтобы столбцы, содержащие даты, могли автоматически распознаваться и анализироваться в объекты Date. Должно быть распознано только несколько форматов даты, например.

date.formats <- c("%m/%d/%Y", "%Y/%m/%d")

Вот пример:

fh <- textConnection(

 "num  char date-format1  date-format2  not-all-dates  not-same-formats
   10     a     1/1/2013    2013/01/01     2013/01/01          1/1/2013
   20     b     2/1/2013    2013/02/01              a        2013/02/01 
   30     c     3/1/2013            NA              b          3/1/2013"
)

И вывод

dat <- my.read.table(fh, header = TRUE, stringsAsFactors = FALSE,
                     date.formats = date.formats)
sapply(dat, class)

даст:

num              => numeric
char             => character
date-format1     => Date
date-format2     => Date
not-all-dates    => character
not-same-formats => character   # not a typo: date format must be consistent

Прежде чем я пойду и реализую его с нуля, что-то подобное уже доступно в пакете? Или, может быть, кто-то уже дал ему трещину (или будет) и готов поделиться своим кодом здесь? Спасибо.

Ответ 1

Здесь я быстро выбросил. Он не обрабатывает последний столбец должным образом, потому что функция as.Date недостаточно строгая (см., Например, что as.Date("1/1/2013", "%Y/%m/%d") обрабатывает ok...)

my.read.table <- function(..., date.formats = c("%m/%d/%Y", "%Y/%m/%d")) {
   dat <- read.table(...)
   for (col.idx in seq_len(ncol(dat))) {
      x <- dat[, col.idx]
      if(!is.character(x) | is.factor(x)) next
      if (all(is.na(x))) next
      for (f in date.formats) {
         d <- as.Date(as.character(x), f)
         if (any(is.na(d[!is.na(x)]))) next
         dat[, col.idx] <- d         
      }
   }
   dat
}

dat <- my.read.table(fh, header = TRUE, stringsAsFactors = FALSE)
as.data.frame(sapply(dat, class))

#                  sapply(dat, class)
# num                         integer
# char                      character
# date.format1                   Date
# date.format2                   Date
# not.all.dates             character
# not.same.formats               Date

Если вы знаете способ синтаксического анализа дат, который более строг в форматах, чем as.Date (см. пример выше), сообщите мне.

Изменить. Чтобы сделать синтаксический анализ даты более строгим, я могу добавить

if (!identical(x, format(d, f))) next

Чтобы он работал, мне понадобятся все мои входные даты с нулевыми ведущими нулями, т.е. 01/01/2013, а не 1/1/2013. Я могу жить с этим, если это стандартный способ.

Ответ 2

Вы можете использовать lubridate::parse_date_time, который немного строже (и создает данные POSIXlt).

Я также добавил немного больше проверки существующих значений NA (может и не понадобиться).

например,

library(lubridate)
my.read.table <- function(..., date.formats = c("%m/%d/%Y", "%Y/%m/%d")) {
  dat <- read.table(...)
  for (col.idx in seq_len(ncol(dat))) {
    x <- dat[, col.idx]
    if(!is.character(x) | is.factor(x)) next
    if (all(is.na(x))) next
    for (format in date.formats) {
      complete.x <- !(is.na(x))
      d <- as.Date(parse_date_time(as.character(x), format, quiet = TRUE))
      d.na <- d[complete.x]
      if (any(is.na(d.na))) next
      dat[, col.idx] <- d         
    }
  }
  dat

}

 dat <- my.read.table(fh, stringsAsFactors = FALSE,header=TRUE)

str(dat)
'data.frame':   3 obs. of  6 variables:
 $ num             : int  10 20 30
 $ char            : chr  "a" "b" "c"
 $ date.format1    : Date, format: "2013-01-01" "2013-02-01" "2013-03-01"
 $ date.format2    : Date, format: "2013-01-01" "2013-02-01" NA
 $ not.all.dates   : chr  "2013/01/01" "a" "b"
 $ not.same.formats: chr  "1/1/2013" "2013/02/01" "3/1/2013"

Альтернативой может быть использование options(warn = 2) внутри функции и перенос parse_date_time(...) в оператор try

my.read.table <- function(..., date.formats = c("%m/%d/%Y", "%Y/%m/%d")) {
  dat <- read.table(...)
  owarn <-getOption('warn')
  on.exit(options(warn = owarn))
  options(warn = 2)
  for (col.idx in seq_len(ncol(dat))) {
    x <- dat[, col.idx]
    if(!is.character(x) | is.factor(x)) next
    if (all(is.na(x))) next
    for (format in date.formats) {
      d <- try(as.Date(parse_date_time(as.character(x), format)), silent= TRUE)

      if (inherits(d, 'try-error')) next
      dat[, col.idx] <- d         
    }
  }
  dat

}

Ответ 3

Вы можете попробовать с регулярными выражениями.

my.read.table <- function(..., date.formats = c("%m/%d/%Y", "%Y/%m/%d")) {
   require(stringr)
   formats <- c(
     "%m" = "[0-9]{1,2}",
     "%d" = "[0-9]{1,2}",
     "%Y" = "[0-9]{4}"
   )
   dat <- read.table(...)
   for (col.idx in seq_len(ncol(dat))) {
      for (format in date.formats) {
         x <- dat[, col.idx]
         if(!is.character(x) | is.factor(x)) break
         if (all(is.na(x))) break
         x <- as.character(x)
         # Convert the format into a regular expression
         for( k in names(formats) ) {
           format <- str_replace_all( format, k, formats[k] )
         }
         # Check if it matches on the non-NA elements
         if( all( str_detect( x, format ) | is.na(x) ) ) {
           dat[, col.idx] <- as.Date(x, format)
           break
         }
      }
   }
   dat
}

dat <- my.read.table(fh, header = TRUE, stringsAsFactors = FALSE)
as.data.frame(sapply(dat, class))
#                  sapply(dat, class)
# num                         integer
# char                      character
# date.format1                   Date
# date.format2                   Date
# not.all.dates             character
# not.same.formats          character