Implement occasion calculation

.Rbuildignore

@@ -2,6 +2,7 @@
 _pkgdown\.yml
 Makefile
 ^test\.R$
+^test-*\.R$
 ^.*\.Rproj$
 ^\.Rproj\.user$
 README\.html

.gitignore

@@ -4,7 +4,8 @@ lastdose.Rcheck
 lastdose*.tar.gz
 src/*.o
 src/*.so
-test*.R
+/test-*.R
+/test.R
 test*.cpp
 .Rproj.user
 .Rhistory

NEWS.md

@@ -1,3 +1,5 @@
+# lastdose (development version)
+
 # lastdose 0.4.3
 
 ## New features and changes

R/RcppExports.R

@@ -1,7 +1,7 @@
 # Generated by using Rcpp::compileAttributes() -> do not edit by hand
 # Generator token: 10BE3573-1514-4C36-9D1C-5A225CD40393
 
-lastdose_impl <- function(id, time, amt, evid, addl, ii, fill, back_calc, sort1, comment) {
-    .Call(`_lastdose_lastdose_impl`, id, time, amt, evid, addl, ii, fill, back_calc, sort1, comment)
+lastdose_impl <- function(id, time, amt, evid, addl, ii, fill, back_calc, sort1, comment, include_occ) {
+    .Call(`_lastdose_lastdose_impl`, id, time, amt, evid, addl, ii, fill, back_calc, sort1, comment, include_occ)
 }
 

R/lastdose.R

@@ -6,7 +6,8 @@ NULL
 #' Calculate last dose amount and times since previous doses
 #'
 #' This function calculates the last dose amount (`LDOS`), the time after
-#' last dose (`TAD`), and time after first dose (`TAFD`). Use [lastdose()]
+#' last dose (`TAD`), time after first dose (`TAFD`), and observation
+#' occasion (`OCC`). Use [lastdose()]
 #' to add (or potentially replace) columns to the input data frame;
 #' [lastdose_list()] and [lastdose_df()] returns calculated information
 #' as either `list` or `data.frame` format without modifying the input data.
@@ -44,8 +45,11 @@ NULL
 #' @param ... arguments passed to [lastdose_list()]
 #' @param include_ldos `logical`; if `FALSE` then the `LDOS` data is not
 #' appended to the data set.  Only used for the [lastdose()] function.
-#' @param include_tafd `logical`; if `FALSE`, then `TAFD` data is not appended
-#' to the data set.  Only used for the [lastdose()] function.
+#' @param include_tafd `logical`; if `FALSE`, then time after first dose
+#' (`TAFD`) data is not appended to the data set; this is only used for the
+#' [lastdose()] function.
+#' @param include_occ `logical`; if `FALSE` then observation occasion counter
+#' (`OCC`; see **Details**) is not appended to the data set.
 #'
 #' @section Options:
 #'
@@ -78,11 +82,17 @@ NULL
 #' accessible with `tad`,  `tafd`, and `ldos` (note the lower case form here to
 #' distinguish from the columns that might be added to the data frame).
 #'
-#' **Time after first dose**: note that time after first dose (`TAFD`) is the
-#' time after the first dosing record (`EVID` 1 or 4) in the data frame that
-#' you pass in. If you don't have a dosing record for the first dose to
+#' **Time after first dose (TAFD)**: note that time after first dose (`TAFD`)
+#' is the time after the first dosing record (`EVID` 1 or 4) in the data frame
+#' that you pass in. If you don't have a dosing record for the first dose to
 #' anchor this calculation, you should opt out.
 #'
+#' **Occasion (OCC)**: observation occasions (`OCC`) occur when there is an
+#' observation record (with `EVID=0`) following a dose record (`EVID 1 or 4`);
+#' `OCC` starts at `0` and increments with each dose that is followed by at
+#' least one observation record. The `OCC` calculation ignores all commented
+#' records (doses or observations).
+#'
 #' **Handling of commented records**: Dosing records that have been "commented"
 #' (as indicated with the `comments` argument) will never be considered as
 #' actual doses when determining `TAD`, `TAFD`, and `LDOS`.  But commented
@@ -133,11 +143,13 @@ NULL
 #'
 #' @export
 lastdose <- function(data, ..., include_ldos = TRUE,
-                     include_tafd = getOption("lastdose.include_tafd", FALSE)) {
-  ans <- lastdose_list(data, ...)
+                     include_tafd = getOption("lastdose.include_tafd", FALSE),
+                     include_occ = getOption("lastdose.include_occ", TRUE)) {
+  ans <- lastdose_list(data, include_occ = include_occ, ...)
   data[["TAD"]] <- ans[["tad"]]
   if(include_tafd) data[["TAFD"]] <- ans[["tafd"]]
   if(include_ldos) data[["LDOS"]] <- ans[["ldos"]]
+  if(include_occ)  data[["OCC"]] <- ans[["occ"]]
   data
 }
 
@@ -150,7 +162,8 @@ lastdose_list <- function(data,
                           fill = -99,
                           back_calc = TRUE,
                           addl_ties = c("obs_first", "dose_first"),
-                          comments = find_comments(data)) {
+                          comments = find_comments(data),
+                          include_occ = getOption("lastdose.include_occ", TRUE)) {
 
   if(length(comments) == 1) {
     comments <- rep(comments,nrow(data))
@@ -161,6 +174,8 @@ lastdose_list <- function(data,
       call. = FALSE
     )
   }
+  back_calc <- isTRUE(back_calc)
+  include_occ <- isTRUE(include_occ)
   addl_ties <- match.arg(addl_ties)
   sort1 <- addl_ties == "obs_first"
   lower_names <- tolower(names(data))
@@ -253,7 +268,8 @@ lastdose_list <- function(data,
     fill,
     back_calc,
     sort1,
-    comments
+    comments,
+    include_occ
   )
   if(has_na_time) {
     re_order <- order(c(which(!na_time), which(na_time)))
@@ -268,13 +284,17 @@ lastdose_list <- function(data,
 #' @export
 lastdose_df <- function(data, ...) {
   ans <- lastdose_list(data, ...)
-  data.frame(
+  out <- data.frame(
     tad = ans[["tad"]],
     tafd = ans[["tafd"]],
     ldos = ans[["ldos"]],
     stringsAsFactors = FALSE, check.names = FALSE,
     fix.empty.names = FALSE, row.names = NULL
   )
+  if(!is.null(ans[["occ"]])) {
+    out$occ <- ans[["occ"]]
+  }
+  out
 }
 
 #' Find commented records

inst/test-data/occ/evid-2-3-a.csv

@@ -0,0 +1,9 @@
+ID,TIME,EVID,AMT
+1,0,0,100
+1,1,1,100
+1,2,0,100
+1,3,1,100
+1,4,2,100
+1,5,1,100
+1,6,1,100
+1,7,0,100

inst/test-data/occ/evid-2-3-b.csv

@@ -0,0 +1,9 @@
+ID,TIME,EVID,AMT
+1,0,0,100
+1,1,1,100
+1,2,0,100
+1,3,1,100
+1,4,3,100
+1,5,1,100
+1,6,1,100
+1,7,0,100

inst/test-data/occ/evid-2-3-c.csv

@@ -0,0 +1,9 @@
+ID,TIME,EVID,AMT
+1,0,0,100
+1,1,1,100
+1,2,0,100
+1,3,1,100
+1,4,3,100
+1,5,0,100
+1,6,1,100
+1,7,0,100

inst/test-data/occ/multi-dose-addl-no-obs.csv

@@ -0,0 +1,10 @@
+ID,TIME,EVID,AMT,CMT,II,ADDL
+1,0,0,0,0,0,0
+1,0,1,100,1,1,3
+1,6,0,0,0,0,0
+1,7,0,0,0,0,0
+1,8,0,0,0,0,0
+1,9,0,0,0,0,0
+1,10,0,0,0,0,0
+1,11,0,0,0,0,0
+1,12,0,0,0,0,0

inst/test-data/occ/multi-dose-addl.csv

@@ -0,0 +1,15 @@
+ID,TIME,EVID,AMT,CMT,II,ADDL
+1,0,0,0,0,0,0
+1,0,1,100,1,12,1
+1,2,0,0,0,0,0
+1,4,0,0,0,0,0
+1,6,0,0,0,0,0
+1,8,0,0,0,0,0
+1,10,0,0,0,0,0
+1,12,0,0,0,0,0
+1,14,0,0,0,0,0
+1,16,0,0,0,0,0
+1,18,0,0,0,0,0
+1,20,0,0,0,0,0
+1,22,0,0,0,0,0
+1,24,0,0,0,0,0

inst/test-data/occ/multi-dose-explicit-no-obs.csv

@@ -0,0 +1,13 @@
+ID,TIME,EVID,AMT,CMT,II,ADDL
+1,0,0,0,0,0,0
+1,0,1,100,1,0,0
+1,1,1,100,1,0,0
+1,2,1,100,1,0,0
+1,3,1,100,1,0,0
+1,6,0,0,0,0,0
+1,7,0,0,0,0,0
+1,8,0,0,0,0,0
+1,9,0,0,0,0,0
+1,10,0,0,0,0,0
+1,11,0,0,0,0,0
+1,12,0,0,0,0,0

inst/test-data/occ/multi-dose-explicit.csv

@@ -0,0 +1,16 @@
+ID,TIME,EVID,AMT,CMT
+1,0,0,0,0
+1,0,1,100,1
+1,2,0,0,0
+1,4,0,0,0
+1,6,0,0,0
+1,8,0,0,0
+1,10,0,0,0
+1,12,0,0,0
+1,12,1,100,1
+1,14,0,0,0
+1,16,0,0,0
+1,18,0,0,0
+1,20,0,0,0
+1,22,0,0,0
+1,24,0,0,0

inst/test-data/occ/occ-data.R

@@ -0,0 +1,93 @@
+
+#'
+#' # Examples
+#'
+library(dplyr)
+library(mrgsolve)
+library(lastdose)
+library(here)
+
+csv <- function(x, file) {
+  file <- here("inst/test-data/occ/", file)
+  x$CP <- NULL
+  x$cp <- NULL
+  write.csv(x, file, quote = FALSE, na = ".", row.names=FALSE)
+}
+
+mod <- house(delta = 2, end = 24, outvars = "CP")
+
+#' ## Single dose
+dose <- evd(amt = 100)
+data <- mrgsim_df(mod, dose, carry_out = "AMT,EVID,CMT")
+#' - `OCC` starts at zero
+#' - `OCC` increments to 1 at the time of the first dose
+csv(data, file = "single-dose.csv")
+
+data <- mrgsim_df(mod, dose, carry_out = "AMT,EVID,CMT", recsort = 3)
+#' Here, `OCC` starts at 1 because it was the first record
+csv(data, file = "single-dose-recsort3.csv")
+
+#' ## Multi-dose, with doses explicit in the data set
+dose <- evd(amt = 100, ii = 12, addl = 1) %>% realize_addl()
+data <- mrgsim_df(mod, dose, carry_out = "AMT,EVID,CMT")
+#' - `OCC` starts at 0 again, increments with the first dose
+#' - `OCC` increments at the time of the second dose because we have obserations following
+csv(data, file = "multi-dose-explicit.csv")
+
+#' ## Multi-dose, with doses coded via addl
+dose <- evd(amt = 100, ii = 12, addl = 1)
+data <- mrgsim_df(mod, dose, carry_out = "AMT,EVID,CMT,ADDL,II")
+
+#' - `OCC` increments at 12 hours, the time of the second dose
+csv(data, file = "multi-dose-addl.csv")
+
+
+#' ## Multi-dose via addl, but no observations after the doses
+dose <- evd(amt = 100, ii = 1, addl = 3)
+data <- mrgsim_df(mod, dose, end = -1, add = c(0, seq(6,12)), carry_out = "AMT,EVID,CMT,ADDL,II")
+#' - In this case, `OCC` doesn't increment at the time of the dose at `TIME==0`;
+#' - This is because there wasn't an observation after the first dose, so we
+#'   (intentionally) don't increment `OCC` at that point
+csv(data, file = "multi-dose-addl-no-obs.csv")
+
+
+#' We can see this explicitly here
+dose <- evd(amt = 100, ii = 1, addl = 3) %>% realize_addl()
+data <- mrgsim_df(mod, dose, end = -1, add = c(0, seq(6,12)), carry_out = "AMT,EVID,CMT,ADDL,II")
+#' The rule is: `OCC` doesn't increment unless there are observations after the dose
+csv(data, file = "multi-dose-explicit-no-obs.csv")
+
+
+#' # EVID 2 or 3
+#'
+#' These currently don't count for establishing an occasion dose
+#'
+data <- data.frame(
+  ID = 1,
+  TIME = c(0, 1, 2, 3, 4, 5, 6, 7),
+  EVID = c(0, 1, 0, 1, 2, 1, 1, 0),
+  AMT = 100
+)
+
+csv(data, file = "evid-2-3-a.csv")
+
+
+data <- data.frame(
+  ID = 1,
+  TIME = c(0, 1, 2, 3, 4, 5, 6, 7),
+  EVID = c(0, 1, 0, 1, 3, 1, 1, 0),
+  AMT = 100
+)
+
+csv(data, file = "evid-2-3-b.csv")
+
+#' But if we find an observation before the next dose, we start the occasion
+#' there
+data <- data.frame(
+  ID = 1,
+  TIME = c(0, 1, 2, 3, 4, 5, 6, 7),
+  EVID = c(0, 1, 0, 1, 3, 0, 1, 0),
+  AMT = 100
+)
+
+csv(data, file = "evid-2-3-c.csv")

inst/test-data/occ/single-dose-recsort3.csv

@@ -0,0 +1,15 @@
+ID,TIME,EVID,AMT,CMT
+1,0,1,100,1
+1,0,0,0,0
+1,2,0,0,0
+1,4,0,0,0
+1,6,0,0,0
+1,8,0,0,0
+1,10,0,0,0
+1,12,0,0,0
+1,14,0,0,0
+1,16,0,0,0
+1,18,0,0,0
+1,20,0,0,0
+1,22,0,0,0
+1,24,0,0,0

inst/test-data/occ/single-dose.csv

@@ -0,0 +1,15 @@
+ID,TIME,EVID,AMT,CMT
+1,0,0,0,0
+1,0,1,100,1
+1,2,0,0,0
+1,4,0,0,0
+1,6,0,0,0
+1,8,0,0,0
+1,10,0,0,0
+1,12,0,0,0
+1,14,0,0,0
+1,16,0,0,0
+1,18,0,0,0
+1,20,0,0,0
+1,22,0,0,0
+1,24,0,0,0