tự động phát hiện các cột ngày khi đọc một tệp vào một data.frame

Question

Khi đọc tệp, hàm read.table sử dụng type.convert để phân biệt giữa các cột logic, số nguyên, số, phức hoặc yếu tố và lưu trữ chúng tương ứng.

Tôi muốn thêm ngày vào danh sách kết hợp để các cột chứa ngày có thể tự động được nhận dạng và phân tích cú pháp thành các đối tượng Date. Chỉ một vài định dạng ngày phải được nhận dạng, ví dụ:

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

Dưới đây là một ví 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" 
) 

Và đầu ra của

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

sẽ cung cấp cho:

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 

Trước khi tôi đi và thực hiện nó từ đầu, là một cái gì đó như thế này đã có sẵn trong một gói? Hoặc có thể ai đó đã cho nó một vết nứt (hoặc sẽ) và sẵn sàng chia sẻ mã của mình ở đây? Cảm ơn bạn.

Answer 1

Ở đây tôi đã ném nhanh một cái. Nó không phải là xử lý cột cuối cùng đúng vì as.Date chức năng là không đủ nghiêm ngặt (thấy rằng as.Date("1/1/2013", "%Y/%m/%d") phân tích ok ví dụ ...)

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 

Nếu bạn biết một cách để phân tích ngày đó là nghiêm ngặt hơn xung quanh các định dạng hơn as.Date (xem ví dụ ở trên), vui lòng cho tôi biết.

Sửa: Để thực hiện ngày phân tích cú pháp siêu nghiêm ngặt, tôi có thể thêm

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

Đối với nó để làm việc, tôi sẽ cần tất cả các đầu vào của tôi vị để có zero hàng đầu khi cần thiết, ví dụ 01/01/2013 và không 1/1/2013 . Tôi có thể sống với điều đó nếu đó là cách tiêu chuẩn.

Answer 2

Bạn có thể thử với các cụm từ thông dụng.

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 

Answer 3

Bạn có thể sử dụng lubridate::parse_date_time, đó là một chút chặt chẽ hơn (và tạo POSIXlt) dữ liệu.

Tôi cũng đã thêm kiểm tra thêm một chút cho các giá trị NA hiện có (có thể không cần thiết).

ví dụ

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" 

Một thay thế sẽ được sử dụng options(warn = 2) trong chức năng và quấn parse_date_time(...) trong một tuyên bố thử

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 

}