Вставьте новый столбец в список фреймов данных, проанализировав имена дат

Question

У меня есть список фреймов данных, в которые я хотел бы вставить новый столбец в

df<- data_frame(first =seq(1:10), second = seq(1:10))
ldf <- list(df, df, df)
names(ldf) <- c('April 2018 ASP NDC-HCPCS Crosswalk', 'Apr 2019 ASP Pricing File', 'Jan 18 ASP Pricing File')

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

Используя приведенный выше пример, в кадре данных Crosswalk ASP NDC-HCPCS за апрель 2018 года будет новый столбец с именем date, который будет содержать «2018 Q2» для всех 10 строк, аналогично, в кадре данных файла цены ASP ASP за апрель 2019 года будетновый столбец даты, содержащий «2019 Q2» для всех строк и, наконец, файл ценообразования ASP 18 января будет иметь новый столбец даты с «2018 Q1»

Answer 1

Вот пример подхода, который вы можете использовать и улучшить. Вы, вероятно, должны сделать регулярное выражение более устойчивым - хотя это работает для вашего примера, я вижу ситуации, когда оно может потерпеть неудачу. Кроме того, это работает в течение 2000 лет и выше;вам нужно будет изменить его, если у вас есть более ранние даты. Дайте знать, если у вас появятся вопросы!

# Getting month indices
# Extracting month names
new_mon <- gsub(paste0(".*(", paste(c(month.name, month.abb), collapse = "|"), ").*"), "\\1", names(ldf))

# Subsetting a "quarter" vector by month name/abbreviation and taking nonmissing values
new_mon <- pmax(sort(rep(1:4, 3))[match(new_mon, month.name)],
                sort(rep(1:4, 3))[match(new_mon, month.abb)], na.rm = T)


# Getting the year indices and ading "20" if there are only two characters
new_year <- gsub(".*?([0-9]{2,4}).*", "\\1", names(ldf)) # This is good for your example but you can make it more robust
new_year <- ifelse(nchar(new_year) == 2, paste0("20", new_year), new_year)    



# Pasting them Together
new_cols <- paste0(new_year, " Q", new_mon)

Результаты :

# Adding the columns using Map
Map(function(x, y) cbind(x, "new_column" = y), ldf, new_cols)

$`April 2018 ASP NDC-HCPCS Crosswalk`
   first second new_column
1      1      1    2018 Q2
2      2      2    2018 Q2
3      3      3    2018 Q2
4      4      4    2018 Q2
5      5      5    2018 Q2
6      6      6    2018 Q2
7      7      7    2018 Q2
8      8      8    2018 Q2
9      9      9    2018 Q2
10    10     10    2018 Q2

$`Apr 2019 ASP Pricing File`
   first second new_column
1      1      1    2019 Q2
2      2      2    2019 Q2
3      3      3    2019 Q2
4      4      4    2019 Q2
5      5      5    2019 Q2
6      6      6    2019 Q2
7      7      7    2019 Q2
8      8      8    2019 Q2
9      9      9    2019 Q2
10    10     10    2019 Q2

$`Jan 18 ASP Pricing File`
   first second new_column
1      1      1    2018 Q1
2      2      2    2018 Q1
3      3      3    2018 Q1
4      4      4    2018 Q1
5      5      5    2018 Q1
6      6      6    2018 Q1
7      7      7    2018 Q1
8      8      8    2018 Q1
9      9      9    2018 Q1
10    10     10    2018 Q1

Данные :

df<- data_frame(first =seq(1:10), second = seq(1:10))
ldf <- list(df, df, df)
names(ldf) <- c('April 2018 ASP NDC-HCPCS Crosswalk', 'Apr 2019 ASP Pricing File', 'Jan 18 ASP Pricing File')

Answer 2

Способ начала:

df<- data_frame(first =seq(1:10), second = seq(1:10))
ldf <- list(df, df, df)
names(ldf) <- c('April 2018 ASP NDC-HCPCS Crosswalk', 'Apr 2019 ASP Pricing File', 'Jan 18 ASP Pricing File')

lookup_quarters <- setNames(paste0("Q", rep(1:4, each = 3)),
                            c("jan", "feb", "mar", "apr", "may", "jun",
                              "jul", "aug", "sep", "oct", "nov", "dec"))

lapply(seq_along(ldf), 
       function(i) {
         qtr <- substr(tolower(strsplit(names(ldf)[i], " ")[[1]][1]), 1, 3)
         qtr <- lookup_quarters[qtr]
         yr <- strsplit(names(ldf)[i], " ")[[1]][2]
         yr <- if (nchar(yr) == 2) paste0("20", yr) else yr
         res <- ldf[[i]]
         res$newcol <- paste(yr, qtr)
         res
       })