问题描述
我正在处理从网站刮掉的凌乱表格，为了使日期列更有用，我需要清理刮掉的东西。我们的数据如下所示：
mydata <- structure(list(Dates = c("Sep\r\n \r\n 10 - 13","Oct\r\n \r\n 8 - 11","Oct 29 - Nov 1","Nov\r\n \r\n 19 - 22","Jan\r\n \r\n 21 - 24","Mar\r\n \r\n 4 - 7","Apr 29 - May 2"),points = c("500","500","550","500"
)),row.names = c(1L,5L,8L,11L,16L,23L,32L),class = "data.frame")
> mydata
Dates points
1 Sep\r\n \r\n 10 - 13 500
5 Oct\r\n \r\n 8 - 11 500
8 Oct 29 - Nov 1 500
11 Nov\r\n \r\n 19 - 22 500
16 Jan\r\n \r\n 21 - 24 500
23 Mar\r\n \r\n 4 - 7 550
32 Apr 29 - May 2 500
Dates中的每个日期都是一个日期范围，实际上应该是startDate和endDate。然后我们要创建的是：
> newdata
StartDate EndDate points
1 20200910 20200913 500
1 20201008 20201011 500
1 20201029 20201101 500
1 20201119 20201122 500
1 20210121 20210124 500
1 20210304 20210307 500
1 20210429 20210502 500
我们可以假设9月至12月的所有日期都是2020年，而1月至8月的所有日期都是2021年。
编辑1
这也许不是最干净的代码，但是我成功地将Dates列分为两列
cleaning_dates_df <- do.call('rbind',strsplit(mydata$Dates,'-')) %>% as.data.frame()
colnames(cleaning_dates_df) <- c('start','end')
cleaning_dates_df$start <- as.character(cleaning_dates_df$start)
cleaning_dates_df$end <- as.character(cleaning_dates_df$end)
cleaning_dates_df <- cleaning_dates_df %>%
dplyr::mutate(end = ifelse(nchar(end) > 4,end,paste0(trimws(sub("\r\n.*","",start)),end))) %>%
dplyr::mutate(start = ifelse(nchar(start) < 8,start,sub(".*\\s",start)))) %>%
dplyr::mutate(end = trimws(end)) %>% dplyr::mutate(start = trimws(start))
head(cleaning_dates_df,8)
...仍然需要转换为YYYYMMDD
解决方法
我不会称它为漂亮，但是您可以使用regex首先抓取所有部分：
rgx <- "^([a-z]+)(\\r|\\n|\\s)+(\\d+)\\s\\-\\s([a-z]+)*\\s*(\\d+)$"
td <- strcapture(rgx,tolower(mydata$Dates),proto=list(mth1="",x="",day1="",mth2="",day2=""))
仅提及一个月时重复一个月：
td$mth2[td$mth2 == ''] <- td$mth1[td$mth2 == '']
将月份转换为数字，然后确定是2020还是2021：
td[c("mth1","mth2")] <- lapply(td[c("mth1","mth2")],function(x) match(x,tolower(month.abb)))
td[c("yr1","yr2")] <- lapply(td[c("mth1",function(x) ifelse(x >= 9,2020,2021) )
从各个部分构造日期：
mydata$startdate <- as.Date(paste(td$yr1,td$mth1,td$day1,sep="/"))
mydata$enddate <- as.Date(paste(td$yr2,td$mth2,td$day2,sep="/"))
完成！：
mydata
# Dates points startdate enddate
#1 Sep\r\n \r\n 10 - 13 500 2020-09-10 2020-09-13
#5 Oct\r\n \r\n 8 - 11 500 2020-10-08 2020-10-11
#8 Oct 29 - Nov 1 500 2020-10-29 2020-11-01
#11 Nov\r\n \r\n 19 - 22 500 2020-11-19 2020-11-22
#16 Jan\r\n \r\n 21 - 24 500 2021-01-21 2021-01-24
#23 Mar\r\n \r\n 4 - 7 550 2021-03-04 2021-03-07
#32 Apr 29 - May 2 500 2021-04-29 2021-05-02
您可以尝试：
library(lubridate)
library(dplyr)
d <- do.call(rbind,lapply(str_split(gsub("[\v-]"," ",mydata$Dates),"\\s+"),function(x) if (length(x) == 3) append(x,x[1],after = 2) else x) )
start_date <- as.Date(paste(d[,1],d[,2],"2020",sep = "-"),format = "%b-%d-%Y")
end_date <- as.Date(paste(d[,3],4],format = "%b-%d-%Y")
start_date <- if_else(month(start_date) < 9,start_date + years(1),start_date)
end_date <- if_else(month(end_date) < 9,end_date + years(1),end_date)
data.frame(start_date,end_date,mydata$points)
start_date end_date mydata.points
1 2020-09-10 2020-09-13 500
2 2020-10-08 2020-10-11 500
3 2020-10-29 2020-11-01 500
4 2020-11-19 2020-11-22 500
5 2021-01-21 2021-01-24 500
6 2021-03-04 2021-03-07 550
7 2021-04-29 2021-05-02 500
除非您有理由不这样做，否则最好将数据保留为日期格式。但是，如果您需要它们作为显示的字符串，则可以使用format()，例如：
format(start_date,"%Y%m%d")
这是一个凌乱的Base R解决方案：
# Function to pad dateparts: pad_dateparts => function()
pad_dateparts <- function(date_vec){
return(ifelse(nchar(date_vec) == 1,paste0("0",date_vec),date_vec))
}
# Store the months for each obersvation: months_ => list of characters
months_ <-
lapply(regmatches(mydata$Dates,gregexpr(
paste0(month.abb,collapse = "|"),mydata$Dates)),function(x) {
if (length(x) == 1) {
pad_dateparts(match(rep(x,2),month.abb))
} else{
pad_dateparts(match(x,month.abb))
}
}
)
# Store the day numbers for each obersvation: days_ => list of characters
days_ <- lapply(sapply(trimws(gsub('\\D+',' ',"both"),strsplit,pad_dateparts)
# Function to increment years from ordered vector of month parts:
# increment_years => function()
increment_years <- function(start_year,ordered_month_vec){
return(start_year + cumsum(c(FALSE,diff(as.integer(ordered_month_vec)) < 0)))
}
# Store the year parts: years_ => list of data.frames
years_ <- split(apply(data.frame(do.call(rbind,months_)),2,function(x){increment_years(2020,x)}),seq_along(months_))
# Create the required data.frame: clean_df => data.frame
clean_df <- cbind(setNames(
data.frame(
do.call(rbind,Map(function(x,y,z) {
as.integer(paste0(x,z))
},years_,months_,days_)),row.names = NULL,stringsAsFactors = FALSE
),c("StartDate","EndDate")
),Points = mydata$points)
数据：
mydata <- structure(list(Dates = c("Sep\r\n \r\n 10 - 13","Oct\r\n \r\n 8 - 11","Oct 29 - Nov 1","Nov\r\n \r\n 19 - 22","Jan\r\n \r\n 21 - 24","Mar\r\n \r\n 4 - 7","Apr 29 - May 2"),points = c("500","500","550","500"
)),row.names = c(1L,5L,8L,11L,16L,23L,32L),class = "data.frame")