Автоматически определять столбцы даты при чтении файла в 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
