Add scale_x_VISITDY

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: Rsdtm
 Title: Study Data Tabulation Model (SDTM) import, export, and management assistance
-Version: 0.0.0.9013
+Version: 0.0.0.9014
 Authors@R:
   c(
     person("William", "Denney", email = "wdenney@humanpredictions.com", role = c("aut", "cre")),
@@ -12,17 +12,20 @@ Description: Assist with management of clinical trial data in the SDTM and ADaM
 Depends: R (>= 3.4)
 Imports:
  dplyr,
+ ggplot2,
+ labeling,
  lubridate,
  methods,
  readr,
  rio,
  rlang,
+ scales,
  tibble,
  tidyr
 License: AGPL-3
 Encoding: UTF-8
 LazyData: true
-RoxygenNote: 7.1.1
+RoxygenNote: 7.1.2
 Suggests: 
     covr,
     testthat (>= 2.1.0)

NAMESPACE

@@ -14,6 +14,7 @@ export(import_sdtm)
 export(import_sdtm_dir)
 export(import_sdtm_file)
 export(merge_supp)
+export(scale_x_VISITDY)
 export(sdtm_dtc_to_datetime)
 export(sdtm_first_dose)
 export(sdtm_time_actual)

R/VISITDY_trans.R

@@ -0,0 +1,77 @@
+# Shift positive values down
+VISITDY_transform <- function(x) {
+  x_i <- as.integer(x)
+  ifelse(
+    x_i < 0,
+    x_i,
+    x_i - 1L
+  )
+}
+
+# Shift positive values up
+VISITDY_inverse <- function(x) {
+  ifelse(
+    x < 0,
+    x,
+    x + 1L
+  )
+}
+
+# Generate breaks daily then weekly, then with other choices
+VISITDY_breaks <- function(n=5, ...) {
+  n_default <- n
+  function(x, n=n_default) {
+    x <- x[is.finite(x)]
+    if (length(x) == 0) {
+      return(numeric())
+    }
+    # Prefer daily then weekly then other options
+    Q_choices <- c(1, 7, 2, 4, 3, 5)
+    x_trans <- VISITDY_transform(x)
+    rng <- range(x_trans)
+    ret <- labeling::extended(dmin=rng[1], dmax=rng[2], m=n, Q=Q_choices, ...)
+    rng_ret <- range(ret)
+    if ((rng_ret[1] < 0) & (rng_ret[2] > 0)) {
+      # Ensure that 1 is displayed
+      ret <- sort(unique(c(-1L, 1L, ret)))
+    }
+    ret
+  }
+}
+
+# Show every day with a minor break
+VISITDY_minor_breaks <- function(b, limits, n) {
+  b <- b[!is.na(b)]
+  setdiff(seq(floor(limits[1]), ceiling(limits[2]), by=1), b)
+}
+
+VISITDY_trans <-
+  scales::trans_new(
+    name="VISITDY",
+    transform=VISITDY_transform,
+    inverse=VISITDY_inverse,
+    breaks=VISITDY_breaks(5),
+    minor_breaks=VISITDY_minor_breaks
+  )
+
+#' A scale for ggplots with SDTM day (DY) numbering
+#' 
+#' The scale will skip over 0, always show 1 (if it is in the range of the
+#' data), provide breaks with preference toward week scales, and provide minor
+#' breaks every day.
+#' 
+#' @param ... Passed to \code{ggplot2::scale_x_continuous()}
+#' @param trans Do not modify
+#' @examples
+#' \dontrun{
+#' ggplot(data.frame(x=-7:14, y=-7:14), aes(x=x, y=y)) +
+#'   scale_x_VISITDY() +
+#'   geom_point()
+#' }
+#' @export
+scale_x_VISITDY <- function(...) {
+  if ("trans" %in% ...names()) {
+    stop("Cannot set 'trans' (just use scale_x_continuous())")
+  }
+  ggplot2::scale_x_continuous(..., trans=VISITDY_trans)
+}