R/date_function.R

In jackwilliambiggs/ForumDates: Package containing a useful function to convert troublesome dates.

date_ameliorator <- function(list_of_dates) {
  if (!require("pacman")) install.packages("pacman")

  p_load(dplyr, lubridate, stringr)

  days <- function() {
    dates <- rep(Sys.Date(), 7)
    minus <- 0:6
    final_dates <- dates - minus
    days <- c(
      "Today",
      "Yesterday",
      weekdays(final_dates[3]),
      weekdays(final_dates[4]),
      weekdays(final_dates[5]),
      weekdays(final_dates[6]),
      weekdays(final_dates[7])
    )

    days_named <- weekdays(final_dates)

    date.df <- data.frame(
      dates = final_dates,
      days, days_named
    )

    # invisible(print(date.df))
  }

  days.df <- days()

  day_finder <- function(day) {
    if (day == "Today") {
      which(str_detect(days.df$days, day))
    }
    else if (day == "Yesterday") {
      which(str_detect(days.df$days, day))
    }
    else {
      which(str_detect(days.df$days_named, day))
    }
  }


  days_of_week <- c(
    "Today", "Yesterday", "Monday", "Tuesday", "Wednesday", "Thursday", "Friday",
    "Saturday", "Sunday"
  )

  frame <- data.frame(days_of_week)

  frame$number <- 0

  for (i in 1:length(frame$days_of_week)) {
    frame$number[i] <- day_finder(as.character(frame$days_of_week[i]))
  }


  delete_one <- which(str_detect(frame$number, "1"))[2]
  delete_two <- which(str_detect(frame$number, "2"))[2]

  frame_final <- frame[-c(delete_one, delete_two), ]

  frame_final <- frame_final %>%
    arrange(number) %>%
    mutate(replacement = days.df$dates)



  formatter <- function(date_vector) {
    for (i in 1:nrow(frame_final)) {
      date_vector <- gsub(
        paste0(".*", frame_final$days_of_week[i], ".*"), frame_final$replacement[i],
        date_vector
      )
    }

    date_vector
  }

  ## this is the first time the input of the original function should come in.

  test <- formatter(list_of_dates)

  converted_dates <- which(str_detect(test, "^\\d\\d\\d\\d"))

  dates <- suppressWarnings(mdy(test))


  lubridate_dates <- which(!str_detect(dates, "NA"))

  dates_converted <- vector(length = length(test))

  dates_converted[converted_dates] <- test[converted_dates]
  dates_converted[lubridate_dates] <- as.character(dates[lubridate_dates])

  dates_converted <- ymd(dates_converted)

  print(dates_converted)
}