Little useless-useful R functions – Date Palindrome

[This article was first published on R – TomazTsql, and kindly contributed to R-bloggers]. (You can report issue about the content on this page here)
Want to share your content on R-bloggers? click here if you have a blog, or here if you don't.

It is a rare thing that a date can be a palindrome. But it happens.

And the idea is the following, to cover all different date formats and for the given period

IsPalindromeDateRange <- function(date = Sys.Date(), 
                             end_date = NULL,
                             formats = "all",
                             verbose = TRUE) {
  
  
  
  ## Helper stuff
  is_palindrome <- function(x) {
    chars <- strsplit(x, "")[[1]]
    identical(chars, rev(chars))
  }
  
  reverse_string <- function(x) {
    paste(rev(strsplit(x, "")[[1]]), collapse = "")
  }
  
  date_to_digits <- function(date, format = "%Y%m%d") {
    format(date, format)
  }
  
  
  date_formats <- list(
    YYYYMMDD = list(
      name = "YYYYMMDD",
      format = "%Y%m%d",
      example = "20251202",
      regions = "International/ISO standard"
    ),
    MMDDYYYY = list(
      name = "MMDDYYYY",
      format = "%m%d%Y",
      example = "12022025",
      regions = "United States"
    ),
    DDMMYYYY = list(
      name = "DDMMYYYY",
      format = "%d%m%Y",
      example = "02122025",
      regions = "Europe"
    ),
    YYMMDD = list(
      name = "YYMMDD",
      format = "%y%m%d",
      example = "251202",
      regions = ""
    ),
    DDMMYY = list(
      name = "DDMMYY",
      format = "%d%m%y",
      example = "021225",
      regions = ""
    ),
    MMDDYY = list(
      name = "MMDDYY",
      format = "%m%d%y",
      example = "120225",
      regions = "United states - short"
    )
  )
  
  
  date <- as.Date(date)
   
  if (identical(formats, "all")) {
    check_formats <- names(date_formats)
  } else {
    check_formats <- formats
    invalid <- setdiff(formats, names(date_formats))
    if (length(invalid) > 0) {
      warning("Unknown formats ignored: ", paste(invalid, collapse = ", "))
      check_formats <- intersect(formats, names(date_formats))
    }
  }
  
  if (!is.null(end_date)) {
    
    end_date <- as.Date(end_date)
    
    # Hearlthy checker start < end
    if (date > end_date) {
      temp <- date
      date <- end_date
      end_date <- temp
    }
    
    total_days <- as.integer(end_date - date) + 1
    
    if (verbose) {
      cat("From:", format(date, "%Y-%m-%d"))
      cat("To:  ", format(end_date, "%Y-%m-%d"))
      cat("(", total_days, " days)", sep = "")
      cat("\n")
      cat("  Formats: ", paste(check_formats, collapse = ", "), "\n\n", sep = "")
    }
    
    # Emopyt data frame
    results <- data.frame(
      date = as.Date(character()),
      day_of_week = character(),
      format = character(),
      digits = character(),
      stringsAsFactors = FALSE
    )
    
 
    check_date <- date
    checked <- 0
    
    while (check_date <= end_date) {
      
      for (fmt in check_formats) {
        digits <- date_to_digits(check_date, date_formats[[fmt]]$format)
        
        if (is_palindrome(digits)) {
          results <- rbind(results, data.frame(
            date = check_date,
            day_of_week = format(check_date, "%A"),
            format = fmt,
            digits = digits,
            stringsAsFactors = FALSE
          ))
        }
      }
      
      check_date <- check_date + 1
      checked <- checked + 1
    }
    
    
    # Results
    if (verbose) {
      if (nrow(results) == 0) {
        cat("No date palindrome  found in this range.\n\n")
      } else {
        # Get uniques per date format
        unique_dates <- unique(results$date)
        
        cat(sprintf("Found %d palindrome occurrence%s (%d unique date%s):\n\n",
                    nrow(results),
                    if (nrow(results) > 1) "s" else "",
                    length(unique_dates),
                    if (length(unique_dates) > 1) "s" else ""))
        
        cat(strrep("─", 60), "\n")
        cat(sprintf("  %-12s  %-10s  %-12s  %s\n","Date", "Day", "Format", "Digits"))
        cat(strrep("─", 60), "\n")
        display_results <-  results
        
        for (i in seq_len(nrow(display_results))) {
          row <- display_results[i, ]
          cat(sprintf("  %-12s  %-10s  %-12s  %s ↔ %s\n",
                      format(row$date, "%Y-%m-%d"),
                      substr(row$day_of_week, 1, 10),
                      row$format,
                      row$digits,
                      reverse_string(row$digits)))
        }
  
        cat(strrep("─", 60), "\n\n")
        
        if (length(check_formats) > 1) {
          #funky stuff
          cat("Summary by format:\n")
          format_counts <- table(results$format)
          for (fmt in names(format_counts)) {
            cat(sprintf("%s: %d palindrome%s\n", fmt, format_counts[fmt],
                  if (format_counts[fmt] > 1) "s" else ""))
          }
          cat("\n")
        }
        
      }
    }
  }
  
  # Sanity Check 
  results <- sapply(check_formats, function(fmt) {
    digits <- date_to_digits(date, date_formats[[fmt]]$format)
    is_palindrome(digits)
  })
  
  if (verbose) {
    any_palindrome <- FALSE
    
    for (fmt in check_formats) {
      digits <- date_to_digits(date, date_formats[[fmt]]$format)
      is_pal <- results[fmt]
      
      status <- if (is_pal) "PALINDROME!" else "Not a palindrome"
      
      if (is_pal) any_palindrome <- TRUE
      
      cat(sprintf("  %s %-15s : %s  %s\n",
                  date_formats[[fmt]]$name,
                  digits,
                  if (is_pal) "<>" else " ",
                  status))
    }
    cat("\n")
  }
}

And to do some useless extraction of the palindrome dates, we have extracted all the dates from year 1100 to 2100.

And you can tell, that the most palindrome dates occurred between 1100 and 1200 and in recent years, if you look EU or ISO date formats (DDMMYYY). But if you look the YYMMDD or DDMMYY or MMDDYY, these have stable frequency per decade and are present equally in all these years. 🙂

As always, the complete code is available on GitHub in  Useless_R_function repository. The sample file in this repository is here (filename: Date_palindrome.R.R). Check the repository for future updates.

Happy R-coding and stay healthy!

To leave a comment for the author, please follow the link and comment on their blog: R – TomazTsql.

R-bloggers.com offers daily e-mail updates about R news and tutorials about learning R and many other topics. Click here if you're looking to post or find an R/data-science job.
Want to share your content on R-bloggers? click here if you have a blog, or here if you don't.

Never miss an update!
Subscribe to R-bloggers to receive
e-mails with the latest R posts.
(You will not see this message again.)

Click here to close (This popup will not appear again)