Add format DATEw.

R/datew.R

@@ -0,0 +1,57 @@
+format_datew <- function(date, wdth){
+
+
+
+  if (5 > wdth | wdth > 11){
+
+    stop( paste0( "Width specified for format DATE is invalid,  width should be between 5 and 11" ) )
+
+  }else{
+
+      if ("numeric" %in% class(date) ){
+
+        date = as.Date(date, origin = "1970-01-01")
+
+      }
+
+      if (wdth == 5){
+
+        ret <- toupper(format(date,  format = "%d%b"))
+
+      }else if(wdth == 6){
+
+        ret <- toupper(paste0(" ", format(date, format = "%d%b")))
+
+      }else if (wdth == 7){
+
+        ret <- toupper(format(date,  format = "%d%b%y"))
+
+      }else if (wdth == 8){
+
+        ret <- toupper(paste0(" ", format(date, format = "%d%b%y")))
+
+      }else if (wdth == 9){
+
+        ret <- toupper(format(date, format = "%d%b%Y"))
+
+      }else if (wdth == 10){
+
+        ret <- toupper(paste0(" ", format(date, format = "%d%b%Y")))
+
+      }else if (wdth == 11){
+
+        ret <- toupper(format(date, format = "%d-%b-%Y"))
+
+      }
+
+
+  }
+
+  return(ret)
+}
+
+
+
+
+
+

R/fapply.R

@@ -78,6 +78,46 @@
 #' For large values, there are some differences between SAS and R in how they
 #' represent these numbers, and sometimes they will not match.
 #' 
+#' @section "DATEw." Format:
+#' The SAS "DATEw." format is used to display date values in a readable
+#' character form, such as "01JAN70" or "01-JAN-1970", depending on the
+#' specified width. The word "date" is followed by the desired w(width),
+#' e.g. "date7" or "date9".
+#' 
+#' The format converts numeric or Date values into character strings using
+#' a pattern that depends on the width. Smaller widths display shorter forms,
+#' while larger widths display more detail. For example:
+#' 
+#' \itemize{
+#'   \item \strong{date5} -- Displays as \code{mmmyy} (e.g., "JAN70")
+#'   \item \strong{date7} -- Displays as \code{ddmmmyy} (e.g., "01JAN70")
+#'   \item \strong{date9} -- Displays as \code{ddmmmyyyy} (e.g., "01JAN1970")
+#'   \item \strong{date11} -- Displays as \code{dd-mmm-yyyy} (e.g., "01-JAN-1970")
+#' }
+#' 
+#' The "date" format accepts widths between 5 and 11. Widths outside this
+#' range are not valid and will result in an error. The default width is 7.
+#' Both \code{"datew"} and \code{"datew."} are accepted, the trailing period
+#' is optional and does not affect behavior.
+#' 
+#' For input values that are numeric, the function will interpret them as
+#' the number of days since 1970-01-01, consistent with R's internal date
+#' representation (different from SAS, which uses 1960-01-01). If the input
+#' is already an R \code{Date} or \code{POSIXt} object, it will be used directly. 
+#' Missing or invalid inputs will result in blank output of the specified width.
+#' 
+#' The output value is left-padded with spaces if it is shorter than the
+#' requested width, ensuring the formatted result always occupies exactly the
+#' specified number of characters. For example, for the date 1970-01-01,
+#' the result of \code{date7} is \code{"01JAN70"}, while the result of
+#' \code{date8} is \code{" 01JAN70"}, with one additional leading space.
+#' 
+#' This format has no direct equivalent in base R, so the \strong{fmtr} package
+#' adds this capability for users who wish to replicate SAS-style "date"
+#' formatting behavior as closely as possible, adapted to R's date origin
+#' and conventions.
+#' 
+#' 
 #' @param x A vector, factor, or list to apply the format to.
 #' @param format A format to be applied.
 #' @param width The desired character width of the formatted vector.  Default
@@ -200,6 +240,13 @@
 #' fapply(v7, "best6")
 #' # [1] "12.346" "1.23E6" NA       "0.1235" "123E-7"
 #' 
