Little useless-useful R functions – Date Palindrome

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!