Code review by Claude

.Rbuildignore

@@ -19,4 +19,5 @@ cran-comments.md
 ^revdep$
 ^CRAN-SUBMISSION$
 ^\.claude$
+^design$
 ^CLAUDE\.md$

R/001-add.interval.col.R

@@ -99,7 +99,7 @@ add.interval.col <- function(name,
   }
   if (length(FUN) != 1) {
     stop("FUN must have length == 1")
-  } else if (!(is.character(FUN) | is.na(FUN))) {
+  } else if (!(is.character(FUN) || is.na(FUN))) {
     stop("FUN must be a character string or NA")
   }
   if (!is.null(depends)) {
@@ -137,10 +137,10 @@ add.interval.col <- function(name,
   }
   if (!is.list(formalsmap)) {
     stop("formalsmap must be a list")
-  } else if (length(formalsmap) > 0 &
+  } else if (length(formalsmap) > 0 &&
              is.null(names(formalsmap))) {
     stop("formalsmap must be a named list")
-  } else if (length(formalsmap) > 0 &
+  } else if (length(formalsmap) > 0 &&
              is.na(FUN)) {
     stop("formalsmap may not be given when FUN is NA.")
   } else if (!all(nchar(names(formalsmap)) > 0)) {
@@ -151,7 +151,7 @@ add.interval.col <- function(name,
       length(utils::getAnywhere(FUN)$objs) == 0) {
     stop("The function named '", FUN, "' is not defined.  Please define the function before calling add.interval.col.")
   }
-  if (!is.na(FUN) &
+  if (!is.na(FUN) &&
       length(formalsmap) > 0) {
     # Ensure that the formalsmap parameters are all in the list of
     # formal arguments to the function.

R/AIC.list.R

@@ -42,7 +42,7 @@ AIC.list <- function(object, ..., assess.best=TRUE) {
     tmpAICs$isBest <- NULL
     # Assign the correct rownames to tmpAICs
     if (!(retnames[i] %in% ""))
-      if (nrow(tmpAICs) > 1 |
+      if (nrow(tmpAICs) > 1 ||
           !identical(rownames(tmpAICs), as.character(seq_len(nrow(tmpAICs))))) {
         rownames(tmpAICs) <- paste(retnames[i], rownames(tmpAICs))
       } else {

R/PKNCA.options.R

@@ -11,11 +11,11 @@
       return(0.0001)
     if (length(x) != 1)
       stop("adj.r.squared.factor must be a scalar")
-    if (is.factor(x) |
+    if (is.factor(x) ||
         !is.numeric(x))
       stop("adj.r.squared.factor must be numeric (and not a factor)")
     # Must be between 0 and 1, exclusive
-    if (x <= 0 | x >= 1)
+    if (x <= 0 || x >= 1)
       stop("adj.r.squared.factor must be between 0 and 1, exclusive")
     if (x > 0.01)
       warning("adj.r.squared.factor is usually <0.01")
@@ -30,10 +30,10 @@
       return(0.5)
     if (length(x) != 1)
       stop("max.missing must be a scalar")
-    if (is.factor(x) | !is.numeric(x))
+    if (is.factor(x) || !is.numeric(x))
       stop("max.missing must be numeric (and not a factor)")
     # Must be between 0 and 1, inclusive
-    if (x < 0 | x >= 1)
+    if (x < 0 || x >= 1)
       stop("max.missing must be between 0 and 1")
     if (x > 0.5)
       warning("max.missing is usually <= 0.5")
@@ -286,7 +286,7 @@
       stop("min.hl.r.squared cannot be a factor")
     if (!is.numeric(x))
       stop("min.hl.r.squared must be a number")
-    if (x <= 0 | x >= 1)
+    if (x <= 0 || x >= 1)
       stop("min.hl.r.squared must be between 0 and 1, exclusive")
     if (x < 0.9)
       warning("min.hl.r.squared is usually >= 0.9")
@@ -314,7 +314,7 @@
       return(NA)
     if (is.factor(x))
       stop("tau.choices cannot be a factor")
-    if (length(x) > 1 & any(is.na(x)))
+    if (length(x) > 1 && any(is.na(x)))
       stop("tau.choices may not include NA and be a vector")
     if (!identical(x, NA))
       if (!is.numeric(x))
@@ -447,7 +447,7 @@
 PKNCA.options <- function(..., default=FALSE, check=FALSE, name, value) {
   current <- get("options", envir=.PKNCAEnv)
   # If the options have not been initialized, initialize them and then proceed.
-  if (is.null(current) & !default) {
+  if (is.null(current) && !default) {
     PKNCA.options(default=TRUE)
     current <- get("options", envir=.PKNCAEnv)
   }
@@ -466,7 +466,7 @@ PKNCA.options <- function(..., default=FALSE, check=FALSE, name, value) {
       args <- append(args, name)
     }
   }
-  if (default & check)
+  if (default && check)
     stop("Cannot request both default and check")
   if (default) {
     if (length(args) > 0)
@@ -591,7 +591,7 @@ PKNCA.set.summary <- function(name, description, point, spread,
   } else {
     current <- get("summary", envir=.PKNCAEnv)
   }
-  if (missing(name) & missing(point) & missing(spread)) {
+  if (missing(name) && missing(point) && missing(spread)) {
     if (reset)
       assign("summary", current, envir=.PKNCAEnv)
     return(invisible(current))

R/assertions.R

@@ -8,7 +8,7 @@
 #' @returns `interval` (or `c(start, end)`)
 #' @keywords Internal
 assert_intervaltime_single <- function(interval = NULL, start = NULL, end = NULL) {
-  if (is.null(interval) & is.null(start) & is.null(end)) {
+  if (is.null(interval) && is.null(start) && is.null(end)) {
     stop("One of `interval` or `start` and `end` must be given")
   }
   if (xor(is.null(start), is.null(end))) {
@@ -116,7 +116,7 @@ assert_conc_time <- function(conc, time, any_missing_conc = TRUE, sorted_time =
 #' @returns `x`
 assert_numeric_between <- function(x, any.missing = FALSE, null.ok = FALSE, lower_eq = -Inf, lower = -Inf, upper = Inf, upper_eq = Inf, ..., .var.name = checkmate::vname(x)) {
   checkmate::assert_numeric(x, any.missing = any.missing, null.ok = null.ok, lower = lower_eq, upper = upper_eq, ..., .var.name = .var.name)
-  if (is.null(x) & null.ok) {
+  if (is.null(x) && null.ok) {
     # do nothing
   } else {
     # disallowed missing will have been previously caught

R/auc.R

@@ -100,7 +100,7 @@ pk.calc.auxc <- function(conc, time, interval=c(0, Inf),
   }
   auc.type <- match.arg(auc.type)
   interval <- assert_intervaltime_single(interval = interval)
-  if (auc.type %in% "AUCinf" & is.finite(interval[2])) {
+  if (auc.type %in% "AUCinf" && is.finite(interval[2])) {
     warning("Requesting AUCinf when the end of the interval is not Inf")
   }
 

R/auc_integrate.R

@@ -5,6 +5,9 @@ aucintegrate_linear <- function(conc.1, conc.2, time.1, time.2) {
 }
 
 aucintegrate_log <- function(conc.1, conc.2, time.1, time.2) {
+  # conc.1 != conc.2 is guaranteed by choose_interval_method(), which only
+  # assigns "log" to intervals where concentrations are strictly declining and
+  # neither endpoint is zero.
   (time.2-time.1) * (conc.2-conc.1)/log(conc.2/conc.1)
 }
 
@@ -17,6 +20,9 @@ aumcintegrate_linear <- function(conc.1, conc.2, time.1, time.2) {
 }
 
 aumcintegrate_log <- function(conc.1, conc.2, time.1, time.2) {
+  # conc.1 != conc.2 is guaranteed by choose_interval_method(), which only
+  # assigns "log" to intervals where concentrations are strictly declining and
+  # neither endpoint is zero.
   ((time.2-time.1) * (conc.2*time.2-conc.1*time.1) / log(conc.2/conc.1)-
      (time.2-time.1)^2 * (conc.2-conc.1) / (log(conc.2/conc.1)^2))
 }
@@ -44,6 +50,9 @@ interpolate_conc_linear <- function(conc_1, conc_2, time_1, time_2, time_out) {
 
 #' @rdname interp_extrap_conc_method
 interpolate_conc_log <- function(conc_1, conc_2, time_1, time_2, time_out) {
+  # conc_1 > 0 and conc_2 > 0 are guaranteed by choose_interval_method(),
+  # which assigns "zero" or "linear" to any interval where either endpoint
+  # is zero, so log() will never receive a zero or negative value here.
   exp(
     log(conc_1)+
       (time_out-time_1)/(time_2-time_1)*(log(conc_2)-log(conc_1))
@@ -92,19 +101,37 @@ choose_interval_method <- function(conc, time, tlast, method, auc.type, options)
     stopifnot(length(tlast) == 1)
   }
 
-  # Where is tlast in the data?
-  idx_tlast <- which(time == tlast)
-
   ret <- rep(NA_character_, length(conc))
   # Handle all interpolation
   idx_1 <- seq(1, length(conc) - 1)
   idx_2 <- idx_1 + 1
   mask_zero <- conc[idx_1] == 0 & conc[idx_2] == 0
+  # %in% 0 is used throughout instead of == 0 because BLQ concentrations are
+  # cleaned to exactly 0 upstream (by clean.conc.blq()), making exact equality
+  # definitionally correct. We cannot use a tolerance here because we do not
+  # know what a "low" concentration may be in all situations.
   if (all(conc %in% 0)) {
     ret[] <- "zero"
-    # short circuit other options
+    # short circuit other options — tlast is NA for all-zero data, so
+    # idx_tlast is not computed here.
     return(ret)
-  } else if (method == "linear") {
+  }
+
+  # Where is tlast in the data?  Must be checked after the all-zeros early
+  # return above, since tlast is NA when all concentrations are zero.
+  idx_tlast <- which(time == tlast)
+  if (length(idx_tlast) != 1) {
+    stop(
+      "tlast (", tlast, ") must occur exactly once in time; ",
+      if (length(idx_tlast) == 0) {
+        "tlast was not found in time (possible floating point issue)"
+      } else {
+        "tlast was found multiple times"
+      }
+    )
+  }
+
+  if (method == "linear") {
     ret[seq_len(idx_tlast - 1)] <- "linear"
   } else if (method == "lin up/log down") {
     mask_down <- conc[idx_2] < conc[idx_1] & conc[idx_2] != 0

R/aucint.R

@@ -71,7 +71,7 @@ pk.calc.aucint <- function(conc, time,
       return(structure(NA_real_, exclude = "clast.pred is NA because the half-life is NA"))
     } else if (is.na(clast)) {
       stop("Please report a bug. clast is NA and the half-life is not NA") # nocov
-    } else if (clast != clast_obs & interval[2] > tlast) {
+    } else if (clast != clast_obs && interval[2] > tlast) {
       # If using clast.pred, we need to doubly calculate at tlast.
       conc_clast <- clast
       time_clast <- tlast

R/choose.intervals.R

@@ -161,7 +161,7 @@ find.tau <- function(x, na.action=stats::na.omit,
       ))
     tau.choices <- all_deltas[all_deltas > 0]
   }
-  if (is.na(ret) &
+  if (is.na(ret) &&
       length(x) > 1) {
     delta_1 <- x[2] - x[1]
     if (all((x[-1] - x[-length(x)]) == delta_1)) {

R/class-PKNCAconc.R

@@ -241,7 +241,7 @@ getGroups.PKNCAconc <- function(object, form=stats::formula(object), level,
                                 data=as.data.frame(object), sep) {
   grpnames <- unlist(object$columns$groups)
   if (!missing(level))
-    if (is.factor(level) | is.character(level)) {
+    if (is.factor(level) || is.character(level)) {
       level <- as.character(level)
       if (any(!(level %in% grpnames)))
         stop("Not all levels are listed in the group names.  Missing levels are: ",

R/class-PKNCAdata.R

@@ -105,7 +105,7 @@ PKNCAdata.default <- function(data.conc, data.dose, ...,
   class(ret) <- c("PKNCAdata", class(ret))
 
   # Check the intervals
-  if (missing(intervals) & identical(ret$dose, NA)) {
+  if (missing(intervals) && identical(ret$dose, NA)) {
     stop("If data.dose is not given, intervals must be given")
   } else if (missing(intervals)) {
     # Generate the intervals for each grouping of concentration and

R/class-PKNCAdose.R

@@ -126,7 +126,7 @@ PKNCAdose.data.frame <- function(data, formula, route, rate, duration,
   duplicate_check(object = ret, data_type = "dosing")
 
   mask.indep <- is.na(getIndepVar.PKNCAdose(ret))
-  if (any(mask.indep) & !all(mask.indep)) {
+  if (any(mask.indep) && !all(mask.indep)) {
     stop("Some but not all values are missing for the independent variable, please see the help for PKNCAdose for how to specify the formula and confirm that your data has dose times for all doses.")
   }
   if (missing(route)) {
@@ -207,17 +207,17 @@ setDuration.PKNCAdose <- function(object, duration, rate, dose, ...) {
   if (missing(dose)) {
     dose <- object$columns$dose
   }
-  if (missing(duration) & missing(rate)) {
+  if (missing(duration) && missing(rate)) {
     object <- setAttributeColumn(object=object, attr_name="duration", default_value=0,
                                  message_if_default="Assuming instant dosing (duration=0)")
 
-  } else if (!missing(duration) & !missing(rate)) {
+  } else if (!missing(duration) && !missing(rate)) {
     stop("Both duration and rate cannot be given at the same time")
     # TODO: A consistency check could be done, but that would get into
     # requiring near-equal checks for floating point error.
   } else if (!missing(duration)) {
     object <- setAttributeColumn(object=object, attr_name="duration", col_or_value=duration)
-  } else if (!missing(rate) & !missing(dose) && !is.na(dose)) {
+  } else if (!missing(rate) && !missing(dose) && !is.na(dose)) {
     tmprate <- getColumnValueOrNot(object$data, rate, "rate")
     tmpdose <- getColumnValueOrNot(object$data, dose, "dose")
     duration <- tmpdose$data[[tmpdose$name]]/tmprate$data[[tmprate$name]]

R/class-PKNCAresults.R

@@ -118,7 +118,7 @@ getGroups.PKNCAresults <- function(object,
     grpnames <- setdiff(grpnames, object$data$conc$columns$subject)
   }
   if (!missing(level))
-    if (is.factor(level) | is.character(level)) {
+    if (is.factor(level) || is.character(level)) {
       level <- as.character(level)
       if (any(!(level %in% grpnames)))
         stop("Not all levels are listed in the group names.  Missing levels are: ",

R/class-general.R

@@ -91,10 +91,10 @@ setAttributeColumn <- function(object, attr_name, col_or_value, col_name, defaul
                                stop_if_default, warn_if_default, message_if_default) {
   dataname <- getDataName(object)
   # Check inputs
-  if (!is.character(attr_name) | (length(attr_name) != 1)) {
+  if (!is.character(attr_name) || (length(attr_name) != 1)) {
     stop("attr_name must be a character scalar.")
   }
-  if (!missing(col_or_value) &
+  if (!missing(col_or_value) &&
       any(!c(missing(col_name), missing(default_value)))) {
     stop("Cannot provide col_or_value and col_name or default_value")
   }
@@ -115,7 +115,7 @@ setAttributeColumn <- function(object, attr_name, col_or_value, col_name, defaul
         class = paste0("pknca_foundcolumn_", attr_name)
       )
     }
-  } else if (!is.character(col_name) | (length(col_name) != 1)) {
+  } else if (!is.character(col_name) || (length(col_name) != 1)) {
     stop("col_name must be a character scalar.")
   }
   # Set the default value

R/class-summary_PKNCAresults.R

@@ -108,7 +108,7 @@ summary.PKNCAresults <- function(object, ...,
   has_subject_col <- length(subject_col) > 0
   if (is.na(summarize_n)) {
     summarize_n <- has_subject_col
-  } else if (summarize_n & !has_subject_col) {
+  } else if (summarize_n && !has_subject_col) {
     warning("summarize_n was requested, but no subject column exists")
     summarize_n <- FALSE
   }
@@ -494,7 +494,7 @@ summarize_PKNCAresults_parameter <- function(data, parameter, subject_col, inclu
     result_txt <- paste0(point_txt, spread_txt)
   }
 
-  if (na_point & na_spread) {
+  if (na_point && na_spread) {
     result_txt <- not_calculated
   } else if (include_units) {
     result_txt <- paste(result_txt, units)

R/cleaners.R

@@ -98,7 +98,12 @@ clean.conc.blq <- function(conc, time,
 
     # If all measurements are BLQ
     if (all(ret$conc == 0)){
-      # Apply "first" BLQ rule to everything for tfirst/tlast
+      # Apply "first" BLQ rule to everything for tfirst/tlast.
+      # tlast is set to tfirst + 1 as a sentinel that is guaranteed to be
+      # greater than all values in ret$time (since tfirst = max(ret$time)).
+      # It is only ever compared to ret$time (never used as an actual time
+      # point), so the fact that it lies outside the observed time range is
+      # intentional and harmless.
       tfirst <- max(ret$time)
       tlast <- tfirst + 1
 
@@ -110,7 +115,11 @@ clean.conc.blq <- function(conc, time,
     for (i in seq_len(length(conc.blq))) {
       # Set the mask to apply the rule to
       time_type <- names(conc.blq)[i]
-      if (is.null(time_type) & length(conc.blq) == 1) {
+      if (is.null(time_type) && length(conc.blq) == 1) {
+        # %in% 0 is used for BLQ checks throughout because BLQ concentrations
+        # are set to exactly 0 by this function. Exact equality is
+        # definitionally correct; a tolerance cannot be used because we do not
+        # know what a "low" concentration may be in all situations.
         mask <- ret$conc %in% 0
       } else if (time_type == "first") {
         mask <- ret$time <= tfirst & ret$conc %in% 0

R/exclude.R

@@ -39,7 +39,7 @@ utils::globalVariables(c("exclude_current_group_XXX", "row_number_XXX", "exclude
 exclude.default <- function(object, reason, mask, FUN) {
   dataname <- getDataName(object)
   # Check inputs
-  if (missing(mask) & !missing(FUN)) {
+  if (missing(mask) && !missing(FUN)) {
     # operate on one group at a time
     groupnames <-
       unique(c(
@@ -141,7 +141,7 @@ setExcludeColumn <- function(object, exclude = NULL, dataname = "data") {
     add.exclude <- TRUE
   }
   if (add.exclude) {
-    if (missing(exclude) | is.null(exclude)) {
+    if (missing(exclude) || is.null(exclude)) {
       # Generate the column name
       exclude <-
         setdiff(c("exclude", paste0("exclude.", max(names(object[[dataname]])))),
@@ -154,7 +154,7 @@ setExcludeColumn <- function(object, exclude = NULL, dataname = "data") {
     } else {
       if (is.factor(object[[dataname]][[exclude]])) {
         object[[dataname]][[exclude]] <- as.character(object[[dataname]][[exclude]])
-      } else if (is.logical(object[[dataname]][[exclude]]) &
+      } else if (is.logical(object[[dataname]][[exclude]]) &&
                  all(is.na(object[[dataname]][[exclude]]))) {
         object[[dataname]][[exclude]] <- rep(NA_character_, nrow(object[[dataname]]))
       } else if (!is.character(object[[dataname]][[exclude]])) {

R/general.functions.R

@@ -110,7 +110,7 @@ signifString <- function(x, ...)
 signifString.data.frame <- function(x, ...) {
   ret <- lapply(x,
                 function(y) {
-                  if (is.numeric(y) & !is.factor(y)) {
+                  if (is.numeric(y) && !is.factor(y)) {
                     signifString(x=y, ...)
                   } else {
                     y