+#' # Example 9: "DATEw." Format
+#' #' # Data Vector
+#' v8 <- as.Date(c("1924-02-29",NA,"1980-12-31","2019-12-31","2020-02-29","2030-08-20"))
+#' 
+#' fapply(v8, "date7")
+#' # [1] "29FEB24" NA        "31DEC80" "31DEC19" "29FEB20" "20AUG30"
+#' 
 fapply <- function(x, format = NULL, width = NULL, justify = NULL) {
 
   # Get attribute values if available
@@ -442,40 +489,39 @@ eval_conditions_back <- function(x, conds) {
 format_vector <- function(x, fmt, udfmt = FALSE) {
 
   if ("character" %in% class(fmt)) {
-    if (any(class(x) %in% c("Date", "POSIXt"))) {
 
-      # For dates, call format
-      if (udfmt == TRUE) {
-
-        ret <- tryCatch({suppressWarnings(format(x, format = fmt))},
-                        error = function(cond) {fmt})
-
-      } else {
-        ret <- format(x, format = fmt)
-      }
-
-      xin <- x
-      if (!"Date" %in% class(x))
-        xin <- as.Date(x)
-
-      ret <- format_quarter(xin, ret, fmt)
-
-    } else if (any(class(x) %in% c("numeric", "character", "integer"))) {
+     if (any(class(x) %in% c("numeric", "character", "integer"))) {
 
         bst <- grepl("^best[0-9]*\\.?$", fmt, ignore.case = TRUE)
-
+        datew <- grepl("^date[0-9]*\\.?$", fmt, ignore.case = TRUE)
+
         if (bst) { 
 
           wdth <- sub("best", "", tolower(fmt), fixed = TRUE)
           wdth <-suppressWarnings(as.integer(wdth))
 
           if (is.na(wdth)) {
-            wdth=12
+
+            wdth = 12
+
           }
 
           ret <- format_best(x, wdth)
 
 
+        }else if (datew) {
+
+          wdth <- sub("date", "", tolower(fmt), fixed = TRUE)
+          wdth <- suppressWarnings(as.integer(wdth))
+
+          if (is.na(wdth)){
+
+            wdth = 7
+
+          }
+
+          ret<-format_datew(x, wdth)
+
         } else {
 
           # For numerics, call sprintf
@@ -490,10 +536,54 @@ format_vector <- function(x, fmt, udfmt = FALSE) {
         }
 
         # Find NA strings
-        nas <- ret == "NA"
+        nas <- ret %in% c("NA", " NA")
+
+        # Turn NA strings back into real NA
+        ret <- replace(ret, nas, NA)
+
+    } else if ( any( class(x) %in% c("Date", "POSIXt"))){
+
+      datew <- grepl("^date[0-9]*\\.?$", fmt, ignore.case = TRUE)
+
+
+      if (datew){
+
+
+        wdth<- sub("date", "", tolower(fmt), fixed = TRUE)
+        wdth<-suppressWarnings(as.integer(wdth))
+
+        if (is.na(wdth)){
+
+          wdth = 7
+
+        }
+
+        ret <- format_datew(x, wdth)
+
+        # Find NA strings
+        nas <- ret == " NA"
 
         # Turn NA strings back into real NA
         ret <- replace(ret, nas, NA)
+
+      }else{
+
+        if (udfmt == TRUE) {
+
+          ret <- tryCatch({suppressWarnings(format(x, format = fmt))},
+                          error = function(cond) {fmt})
+
+        } else {
+          ret <- format(x, format = fmt)
+        }
+
+        xin <- x
+        if (!"Date" %in% class(x))
+          xin <- as.Date(x)
+
+        ret <- format_quarter(xin, ret, fmt)
+      }
+
     } else {
       ret <- fmt
     }

R/fmtr.R

@@ -122,6 +122,27 @@
 #' See the \code{\link[base]{strptime}} function for additional codes and 
 #' examples of formatting dates and times.
 #' 
+#' @section "DATEw." date format:
+#' The "DATEw." format is a special date-display format that replicates the
+#' behavior of the SAS DATEw. family of formats. The "DATEw." format converts
+#' either numeric date values, R \code{Date} objects, or \code{POSIXt} date-time
+#' objects into standard SAS-style character representations, with the specific 
+#' output depending on the width.
+#' 
+#' Smaller widths show abbreviated forms (e.g., "JAN70" for date5), while
+#' larger widths show full day/month/year values (e.g., "01JAN1970" for date9
+#' or "01-JAN-1970" for date11). For \code{POSIXt} values, only the date
+#' portion is used.
+#'
+#' Numeric inputs follow R conventions and are interpreted as days since
+#' 1970-01-01. The default width is 7, so "date" is interpreted as "date7". 
+#' Both "date7" and "date7." are accepted; the trailing period is optional.
+#'
+#' Output always occupies the exact width. If shorter, it is left-padded
+#' with spaces. For example, for 1970-01-01, "date7." returns "01JAN70"
+#' while "date8." returns " 01JAN70".
+#' 
+#' 
 #' @section Numeric Formatting:
 #' 
 #' Below are some commonly used formatting codes for other data types:
@@ -161,6 +182,18 @@
 #' fapply(t, "%Y-%Q")                 # Year and Quarter
 #' fapply(t, "%Y-%m%-%d %H:%M:%S %p") # Common timestamp format
 #' 
+#' # Examples for formatting dates (date and times) using "DATEw."
+#' d <- Sys.Date()
+#' fapply(d, "date5")                 # Month Year (mmmyy)
+#' fapply(d, "date7")                 # Day Month Year (ddmmmyy)
+#' fapply(d, "date9")                 # Day Month Year (ddmmmyyyy)
+#' fapply(d, "date11")                # Day Month Year (dd-mmm-yyyy)
+#' t <- Sys.time()
+#' fapply(t, "date5")                 # Month Year (mmmyy)
+#' fapply(t, "date7")                 # Day Month Year (ddmmmyy)
+#' fapply(t, "date9")                 # Day Month Year (ddmmmyyyy)
+#' fapply(t, "date11")                # Day Month Year (dd-mmm-yyyy)
+#' 
 #' # Examples for formatting numbers
 #' a <- 1234.56789
 #' fapply(a, "%f")                    # Floating point number