Преобразование имен файлов, содержащих даты, в формат QQ-YYYY и вставка в виде столбца для файлов N excel в R - PullRequest
0 голосов
/ 26 сентября 2019

У меня есть несколько файлов xls, которые я скачал из Интернета, и я хочу преобразовать эти имена файлов в QQ-YYYY и сохранить эти строки как новый столбец.Это поле даты в настоящее время отсутствует в исходном файле xls.Обратите внимание, что некоторые файлы, которые меня интересуют, когда-нибудь будут иметь полные названия месяцев, а другие будут сокращенно, т. Е. Октябрь и октябрь

> pricingFiles
[1] "Apr 2018 ASP Pricing File 031318.xls"           "Apr 2019 ASP Pricing File 032219.xls"          
[3] "Jan 18 ASP Pricing File updated 030218.xls"     "Jan 2019 ASP Pricing File - updated 052919.xls"
[5] "Jul 2018 ASP Pricing File updated 052919.xls"   "Jul 2019 ASP Pricing File 091119.xls"          
[7] "Oct 18 ASP Pricing File updated 052919.xls"     "Oct 2019 ASP Pricing File 092519.xls" 

Как мы видим выше, я хочу преобразовать фрагмент строки даты перед ASP Pric...... в QQ-YYYY, а затем сохраните его в новом столбце в кадре данных, т.е.

апрель 2018 г. Файл цены ASP 031318.xls -> Q2-2018, а затем вставьте его в столбец даты вDF при чтении в R.

Обратите внимание, что каждый файл xls находится на разных номерах строк, и у меня есть определенная функция, которую я планирую использовать в аргументе пропуска

skip=header_begins[i]-1

Мой кодвыглядит следующим образом:

startDate <- 2018
endDate <- as.numeric(format(Sys.Date(), "%Y"))

# FUNCTION DEFINITION TO FETCH 2018 TO 2019 CROSSWALK AND ASP PRICING ZIP FILES
fileFinder <- function(yearsVector)
{
  for (i in yearsVector)
  {
    message(paste0("Getting data for ", i))
    tryCatch({
      webpages <- read_html(paste0("https://www.cms.gov/Medicare/Medicare-Fee-for-Service-Part-B-Drugs/McrPartBDrugAvgSalesPrice/", 
        i, "ASPFiles.html"))
      r <- webpages %>% html_nodes("a") %>% html_attr("href") %>% grep(c("\\Crosswalk.zip$|\\ASP-Pricing-File.zip$"), 
        ., value = TRUE) %>% gsub("apps\\/ama\\/license.asp\\?file=\\/", 
        "", .) %>% paste0("https://www.cms.gov", .)
      return(r)
    }, error = function(e)
    {
      # TODO
      return(NA)
    })
  }
}

# CREATE LIST TO STORE URLs
urls <- list()

# PASS DATE RANGE TO THE CMS ZIP FINDER FUNCTION
urls <- lapply(startDate:endDate, fileFinder)

# CONVERT LIST OF URLs INTO VECTOR
urls <- unlist(urls, recursive = F)

# CREATE FUNCTION TO DOWNLOAD FILES FROM CMS.GOV
download.cms <- function(urls, refetch = TRUE, path = ".")
{
  dest <- file.path(path, basename(urls))
  if (refetch || !file.exists(dest)) 
    download.file(urls, dest)
  dest
}

# DOWNLOAD THE CROSSWALK ZIP FILES
sapply(urls, download.cms)

# UNZIP ALL FILES
for (i in dir(path = ".", pattern = "*.zip$")) unzip(i)

# CREATE A LIST OF ALL EXCEL FILES IN THE DIRECTORY
listExcelFiles <- list.files(".", pattern = c("\\.xls$|\\.csv$|\\.xlsx$"))

# RETAIN EXCEL FILES THAT ARE CROSSWALK FILES
crosswalkFiles <- listExcelFiles[grepl("ASP NDC-HCPCS", listExcelFiles) & !grepl("508 version", 
  listExcelFiles)]

# RETAIN EXCEL FILES THAT ARE PRICING FILES
pricingFiles <- listExcelFiles[grepl("ASP Pricing File", listExcelFiles) & !grepl("508 version", 
  listExcelFiles)]

# CREATE A LIST OF FILES TO DELETE 
# TBC

# SINCE EACH FILE BEGINS ON DIFFERENT ROWS, DEFINE FUNCTION TO DETECT HEADER LINE
detect_header_line <- function(file_names, column_name)
{
  header_begins <- NULL
  for (i in 1:length(file_names))
  {
    lines_read <- readLines(file_names[i], warn = FALSE)
    header_begins[i] <- grep(column_name, lines_read)
  }
}

# FIND THE FIRST ROW FOR EACH FILE
header_begins <- detect_header_line(myExcel, "Short Description")

1 Ответ

0 голосов
/ 26 сентября 2019

Мы можем получить подстроку и использовать as.yearqtr

library(zoo)
as.yearqtr(sub("^(\\w+\\s+\\d+).*", '\\1', pricingFiles), "%b %Y")
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...