From 287cd04b1d09ae56d292627b13cdaf1eeaa6b69b Mon Sep 17 00:00:00 2001 From: mattfidler Date: Wed, 5 Aug 2026 21:38:27 -0500 Subject: [PATCH 01/10] fix(dde): optExpression and past() durations for DDEs (#1192, #1193) rxOptExpr() could not optimize a past(state, tau) whose delay duration was an expression: ..rxOptLhs() recursed into the duration with the left-hand-side renderer, which only knows names and the dosing-property heads, so past(G, exp(lT)) hit its stop() (after printing the duration into the middle of the progress bar). Only the whole-model path was affected -- .rxDisguiseCmt() hex-encodes the whole left-hand side for the chunked path -- so the same model failed at 10 lines and optimized at 50, and optExpression=TRUE was unusable for a DDE. Render the duration with .rxOptExpr() instead: it parses, and it picks up the same rx_expr_ temporary the matching delay() calls do, which is what .rxValidatePast() needs to keep matching them. The chunked path cannot do that (the left-hand side is hidden from the optimizer and restored byte-exactly), so .rxRealignPastTau() re-points a restored past() duration at the one its delay() calls ended up with. Text only -- the duration is never evaluated -- and only when the state's delay() calls agree on exactly one duration; otherwise the line is left for the validator. Separately, the duration was stored as verbatim source text and emitted unresolved by all four past() emitters, while every delay() had its duration inlined by symengine. A duration written as an intermediate (T <- exp(lT)) was therefore emitted into a generated model that intermediate had been dead-code eliminated from, so rxode2(..., calcJac=TRUE), calcSens= and the nlmixr2 estimation models produced a past() naming a duration no delay() used any more and rxSolve() rejected them. .rxPastFromEnv()/.rxTauFromEnv() resolve the duration the way the history already was, by evaluating a surrogate delay(state, tau) in the env so the rendering is identical to the augmented d/dt() by construction (this also covers a constant-folded duration, stored as a plain numeric rather than a Basic). Co-Authored-By: Claude Opus 5 (1M context) --- NEWS.md | 20 +++++++ R/dde.R | 106 ++++++++++++++++++++++++--------- R/rxOptExpr.R | 64 ++++++++++++++++++-- tests/testthat/test-dde-past.R | 71 ++++++++++++++++++++++ tests/testthat/test-opt-expr.R | 40 +++++++++++++ 5 files changed, 268 insertions(+), 33 deletions(-) diff --git a/NEWS.md b/NEWS.md index 6dfe0d104..d10bd8553 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,5 +1,25 @@ # rxode2 5.1.7 +## Bug fixes + +### Delay differential equations + +- `rxOptExpr()` no longer fails on a `past(state, tau)` whose delay duration is + an expression rather than a name or a number (`past(G, exp(lT))`, + `past(G, tau*2)`), which raised `unsupported lhs in optimize expression` and + printed the duration into the middle of the progress bar. This made + `optExpression=TRUE` unusable for such a delay differential equation; it now + optimizes, and the duration follows the same common subexpression its + `delay()` terms do, so the history stays matched to them. + +- A generated delay differential equation model (`rxode2(..., calcJac=TRUE)`, + `calcSens=`, or an nlmixr2 estimation model) now resolves the `past()` delay + duration the same way it resolves the history itself. A duration written as + an intermediate (`T <- exp(lT)`) was emitted verbatim while every `delay()` + had its duration inlined, so the generated model named a duration no `delay()` + used any more and `rxSolve()` rejected it with `duration 'T' does not match + any delay(...)`. + # rxode2 5.1.6 ## New features diff --git a/R/dde.R b/R/dde.R index d000f6797..11bc89f38 100644 --- a/R/dde.R +++ b/R/dde.R @@ -67,6 +67,69 @@ .df } +#' Resolve a stored past() delay duration through a symengine env +#' +#' The duration is rendered by evaluating a surrogate `delay(state, tau)` in the +#' env and taking its second argument back off, so it comes out byte-identical to +#' the duration `.rxDelaySensAugment()` reads off the augmented `d/dt()` (which is +#' `deparse1()` of the same `rxFromSE()` round trip). Evaluating the duration on +#' its own is the fallback; a constant-folded intermediate is stored as a plain R +#' numeric rather than a `Basic`, which is exactly the case the surrogate gets +#' right and a bare `eval()` does not. An unresolvable duration (env binding +#' missing, eval error) keeps its stored text. +#' +#' @param model symengine environment. +#' @param state state the history belongs to. +#' @param tauTxt stored duration text (`rx__pastTau_STATE__`). +#' @return duration text to emit. +#' @noRd +.rxTauFromEnv <- function(model, state, tauTxt) { + if (is.null(tauTxt)) return(tauTxt) + .b <- tryCatch(eval(parse(text = paste0("delay(", state, ",", tauTxt, ")")), + envir = model), error = function(e) NULL) + if (inherits(.b, "Basic")) { + .c <- tryCatch(parse(text = rxFromSE(.b))[[1L]], error = function(e) NULL) + if (is.call(.c) && length(.c) == 3L) return(deparse1(.c[[3L]])) + } + .t <- tryCatch(eval(parse(text = tauTxt), envir = model), error = function(e) NULL) + if (inherits(.t, "Basic")) return(rxFromSE(.t)) + tauTxt +} + +#' Read a state's stored past() history out of a symengine env, resolved +#' +#' Both the history RHS and the duration are stored as plain rxode2 text +#' (`rx__pastRhs_STATE__` / `rx__pastTau_STATE__`, see `R/symengine.R`). The RHS +#' has always been resolved back through the env; the duration was not, so a +#' duration written as an intermediate (`T`) was emitted verbatim even though that +#' intermediate had been dead-code eliminated from the generated model, while the +#' matching `delay()` had its duration inlined by symengine. Resolving both here +#' is what keeps the emitted `past()` line matched to its `delay()` terms, and +#' keeps the three emitters from drifting apart. +#' +#' @param model symengine environment. +#' @param state state the history belongs to. +#' @return `NULL` when the state has no `past()`, otherwise a list with the +#' resolved duration `tau`, the resolved history text `rhs`, and the history +#' `Basic` `rhsB` (`NULL` when it did not resolve) for differentiation. +#' @noRd +.rxPastFromEnv <- function(model, state) { + .rhsTxt <- base::mget(paste0("rx__pastRhs_", state, "__"), envir = model, + ifnotfound = list(NULL))[[1L]] + if (is.null(.rhsTxt)) return(NULL) + .tauTxt <- base::mget(paste0("rx__pastTau_", state, "__"), envir = model, + ifnotfound = list(NULL))[[1L]] + ## resolve the duration first: rxFromSE() of a Basic holding lag0()/llik*() + ## poisons the next `[[`/get read from the env, and the history RHS is the one + ## that may carry such a call + .tau <- .rxTauFromEnv(model, state, .tauTxt) + .rhsB <- tryCatch(eval(parse(text = .rhsTxt), envir = model), + error = function(e) NULL) + list(tau = .tau, + rhs = if (inherits(.rhsB, "Basic")) rxFromSE(.rhsB) else .rhsTxt, + rhsB = if (inherits(.rhsB, "Basic")) .rhsB else NULL) +} + #' Base past(state, tau) <- expr history lines from a symengine env #' #' Rebuilds the base `past(state,tau)=expr` line(s) from the stored @@ -83,16 +146,10 @@ .states <- tryCatch(rxode2::rxStateOde(model), error = function(e) character(0)) .lines <- character(0) for (.si in .states) { - .rhsTxt <- base::mget(paste0("rx__pastRhs_", .si, "__"), envir = model, - ifnotfound = list(NULL))[[1L]] - if (is.null(.rhsTxt)) next - .tauTxt <- base::mget(paste0("rx__pastTau_", .si, "__"), envir = model, - ifnotfound = list(NULL))[[1L]] ## resolve through the env so the injected line references root parameters - .rhsB <- tryCatch(eval(parse(text = .rhsTxt), envir = model), - error = function(e) NULL) - .rhsOut <- if (!is.null(.rhsB) && inherits(.rhsB, "Basic")) rxFromSE(.rhsB) else .rhsTxt - .lines <- c(.lines, sprintf("past(%s,%s)=%s", .si, .tauTxt, .rhsOut)) + .p <- .rxPastFromEnv(model, .si) + if (is.null(.p)) next + .lines <- c(.lines, sprintf("past(%s,%s)=%s", .si, .p$tau, .p$rhs)) } if (length(.lines)) .lines else NULL } @@ -380,21 +437,16 @@ .baseLines <- character(0) # base state history (also needed by gradient-free SAEM) .pastLines <- character(0) # base + per-sensitivity-compartment histories for (.si in .states) { - .rhsTxt <- base::mget(paste0("rx__pastRhs_", .si, "__"), envir = model, - ifnotfound = list(NULL))[[1L]] - if (is.null(.rhsTxt)) next - .tauTxt <- base::mget(paste0("rx__pastTau_", .si, "__"), envir = model, - ifnotfound = list(NULL))[[1L]] ## resolve through the env so the line references root parameters ## (past()-only intermediates are dead-code eliminated from the model) - .rhsB <- tryCatch(eval(parse(text = .rhsTxt), envir = model), - error = function(e) NULL) - .rhsOut <- if (!is.null(.rhsB) && inherits(.rhsB, "Basic")) rxFromSE(.rhsB) else .rhsTxt - .base <- sprintf("past(%s,%s)=%s", .si, .tauTxt, .rhsOut) + .pe <- .rxPastFromEnv(model, .si) + if (is.null(.pe)) next + .rhsB <- .pe$rhsB + .base <- sprintf("past(%s,%s)=%s", .si, .pe$tau, .pe$rhs) .baseLines <- c(.baseLines, .base) .pastLines <- c(.pastLines, .base) ## sens-compartment pre-history: d(history)/d(param) - if (is.null(.rhsB) || !inherits(.rhsB, "Basic")) next + if (is.null(.rhsB)) next for (.p in params) { .dp <- tryCatch(symengine::D(.rhsB, symengine::S(.p)), error = function(e) NULL) if (is.null(.dp)) next @@ -402,7 +454,7 @@ if (identical(.dpTxt, "0")) next .pastLines <- c(.pastLines, sprintf("past(rx__sens_%s_BY_%s__,%s)=%s", - .si, .p, .tauTxt, .dpTxt)) + .si, .p, .pe$tau, .dpTxt)) } } ## append; unique dedups the base past() line shared by the 1st/2nd-order augments @@ -845,14 +897,10 @@ ## 2nd-order pre-history: past(rx__sens_s_BY_p_BY_q__, tau) = d^2 expr/dp dq .pastLines2 <- character(0) for (.si in .states) { - .rhsTxt <- base::mget(paste0("rx__pastRhs_", .si, "__"), envir = model, - ifnotfound = list(NULL))[[1L]] - if (is.null(.rhsTxt)) next - .tauTxt <- base::mget(paste0("rx__pastTau_", .si, "__"), envir = model, - ifnotfound = list(NULL))[[1L]] - .rhsB <- tryCatch(eval(parse(text = .rhsTxt), envir = model), - error = function(e) NULL) - if (is.null(.rhsB) || !inherits(.rhsB, "Basic")) next + .pe <- .rxPastFromEnv(model, .si) + if (is.null(.pe)) next + .rhsB <- .pe$rhsB + if (is.null(.rhsB)) next .cmts <- regmatches(sensVec, regexpr(paste0("rx__sens_", .si, "_BY_[^,)]+_BY_[^,)]+__"), sensVec)) @@ -867,7 +915,7 @@ .d2Txt <- rxFromSE(.d2) if (identical(.d2Txt, "0")) next .pastLines2 <- c(.pastLines2, - sprintf("past(%s,%s)=%s", .cmt, .tauTxt, .d2Txt)) + sprintf("past(%s,%s)=%s", .cmt, .pe$tau, .d2Txt)) } } if (length(.pastLines2)) { diff --git a/R/rxOptExpr.R b/R/rxOptExpr.R index 8ce694f91..c659279ed 100644 --- a/R/rxOptExpr.R +++ b/R/rxOptExpr.R @@ -167,7 +167,15 @@ } else if (identical(x[[1]], quote(`dur`))) { return(paste0("dur(", ..rxOptLhs(x[[2]]), ")")) } else if (identical(x[[1]], quote(`past`))) { - return(paste0("past(", ..rxOptLhs(x[[2]]), ",", ..rxOptLhs(x[[3]]), ")")) + ## The delay duration is an ordinary expression, not a left-hand side, so it + ## is rendered by the right-hand-side optimizer rather than by this one -- + ## which only knows names and the dosing-property heads and would reject any + ## `past(G, exp(lT))`. Going through .rxOptExpr() also makes the duration + ## pick up the SAME rx_expr_ temporary the matching delay(state, tau) calls + ## do, which .rxValidatePast() requires (it matches the two by text). + .tau <- .rxOptExpr(x[[3]]) + if (!is.character(.tau) || length(.tau) != 1L) .tau <- deparse1(x[[3]]) + return(paste0("past(", ..rxOptLhs(x[[2]]), ",", .tau, ")")) } else if (identical(x[[1]], quote(`dy`))) { return(paste0("dy(", ..rxOptLhs(x[[2]]), ")")) } else if (identical(x[[1]], quote(`df`))) { @@ -175,8 +183,7 @@ } else if (identical(x[[2]], 0)) { return(paste0(as.character(x[[1]]), "(0)")) } else { - print(x) - stop("unsupported lhs in optimize expression") + stop("unsupported lhs in optimize expression: ", deparse1(x), call. = FALSE) } } } @@ -544,6 +551,54 @@ txt } +# Re-point a past() duration at the duration its delay() calls actually ended up with. +# +# On the whole-model path ..rxOptLhs() renders the past() duration through the optimizer, +# so it picks up the same rx_expr_ temporary the matching delay(state, tau) calls do. The +# chunked path cannot: .rxDisguiseCmt() hides the whole past() left-hand side from the +# optimizer and restores it byte-exactly, so a duration factored out of the delay() calls +# would leave past(state, tau) naming an expression no delay(state, ...) uses any more -- +# which .rxValidatePast() rejects at solve time. +# +# This is text only, and no model semantics are involved: the duration on a past() line is +# never evaluated (it exists so a history can be matched to its delay(); see +# src/parseCmtProperties.h). A duration is only re-pointed when the state's delay() calls +# agree on exactly one duration; with several the past() line is left alone, since a single +# history cannot say which one it belongs to anyway and the validator should say so. +.rxRealignPastTau <- function(txt) { + .ln <- strsplit(txt, "\n", fixed = TRUE)[[1]] + .id <- "[a-zA-Z][a-zA-Z0-9_.]*" + .eq <- regexpr("=", .ln, fixed = TRUE) + .lhs <- ifelse(.eq > 0L, substr(.ln, 1L, .eq - 1L), "") + .isPast <- .eq > 0L & + grepl(paste0("^[ \t]*past[ \t]*\\([ \t]*", .id, "[ \t]*,.*\\)[ \t]*$"), .lhs) + if (!any(.isPast)) return(txt) + .e <- tryCatch(parse(text = paste0("{\n", txt, "\n}"))[[1L]], error = function(e) NULL) + if (is.null(.e)) return(txt) + .dly <- list() + .walk <- function(x) { + if (is.call(x)) { + if (identical(x[[1]], quote(delay)) && length(x) == 3L) { + .st <- deparse1(x[[2]]) + .dly[[.st]] <<- unique(c(.dly[[.st]], deparse1(x[[3]]))) + } + for (.i in seq_along(x)) .walk(x[[.i]]) + } + } + .walk(.e) + for (.i in which(.isPast)) { + .p <- tryCatch(parse(text = .lhs[.i])[[1L]], error = function(e) NULL) + if (is.null(.p) || !is.call(.p) || length(.p) != 3L) next + .st <- deparse1(.p[[2L]]) + .d <- .dly[[.st]] + if (is.null(.d) || length(.d) != 1L || deparse1(.p[[3L]]) %in% .d) next + .lead <- sub("^([ \t]*).*$", "\\1", .lhs[.i]) + .ln[.i] <- paste0(.lead, "past(", .st, ",", .d, + ")", substr(.ln[.i], .eq[.i], nchar(.ln[.i]))) + } + paste(.ln, collapse = "\n") +} + # A chunk is itself a (smaller) model, so optimize it with rxOptExpr() and chunking off. # Each chunk restarts its rx_expr_ counter at zero, so the names one chunk introduces would # collide with another's once reassembled; prefix them per chunk. @@ -685,7 +740,8 @@ if (is.null(.opt)) { return(rxOptExpr(.txt, msg = msg, chunkLines = 0L)) } - .rxRestoreCmt(.rxRestoreDelay(paste(.opt, collapse = "\n"), .delay$map)) + .out <- .rxRestoreCmt(.rxRestoreDelay(paste(.opt, collapse = "\n"), .delay$map)) + .rxRealignPastTau(.out) } #' Optimize rxode2 for computer evaluation diff --git a/tests/testthat/test-dde-past.R b/tests/testthat/test-dde-past.R index b4e9c1d3b..1a8a891ff 100644 --- a/tests/testthat/test-dde-past.R +++ b/tests/testthat/test-dde-past.R @@ -146,4 +146,75 @@ rxTest({ dense = TRUE) expect_equal(.s1$R2, .s2$R2, tolerance = 1e-8) }) + + # An expression duration is the case the estimation models hit: symengine inlines + # `T <- exp(lT)` into every delay(), and rxOptExpr() then factors that expression + # into a temporary. Both must keep the past() line matched to its delay() (#1192). + test_that("an expression past() duration optimizes and keeps its delay() match", { + .filler <- paste(sprintf("v%d = %d * exp(kg * t) + sin(v0 * %d)", 1:45, 1:45, 1:45), + collapse = "\n") + .head <- paste0( + "lT = 2.5\na = 1\nb = 0.5\nk3 = 5\nkg = 0.4\nk4 = 0.3\nk5 = 0.1\nv0 = 2\n", + "G(0) = a\nd/dt(G) = k3 - kg * G\n", + "I(0) = 0\nd/dt(I) = k4 * G - k4 * delay(G, exp(lT))\n", + "D(0) = 0\nd/dt(D) = k4 * delay(G, exp(lT)) - k5 * D\n") + .tail <- "R2 = D\npast(G, exp(lT)) = a * exp(b * t)\n" + .ev <- et(seq(0, 30, by = 1)) + .sol <- function(.x) { + rxSolve(rxode2(.x), .ev, method = "dop853", atol = 1e-10, rtol = 1e-10, + dense = TRUE) + } + for (.chunkLines in c(0L, 40L)) { + # pad past chunkLines only for the chunked arm, so each arm exercises its path + .mod <- if (.chunkLines == 0L) paste0(.head, .tail) + else paste0(.head, .filler, "\n", .tail) + .o <- suppressMessages(rxOptExpr(.mod, "m", chunkLines = .chunkLines)) + expect_error(rxModelVars(.o), NA) + # the duration was factored out of the delay() calls ... + expect_true(grepl("delay\\(G, *rx_expr_", .o)) + # ... and the past() line followed it, so the history still matches its delay() + expect_true(grepl("past\\(G,rx_expr_", .o)) + expect_error(rxode2:::.rxValidatePast(rxModelVars(.o)), NA) + # optimizing must not change what the model means + expect_equal(.sol(.mod)$R2, .sol(.o)$R2, tolerance = 1e-8) + } + }) + + # The duration was stored as verbatim source text and emitted unresolved, while every + # delay() had its duration inlined by symengine -- so a generated model carried a + # past() naming an expression no delay() used any more (#1193). + .genModel <- "T=exp(lT)\nk=0.3\ny(0)=1\nd/dt(y)=-k*delay(y,T)\npast(y,T)=exp(b*t)\n" + + test_that("generated models keep the past() duration matched to delay() (#1193)", { + .ev <- et(seq(0, 6, by = 0.25)) + .p <- c(lT = 0.2, b = 0.5) + .ref <- rxSolve(rxode2(.genModel), .p, .ev, method = "dop853", dense = TRUE, + atol = 1e-10, rtol = 1e-10) + for (.g in list(rxode2(.genModel, calcJac = TRUE), + suppressMessages(rxode2(.genModel, calcSens = "k")))) { + .n <- gsub(" ", "", rxNorm(.g), fixed = TRUE) + expect_false(grepl("past(y,T)", .n, fixed = TRUE)) + expect_true(grepl("past(y,exp(lT))", .n, fixed = TRUE)) + expect_error(rxode2:::.rxValidatePast(.g), NA) + # ... and the generated model therefore solves, and means the same thing + .s <- rxSolve(.g, .p, .ev, method = "dop853", dense = TRUE, + atol = 1e-10, rtol = 1e-10) + expect_equal(.s$y, .ref$y, tolerance = 1e-8) + } + }) + + test_that("sensitivity-compartment histories carry the resolved duration too", { + # differentiating the history w.r.t. b is non-zero, so .rxDelaySensAugment() also + # emits a past(rx__sens_y_BY_b__, tau) line -- it must resolve the duration the + # same way the base history does, and .rxValidatePast() skips rx__sens_ lines so + # only a test can say so + .g <- suppressMessages(rxode2(.genModel, calcSens = "b")) + .past <- .rxPastTerms(.g) + expect_equal(length(.past), 2L) # base + rx__sens_ history + .tau <- vapply(.past, `[[`, character(1), "tau") + expect_false(any(.tau == "T")) + expect_equal(length(unique(.tau)), 1L) + # the duration is the one the model's delay() terms actually use + expect_true(all(.tau %in% .rxDelayTerms(.g)$tau)) + }) }) diff --git a/tests/testthat/test-opt-expr.R b/tests/testthat/test-opt-expr.R index 242ded420..fd31d6117 100644 --- a/tests/testthat/test-opt-expr.R +++ b/tests/testthat/test-opt-expr.R @@ -335,4 +335,44 @@ rxTest({ expect_identical(.par, .seq) expect_equal(sum(mirai::status()$connections), 0L) }) + + # A past() duration is an ordinary expression, not a left-hand side; rendering it with + # ..rxOptLhs() only ever worked for a name, a number, `(x)` and `x/y` (the last two by + # accident -- they are there for d/dt(x)) and stopped on anything else (#1192). + .pastModel <- function(tau) { + paste(c("lT=1.2", "a=1", "b=0.5", "k3=5", "kg=0.4", + "G(0)=a", "d/dt(G)=k3-kg*G", + sprintf("past(G,%s)=a*exp(b*t)", tau), + sprintf("z1=delay(G,%s)", tau), + sprintf("z2=2*delay(G,%s)", tau)), collapse = "\n") + } + + test_that("a past() duration that is an expression optimizes (#1192)", { + for (.tau in c("exp(lT)", "lT*2", "2^lT", "exp(THETA[1]+ETA[1])")) { + .o <- suppressMessages(rxOptExpr(.pastModel(.tau), "model", chunkLines = 0L)) + expect_error(rxModelVars(.o), NA) + # the duration picked up the same temporary the delay() calls did, so the + # past() history still matches its delay() -- see .rxValidatePast() + expect_error(rxode2:::.rxValidatePast(rxModelVars(.o)), NA) + expect_true(grepl("past\\(G,rx_expr_[0-9]+\\)", .o)) + expect_true(grepl("delay\\(G, *rx_expr_[0-9]+\\)", .o)) + } + }) + + test_that("a degenerate past() duration is rendered exactly as before", { + for (.tau in c("lT", "12.8", "(lT)")) { + .o <- suppressMessages(rxOptExpr(.pastModel(.tau), "model", chunkLines = 0L)) + expect_true(grepl(sprintf("past(G,%s)=", .tau), .o, fixed = TRUE)) + expect_error(rxode2:::.rxValidatePast(rxModelVars(.o)), NA) + } + }) + + test_that("an unsupported lhs names itself and does not print (#1192)", { + # the branch is only reachable directly -- an unsupported lhs is already a parse + # error in rxModelVars() -- but the stray print() it used to do landed in the + # middle of the progress bar + expect_error(rxode2:::..rxOptLhs(quote(foo(bar, baz))), + "foo(bar, baz)", fixed = TRUE) + expect_output(try(rxode2:::..rxOptLhs(quote(foo(bar, baz))), silent = TRUE), NA) + }) }) From d1c8b2b0459913d990da261a066e9a4f5d2b8c6f Mon Sep 17 00:00:00 2001 From: mattfidler Date: Wed, 5 Aug 2026 22:06:55 -0500 Subject: [PATCH 02/10] fix(dde): re-point a chunked past() duration without parsing the model Follow-up to the review of the previous commit. .rxRealignPastTau() decided which past() lines to touch by splitting each line at its first "=" and found the delay() durations by parsing the whole reassembled model as R. Three ways that fell short: - a duration holding an "=" (past(G, h(x)==1)) split in the wrong place, so the line was skipped and left unmatched; - the reassembled text is rxode2 syntax and not guaranteed to be valid R, so a parse failure silently skipped every past() line in the model; - a state whose delay() calls used more than one duration was skipped outright, which a two-delay/two-past() model does legitimately. Delimit the past() left-hand side with the parenthesis matching past(, and scan for delay(state, tau) by matching parentheses the way .rxDisguiseDelayChunks() already does, so neither depends on the text parsing as R. Optimizing never reorders statements, so a state's delay() durations keep their order of first appearance: .rxOptExprChunked() now passes the pre-optimization text in and each past() line follows the delay() it came from. A single duration remains unambiguous without it; anything else is still left for .rxValidatePast(). Co-Authored-By: Claude Opus 5 (1M context) --- R/rxOptExpr.R | 139 +++++++++++++++++++++++++-------- tests/testthat/test-opt-expr.R | 34 ++++++++ 2 files changed, 141 insertions(+), 32 deletions(-) diff --git a/R/rxOptExpr.R b/R/rxOptExpr.R index c659279ed..c10c1f1d5 100644 --- a/R/rxOptExpr.R +++ b/R/rxOptExpr.R @@ -551,6 +551,80 @@ txt } +# Index of the ")" matching the "(" at `open`, or NA when the line does not close it. +.rxMatchParen <- function(line, open) { + .ch <- strsplit(substr(line, open, nchar(line)), "", fixed = TRUE)[[1]] + .rel <- which(cumsum((.ch == "(") - (.ch == ")")) == 0L)[1L] + if (is.na(.rel)) NA_integer_ else open + .rel - 1L +} + +# Split "state, tau" at its top-level comma. NULL when there is no such comma or the +# first argument is not a plain name (`delay(f(x), tau)` is not a state). +.rxSplitStateTau <- function(inner) { + .ch <- strsplit(inner, "", fixed = TRUE)[[1]] + .depth <- cumsum((.ch == "(") - (.ch == ")")) + .at <- which(.ch == "," & .depth == 0L)[1L] + if (is.na(.at)) return(NULL) + .st <- trimws(substr(inner, 1L, .at - 1L)) + if (!grepl("^[a-zA-Z][a-zA-Z0-9_.]*$", .st)) return(NULL) + list(state = .st, tau = trimws(substr(inner, .at + 1L, nchar(inner)))) +} + +# Comparable form of a duration: whatever spacing the text carries, two durations that +# parse to the same expression compare equal. Text that does not parse compares as itself. +.rxTauKey <- function(tau) { + .e <- tryCatch(parse(text = tau)[[1L]], error = function(e) NULL) + if (is.null(.e)) trimws(tau) else deparse1(.e) +} + +# Durations of every delay(state, tau) in `txt`, per state, in order of first appearance. +# Found by matching parentheses rather than by parsing, the way .rxDisguiseDelayChunks() +# already scans for the same calls: `txt` is reassembled optimizer output, which is rxode2 +# syntax and not guaranteed to be valid R, and a scan that quietly stopped working on some +# model shape would silently leave a past() line unmatched. +.rxDelayDurs <- function(txt) { + .re <- "(? 0L, substr(.ln, 1L, .eq - 1L), "") - .isPast <- .eq > 0L & - grepl(paste0("^[ \t]*past[ \t]*\\([ \t]*", .id, "[ \t]*,.*\\)[ \t]*$"), .lhs) - if (!any(.isPast)) return(txt) - .e <- tryCatch(parse(text = paste0("{\n", txt, "\n}"))[[1L]], error = function(e) NULL) - if (is.null(.e)) return(txt) - .dly <- list() - .walk <- function(x) { - if (is.call(x)) { - if (identical(x[[1]], quote(delay)) && length(x) == 3L) { - .st <- deparse1(x[[2]]) - .dly[[.st]] <<- unique(c(.dly[[.st]], deparse1(x[[3]]))) - } - for (.i in seq_along(x)) .walk(x[[.i]]) + .parts <- lapply(.ln, .rxPastLineParts) + .isPast <- which(!vapply(.parts, is.null, logical(1))) + if (length(.isPast) == 0L) return(txt) + .opt <- .rxDelayDurs(txt) + .org <- if (is.null(orig)) .opt else .rxDelayDurs(orig) + .did <- FALSE + for (.i in .isPast) { + .p <- .parts[[.i]] + .o <- .opt[[.p$state]] + if (is.null(.o)) next + .key <- .rxTauKey(.p$tau) + if (.key %in% vapply(.o, .rxTauKey, character(1))) next # already matches + .g <- .org[[.p$state]] + .new <- NULL + if (!is.null(.g) && length(.g) == length(.o)) { + .j <- match(.key, vapply(.g, .rxTauKey, character(1))) + if (!is.na(.j)) .new <- .o[[.j]] } + # the pre-optimization text could not say which one it was (or was not given): a + # single duration is still unambiguous + if (is.null(.new) && length(.o) == 1L) .new <- .o[[1L]] + if (is.null(.new)) next + # keep the caller's spacing: only the duration inside past(...) is rewritten + .ln[.i] <- paste0(.p$lead, "past(", .p$state, ",", .new, ")", .p$rest) + .did <- TRUE } - .walk(.e) - for (.i in which(.isPast)) { - .p <- tryCatch(parse(text = .lhs[.i])[[1L]], error = function(e) NULL) - if (is.null(.p) || !is.call(.p) || length(.p) != 3L) next - .st <- deparse1(.p[[2L]]) - .d <- .dly[[.st]] - if (is.null(.d) || length(.d) != 1L || deparse1(.p[[3L]]) %in% .d) next - .lead <- sub("^([ \t]*).*$", "\\1", .lhs[.i]) - .ln[.i] <- paste0(.lead, "past(", .st, ",", .d, - ")", substr(.ln[.i], .eq[.i], nchar(.ln[.i]))) - } + if (!.did) return(txt) paste(.ln, collapse = "\n") } @@ -741,7 +816,7 @@ return(rxOptExpr(.txt, msg = msg, chunkLines = 0L)) } .out <- .rxRestoreCmt(.rxRestoreDelay(paste(.opt, collapse = "\n"), .delay$map)) - .rxRealignPastTau(.out) + .rxRealignPastTau(.out, .txt) } #' Optimize rxode2 for computer evaluation diff --git a/tests/testthat/test-opt-expr.R b/tests/testthat/test-opt-expr.R index fd31d6117..d2efdd72f 100644 --- a/tests/testthat/test-opt-expr.R +++ b/tests/testthat/test-opt-expr.R @@ -367,6 +367,40 @@ rxTest({ } }) + test_that(".rxRealignPastTau() only ever rewrites the duration it is sure of", { + .r <- rxode2:::.rxRealignPastTau + .pastOf <- function(.x) grep("past\\(", strsplit(.x, "\n")[[1]], value = TRUE) + # nothing to do: no past() at all, and a past() already naming its delay's duration + .none <- "d/dt(G)=-delay(G,rx_expr_0)\nrx_expr_0~exp(lT)\n" + expect_identical(.r(.none), .none) + .ok <- "past(G,exp(lT))=2\nd/dt(G)=-delay(G,exp(lT))\n" + expect_identical(.r(.ok), .ok) + # the left-hand side is delimited by the parenthesis matching past(, not by the first + # "=", so a duration holding one is still re-pointed + .eq <- "past(G, h(x)==1)=2\nd/dt(G)=-delay(G,rx_expr_0)\nrx_expr_0~h(x)==1\n" + expect_identical(.pastOf(.r(.eq)), "past(G,rx_expr_0)=2") + # the delay() scan matches parentheses rather than parsing, so a model whose + # if/else the R parser would reject is still realigned + .ie <- paste(c("if (t>0) {", "v1=1", "}", "else {", "v1=2", "}", + "rx_expr_0~exp(lT)", "d/dt(G)=-delay(G, rx_expr_0)", + "past(G,exp(lT))=2"), collapse = "\n") + expect_identical(.pastOf(.r(.ie)), "past(G,rx_expr_0)=2") + # two distinct durations on one state: with the pre-optimization text each past() + # line follows the delay() it came from (order of first appearance is preserved) ... + .two0 <- paste(c("d/dt(G)=-delay(G, exp(lT))-delay(G, 2*lT)", + "past(G,exp(lT))=2", "past(G,2*lT)=3"), collapse = "\n") + .two1 <- paste(c("rx_expr_0~exp(lT)", "rx_expr_1~2*lT", + "d/dt(G)=-delay(G, rx_expr_0)-delay(G, rx_expr_1)", + "past(G,exp(lT))=2", "past(G,2*lT)=3"), collapse = "\n") + expect_identical(.pastOf(.r(.two1, .two0)), + c("past(G,rx_expr_0)=2", "past(G,rx_expr_1)=3")) + # ... and without it neither line is guessed at + expect_identical(.r(.two1), .two1) + # when it does rewrite, only the duration changes -- spacing is kept + .sp <- " past(G,exp(lT)) = 2\nd/dt(G)=-delay(G,rx_expr_0)\nrx_expr_0~exp(lT)" + expect_identical(strsplit(.r(.sp), "\n")[[1]][1L], " past(G,rx_expr_0) = 2") + }) + test_that("an unsupported lhs names itself and does not print (#1192)", { # the branch is only reachable directly -- an unsupported lhs is already a parse # error in rxModelVars() -- but the stray print() it used to do landed in the From 5885fa021c972ba50639f121a8dcbda1d04ac67c Mon Sep 17 00:00:00 2001 From: mattfidler Date: Fri, 7 Aug 2026 01:41:39 -0500 Subject: [PATCH 03/10] style: address CodeFactor findings on the past()/optExpr changes - drop the explicit return() on the past() branch of ..rxOptLhs() (the if/else chain is the function's last expression) - call the internal .rxValidatePast()/.rxRealignPastTau()/..rxOptLhs() unqualified in the new tests, as the rest of the suite does, instead of going through rxode2::: --- R/rxOptExpr.R | 2 +- tests/testthat/test-dde-past.R | 4 ++-- tests/testthat/test-opt-expr.R | 10 +++++----- 3 files changed, 8 insertions(+), 8 deletions(-) diff --git a/R/rxOptExpr.R b/R/rxOptExpr.R index c10c1f1d5..889b758af 100644 --- a/R/rxOptExpr.R +++ b/R/rxOptExpr.R @@ -175,7 +175,7 @@ ## do, which .rxValidatePast() requires (it matches the two by text). .tau <- .rxOptExpr(x[[3]]) if (!is.character(.tau) || length(.tau) != 1L) .tau <- deparse1(x[[3]]) - return(paste0("past(", ..rxOptLhs(x[[2]]), ",", .tau, ")")) + paste0("past(", ..rxOptLhs(x[[2]]), ",", .tau, ")") } else if (identical(x[[1]], quote(`dy`))) { return(paste0("dy(", ..rxOptLhs(x[[2]]), ")")) } else if (identical(x[[1]], quote(`df`))) { diff --git a/tests/testthat/test-dde-past.R b/tests/testthat/test-dde-past.R index 1a8a891ff..05b351163 100644 --- a/tests/testthat/test-dde-past.R +++ b/tests/testthat/test-dde-past.R @@ -174,7 +174,7 @@ rxTest({ expect_true(grepl("delay\\(G, *rx_expr_", .o)) # ... and the past() line followed it, so the history still matches its delay() expect_true(grepl("past\\(G,rx_expr_", .o)) - expect_error(rxode2:::.rxValidatePast(rxModelVars(.o)), NA) + expect_error(.rxValidatePast(rxModelVars(.o)), NA) # optimizing must not change what the model means expect_equal(.sol(.mod)$R2, .sol(.o)$R2, tolerance = 1e-8) } @@ -195,7 +195,7 @@ rxTest({ .n <- gsub(" ", "", rxNorm(.g), fixed = TRUE) expect_false(grepl("past(y,T)", .n, fixed = TRUE)) expect_true(grepl("past(y,exp(lT))", .n, fixed = TRUE)) - expect_error(rxode2:::.rxValidatePast(.g), NA) + expect_error(.rxValidatePast(.g), NA) # ... and the generated model therefore solves, and means the same thing .s <- rxSolve(.g, .p, .ev, method = "dop853", dense = TRUE, atol = 1e-10, rtol = 1e-10) diff --git a/tests/testthat/test-opt-expr.R b/tests/testthat/test-opt-expr.R index d2efdd72f..2fdcd13e7 100644 --- a/tests/testthat/test-opt-expr.R +++ b/tests/testthat/test-opt-expr.R @@ -353,7 +353,7 @@ rxTest({ expect_error(rxModelVars(.o), NA) # the duration picked up the same temporary the delay() calls did, so the # past() history still matches its delay() -- see .rxValidatePast() - expect_error(rxode2:::.rxValidatePast(rxModelVars(.o)), NA) + expect_error(.rxValidatePast(rxModelVars(.o)), NA) expect_true(grepl("past\\(G,rx_expr_[0-9]+\\)", .o)) expect_true(grepl("delay\\(G, *rx_expr_[0-9]+\\)", .o)) } @@ -363,12 +363,12 @@ rxTest({ for (.tau in c("lT", "12.8", "(lT)")) { .o <- suppressMessages(rxOptExpr(.pastModel(.tau), "model", chunkLines = 0L)) expect_true(grepl(sprintf("past(G,%s)=", .tau), .o, fixed = TRUE)) - expect_error(rxode2:::.rxValidatePast(rxModelVars(.o)), NA) + expect_error(.rxValidatePast(rxModelVars(.o)), NA) } }) test_that(".rxRealignPastTau() only ever rewrites the duration it is sure of", { - .r <- rxode2:::.rxRealignPastTau + .r <- .rxRealignPastTau .pastOf <- function(.x) grep("past\\(", strsplit(.x, "\n")[[1]], value = TRUE) # nothing to do: no past() at all, and a past() already naming its delay's duration .none <- "d/dt(G)=-delay(G,rx_expr_0)\nrx_expr_0~exp(lT)\n" @@ -405,8 +405,8 @@ rxTest({ # the branch is only reachable directly -- an unsupported lhs is already a parse # error in rxModelVars() -- but the stray print() it used to do landed in the # middle of the progress bar - expect_error(rxode2:::..rxOptLhs(quote(foo(bar, baz))), + expect_error(..rxOptLhs(quote(foo(bar, baz))), "foo(bar, baz)", fixed = TRUE) - expect_output(try(rxode2:::..rxOptLhs(quote(foo(bar, baz))), silent = TRUE), NA) + expect_output(try(..rxOptLhs(quote(foo(bar, baz))), silent = TRUE), NA) }) }) From 057444fe3ae4f916a62426254bf8558a7ff49b50 Mon Sep 17 00:00:00 2001 From: mattfidler Date: Fri, 7 Aug 2026 01:58:43 -0500 Subject: [PATCH 04/10] fix(dde): resolve THETA[]/ETA[] in past(), and never invent a duration Three defects found by an independent review pass over the branch. R/dde.R -- the stored past() pieces are rxode2 source text, where THETA[1] is a subscript; in the symengine env it is the symbol THETA_1_. Evaluating the text directly therefore failed on every mu-referenced model, so .rxTauFromEnv() fell back to the verbatim duration while the matching delay() had its own inlined -- exactly the #1193 mismatch the branch set out to fix, still reachable from rxode2(mod, calcJac=TRUE) with a THETA[] duration. The same eval resolved the history, and an unresolved history is not a Basic, so .rxDelaySensAugment() also emitted no per-parameter sensitivity pre-history at all. Both now go through .rxSeEvalTxt(), which translates with .rxToSE() first. R/rxOptExpr.R -- .rxRealignPastTau() re-pointed a duration that had matched no delay() BEFORE optimizing, so the chunked path silently accepted a duration the whole-model path rejects (past(G,typo) became past(G,rx_expr_0)). It now rewrites only a duration that did match one, and takes the single-duration fallback only when a single past() line claims it, so two histories cannot be collapsed onto one duration with one silently shadowing the other. --- NEWS.md | 5 +++- R/dde.R | 44 ++++++++++++++++++++++++++-------- R/rxOptExpr.R | 19 +++++++++++---- tests/testthat/test-dde-past.R | 24 +++++++++++++++++++ tests/testthat/test-opt-expr.R | 28 ++++++++++++++++++++++ 5 files changed, 105 insertions(+), 15 deletions(-) diff --git a/NEWS.md b/NEWS.md index d10bd8553..45168fdbf 100644 --- a/NEWS.md +++ b/NEWS.md @@ -18,7 +18,10 @@ an intermediate (`T <- exp(lT)`) was emitted verbatim while every `delay()` had its duration inlined, so the generated model named a duration no `delay()` used any more and `rxSolve()` rejected it with `duration 'T' does not match - any delay(...)`. + any delay(...)`. This also covers a duration or a history written with + `THETA[n]`/`ETA[n]`, as every mu-referenced model is: they were left + unresolved, and an unresolved history additionally emitted no per-parameter + sensitivity pre-history at all. # rxode2 5.1.6 diff --git a/R/dde.R b/R/dde.R index 11bc89f38..95a675d56 100644 --- a/R/dde.R +++ b/R/dde.R @@ -67,6 +67,29 @@ .df } +#' Evaluate stored rxode2 text in a symengine env +#' +#' The `past()` pieces are stored as plain rxode2 source text, which is not +#' symengine syntax: `THETA[1]`/`ETA[1]` are subscripts there and symbols +#' (`THETA_1_`) in the env, so evaluating the text directly fails on every +#' mu-referenced model. Translate it the way the model body itself was +#' translated, then evaluate inside `with()` (the safe idiom -- symengine masks +#' `get`/`[[`). +#' +#' @param model symengine environment. +#' @param txt rxode2 source text. +#' @return the `Basic` it evaluates to, or `NULL` when it does not resolve. +#' @noRd +.rxSeEvalTxt <- function(model, txt) { + .e <- tryCatch(parse(text = txt)[[1L]], error = function(e) NULL) + if (is.null(.e)) return(NULL) + .se <- tryCatch(.rxToSE(.e, envir = model), error = function(e) NULL) + if (is.null(.se)) return(NULL) + .b <- tryCatch(eval(parse(text = paste0("with(model,", .se, ")"))), + error = function(e) NULL) + if (inherits(.b, "Basic")) .b else NULL +} + #' Resolve a stored past() delay duration through a symengine env #' #' The duration is rendered by evaluating a surrogate `delay(state, tau)` in the @@ -85,14 +108,13 @@ #' @noRd .rxTauFromEnv <- function(model, state, tauTxt) { if (is.null(tauTxt)) return(tauTxt) - .b <- tryCatch(eval(parse(text = paste0("delay(", state, ",", tauTxt, ")")), - envir = model), error = function(e) NULL) - if (inherits(.b, "Basic")) { + .b <- .rxSeEvalTxt(model, paste0("delay(", state, ",", tauTxt, ")")) + if (!is.null(.b)) { .c <- tryCatch(parse(text = rxFromSE(.b))[[1L]], error = function(e) NULL) if (is.call(.c) && length(.c) == 3L) return(deparse1(.c[[3L]])) } - .t <- tryCatch(eval(parse(text = tauTxt), envir = model), error = function(e) NULL) - if (inherits(.t, "Basic")) return(rxFromSE(.t)) + .t <- .rxSeEvalTxt(model, tauTxt) + if (!is.null(.t)) return(rxFromSE(.t)) tauTxt } @@ -105,7 +127,10 @@ #' intermediate had been dead-code eliminated from the generated model, while the #' matching `delay()` had its duration inlined by symengine. Resolving both here #' is what keeps the emitted `past()` line matched to its `delay()` terms, and -#' keeps the three emitters from drifting apart. +#' keeps the three emitters from drifting apart. Both go through `.rxSeEvalTxt()`, +#' so a `THETA[n]`/`ETA[n]` subscript resolves as well -- without it a +#' mu-referenced history resolved to nothing and its per-parameter sensitivity +#' pre-history lines were silently dropped. #' #' @param model symengine environment. #' @param state state the history belongs to. @@ -123,11 +148,10 @@ ## poisons the next `[[`/get read from the env, and the history RHS is the one ## that may carry such a call .tau <- .rxTauFromEnv(model, state, .tauTxt) - .rhsB <- tryCatch(eval(parse(text = .rhsTxt), envir = model), - error = function(e) NULL) + .rhsB <- .rxSeEvalTxt(model, .rhsTxt) list(tau = .tau, - rhs = if (inherits(.rhsB, "Basic")) rxFromSE(.rhsB) else .rhsTxt, - rhsB = if (inherits(.rhsB, "Basic")) .rhsB else NULL) + rhs = if (is.null(.rhsB)) .rhsTxt else rxFromSE(.rhsB), + rhsB = .rhsB) } #' Base past(state, tau) <- expr history lines from a symengine env diff --git a/R/rxOptExpr.R b/R/rxOptExpr.R index 889b758af..e52e6dd2f 100644 --- a/R/rxOptExpr.R +++ b/R/rxOptExpr.R @@ -642,6 +642,13 @@ # disagree on how many durations a state has -- a duration is only re-pointed when the # state's delay() calls agree on exactly one, and otherwise the line is left for the # validator to report. +# +# Only a duration that DID match a delay() before optimizing is ever re-pointed. A +# duration that matched nothing then matches nothing now for a reason of the model's own -- +# a typo, say -- and re-pointing it would turn a duration .rxValidatePast() rejects into +# one it accepts, which is the one thing this pass must not do. For the same reason the +# single-duration fallback is only taken when the state has a single past() line: two +# histories rewritten to one duration would leave one silently shadowing the other. .rxRealignPastTau <- function(txt, orig = NULL) { .ln <- strsplit(txt, "\n", fixed = TRUE)[[1]] .parts <- lapply(.ln, .rxPastLineParts) @@ -649,6 +656,7 @@ if (length(.isPast) == 0L) return(txt) .opt <- .rxDelayDurs(txt) .org <- if (is.null(orig)) .opt else .rxDelayDurs(orig) + .nPast <- table(vapply(.parts[.isPast], function(z) z$state, character(1))) .did <- FALSE for (.i in .isPast) { .p <- .parts[[.i]] @@ -657,14 +665,17 @@ .key <- .rxTauKey(.p$tau) if (.key %in% vapply(.o, .rxTauKey, character(1))) next # already matches .g <- .org[[.p$state]] + .gk <- if (is.null(.g)) character(0) else vapply(.g, .rxTauKey, character(1)) + # it did not match a delay() before optimizing either: not ours to rewrite + if (!is.null(orig) && !(.key %in% .gk)) next .new <- NULL - if (!is.null(.g) && length(.g) == length(.o)) { - .j <- match(.key, vapply(.g, .rxTauKey, character(1))) + if (length(.g) == length(.o)) { + .j <- match(.key, .gk) if (!is.na(.j)) .new <- .o[[.j]] } # the pre-optimization text could not say which one it was (or was not given): a - # single duration is still unambiguous - if (is.null(.new) && length(.o) == 1L) .new <- .o[[1L]] + # single duration is still unambiguous, as long as a single history claims it + if (is.null(.new) && length(.o) == 1L && .nPast[[.p$state]] == 1L) .new <- .o[[1L]] if (is.null(.new)) next # keep the caller's spacing: only the duration inside past(...) is rewritten .ln[.i] <- paste0(.p$lead, "past(", .p$state, ",", .new, ")", .p$rest) diff --git a/tests/testthat/test-dde-past.R b/tests/testthat/test-dde-past.R index 05b351163..7962d58b0 100644 --- a/tests/testthat/test-dde-past.R +++ b/tests/testthat/test-dde-past.R @@ -217,4 +217,28 @@ rxTest({ # the duration is the one the model's delay() terms actually use expect_true(all(.tau %in% .rxDelayTerms(.g)$tau)) }) + + test_that("a THETA[]/ETA[] duration resolves like the rest of the model", { + # the stored duration is rxode2 source text, where THETA[1] is a subscript -- in the + # symengine env it is the symbol THETA_1_, so it has to be translated before it is + # evaluated. Every mu-referenced (nlmixr2) model reaches this. + .m <- paste0("T=exp(lT)\nk=0.3\ny(0)=1\n", + "d/dt(y)=-k*delay(y,T+THETA[1])\npast(y,T+THETA[1])=exp(b*t)\n") + .g <- rxode2(.m, calcJac = TRUE) + .n <- gsub(" ", "", rxNorm(.g), fixed = TRUE) + expect_false(grepl("past(y,T+THETA[1])", .n, fixed = TRUE)) + expect_true(grepl("past(y,THETA[1]+exp(lT))", .n, fixed = TRUE)) + expect_error(.rxValidatePast(.g), NA) + }) + + test_that("a THETA[]/ETA[] history resolves, so it can be differentiated", { + # an unresolved history is not a Basic, and .rxDelaySensAugment() then silently + # emits no per-parameter sensitivity pre-history at all + .e <- rxS(paste0("k=0.3\nG(0)=1\nd/dt(G)=-k*delay(G,exp(THETA[1]))\n", + "past(G,exp(THETA[1]))=exp(ETA[1]*t)\n"), doConst = FALSE) + .p <- .rxPastFromEnv(.e, "G") + expect_equal(.p$tau, "exp(THETA[1])") + expect_equal(.p$rhs, "exp(t*ETA[1])") + expect_true(inherits(.p$rhsB, "Basic")) + }) }) diff --git a/tests/testthat/test-opt-expr.R b/tests/testthat/test-opt-expr.R index 2fdcd13e7..9a955c5bd 100644 --- a/tests/testthat/test-opt-expr.R +++ b/tests/testthat/test-opt-expr.R @@ -399,6 +399,34 @@ rxTest({ # when it does rewrite, only the duration changes -- spacing is kept .sp <- " past(G,exp(lT)) = 2\nd/dt(G)=-delay(G,rx_expr_0)\nrx_expr_0~exp(lT)" expect_identical(strsplit(.r(.sp), "\n")[[1]][1L], " past(G,rx_expr_0) = 2") + # a duration that matched no delay() BEFORE optimizing is the model's own error and + # is left for the validator: re-pointing it would make a rejected duration accepted + .bad1 <- "rx_expr_0~exp(lT)\nd/dt(G)=-delay(G,rx_expr_0)\npast(G,typo)=2\n" + .bad0 <- "d/dt(G)=-delay(G,exp(lT))\npast(G,typo)=2\n" + expect_identical(.r(.bad1, .bad0), .bad1) + # two histories on one state whose delay() durations optimized down to one: rewriting + # both would leave one silently shadowing the other, so neither is guessed at + .mrg0 <- paste(c("d/dt(G)=-delay(G,1+1)-delay(G,2)", + "past(G,1+1)=2", "past(G,2)=3"), collapse = "\n") + .mrg1 <- paste(c("rx_expr_0~2", "d/dt(G)=-delay(G,rx_expr_0)-delay(G,rx_expr_0)", + "past(G,1+1)=2", "past(G,2)=3"), collapse = "\n") + expect_identical(.r(.mrg1, .mrg0), .mrg1) + }) + + test_that("the chunked path rejects a wrong duration the way the whole model does", { + .pad <- paste(sprintf("v%d=%d", 1:60, 1:60), collapse = "\n") + .mod <- function(.tau) { + paste0("lT=0.2\nb=0.5\nG(0)=1\n", .pad, + "\nd/dt(G)=-exp(lT)*delay(G,exp(lT))\npast(G,", .tau, ")=exp(b*t)\n") + } + for (.chunk in c(0L, 10L)) { + .o <- suppressMessages(rxOptExpr(.mod("exp(lT)"), "m", chunkLines = .chunk)) + expect_error(.rxValidatePast(rxModelVars(.o)), NA) + expect_true(grepl("past\\(G,rx_expr_", .o)) + # a genuinely wrong duration still names itself in the error, on either path + .b <- suppressMessages(rxOptExpr(.mod("typo"), "m", chunkLines = .chunk)) + expect_error(.rxValidatePast(rxModelVars(.b)), "'typo' does not match") + } }) test_that("an unsupported lhs names itself and does not print (#1192)", { From 6572901113d00e30ad888a567fde39f8ef871784 Mon Sep 17 00:00:00 2001 From: mattfidler Date: Fri, 7 Aug 2026 02:11:31 -0500 Subject: [PATCH 05/10] fix(dde): read a leading-dot state, and only refuse what the scan could read Second independent review pass. .rxSplitStateTau() required a state name to start with a letter, so a model using a leading-dot state (d/dt(.y.1) parses) had its past() line skipped by .rxRealignPastTau() and left unmatched to its optimized delay(). The "did it match a delay() before optimizing" guard now applies only when the pre-optimization scan actually read that state's delay() durations. The scan reads a line at a time, so a delay() split over lines is not read at all, and the guard would have turned its absence into a refusal to re-point. --- R/rxOptExpr.R | 12 ++++++++---- tests/testthat/test-opt-expr.R | 13 +++++++++++++ 2 files changed, 21 insertions(+), 4 deletions(-) diff --git a/R/rxOptExpr.R b/R/rxOptExpr.R index e52e6dd2f..41e36a83e 100644 --- a/R/rxOptExpr.R +++ b/R/rxOptExpr.R @@ -559,14 +559,15 @@ } # Split "state, tau" at its top-level comma. NULL when there is no such comma or the -# first argument is not a plain name (`delay(f(x), tau)` is not a state). +# first argument is not a plain name (`delay(f(x), tau)` is not a state). A state may +# lead with "." (`d/dt(.y.1)` parses), so a name is not required to start with a letter. .rxSplitStateTau <- function(inner) { .ch <- strsplit(inner, "", fixed = TRUE)[[1]] .depth <- cumsum((.ch == "(") - (.ch == ")")) .at <- which(.ch == "," & .depth == 0L)[1L] if (is.na(.at)) return(NULL) .st <- trimws(substr(inner, 1L, .at - 1L)) - if (!grepl("^[a-zA-Z][a-zA-Z0-9_.]*$", .st)) return(NULL) + if (!grepl("^[a-zA-Z.][a-zA-Z0-9_.]*$", .st)) return(NULL) list(state = .st, tau = trimws(substr(inner, .at + 1L, nchar(inner)))) } @@ -666,8 +667,11 @@ if (.key %in% vapply(.o, .rxTauKey, character(1))) next # already matches .g <- .org[[.p$state]] .gk <- if (is.null(.g)) character(0) else vapply(.g, .rxTauKey, character(1)) - # it did not match a delay() before optimizing either: not ours to rewrite - if (!is.null(orig) && !(.key %in% .gk)) next + # it did not match a delay() before optimizing either: not ours to rewrite. Only when + # the pre-optimization text did say what this state's delay() durations were -- a + # delay() split over lines, say, is not read by the scan, and then there is nothing to + # conclude from its absence + if (!is.null(orig) && length(.gk) > 0L && !(.key %in% .gk)) next .new <- NULL if (length(.g) == length(.o)) { .j <- match(.key, .gk) diff --git a/tests/testthat/test-opt-expr.R b/tests/testthat/test-opt-expr.R index 9a955c5bd..5b8e3de06 100644 --- a/tests/testthat/test-opt-expr.R +++ b/tests/testthat/test-opt-expr.R @@ -411,6 +411,19 @@ rxTest({ .mrg1 <- paste(c("rx_expr_0~2", "d/dt(G)=-delay(G,rx_expr_0)-delay(G,rx_expr_0)", "past(G,1+1)=2", "past(G,2)=3"), collapse = "\n") expect_identical(.r(.mrg1, .mrg0), .mrg1) + # a state may lead with a "." -- d/dt(.y.1) parses, so the scan must take it + .dot <- "past(.y.1,exp(lT))=2\nd/dt(.y.1)=-delay(.y.1,rx_expr_0)\nrx_expr_0~exp(lT)\n" + expect_identical(.pastOf(.r(.dot)), "past(.y.1,rx_expr_0)=2") + # the same duration twice is one duration, so the past() line still follows it + .dup0 <- "d/dt(G)=-delay(G, exp(lT))-delay(G, exp(lT))\npast(G,exp(lT))=2" + .dup1 <- paste(c("rx_expr_0~exp(lT)", "d/dt(G)=-delay(G, rx_expr_0)-delay(G, rx_expr_0)", + "past(G,exp(lT))=2"), collapse = "\n") + expect_identical(.pastOf(.r(.dup1, .dup0)), "past(G,rx_expr_0)=2") + # the scan reads a line at a time, so a delay() split over lines is not read at all -- + # the guard above needs something to have been read before it can refuse a rewrite + .ml0 <- "lT=2.5\nd/dt(G)=-delay(G,\n exp(lT))\npast(G, exp(lT))=10\n" + .ml1 <- "rx_expr_0~exp(lT)\nd/dt(G)=-delay(G, rx_expr_0)\npast(G, exp(lT))=10\n" + expect_identical(.pastOf(.r(.ml1, .ml0)), "past(G,rx_expr_0)=10") }) test_that("the chunked path rejects a wrong duration the way the whole model does", { From b44c229e930912ea78352b463d48290c32b762c1 Mon Sep 17 00:00:00 2001 From: mattfidler Date: Fri, 7 Aug 2026 02:24:48 -0500 Subject: [PATCH 06/10] fix(dde): conclude nothing from a delay() scan that could not read the model Third independent review pass. .rxDelayDurs() reads a line at a time, so a delay() split over lines is not read at all -- and both guards then drew a conclusion the scan had not earned: a past() duration missing from the pre-optimization text was taken as already wrong (it may be the dropped call's), and the durations that were read were matched by position against the optimized ones, which are not the same calls in the same order. Either way a history could be re-pointed at another delay() term's duration, and a genuinely wrong duration could be re-pointed into a valid one on the chunked path. The scan now reports that it could not read a call, and .rxRealignPastTau() leaves every line alone when either text is incomplete -- which is what happened before this pass existed, so the validator says whatever it would have said. --- R/rxOptExpr.R | 21 ++++++++++++++++----- tests/testthat/test-opt-expr.R | 31 ++++++++++++++++++++++++++----- 2 files changed, 42 insertions(+), 10 deletions(-) diff --git a/R/rxOptExpr.R b/R/rxOptExpr.R index 41e36a83e..ccf2678b5 100644 --- a/R/rxOptExpr.R +++ b/R/rxOptExpr.R @@ -583,9 +583,14 @@ # already scans for the same calls: `txt` is reassembled optimizer output, which is rxode2 # syntax and not guaranteed to be valid R, and a scan that quietly stopped working on some # model shape would silently leave a past() line unmatched. +# +# A call the scan cannot read -- one split over lines, say -- sets the "incomplete" +# attribute: the result is then a subset of the model's delay() calls, so neither the +# order of what it did read nor the absence of a duration from it says anything. .rxDelayDurs <- function(txt) { .re <- "(? 0L && !(.key %in% .gk)) next + # it did not match a delay() before optimizing either: not ours to rewrite + if (!is.null(orig) && !(.key %in% .gk)) next .new <- NULL if (length(.g) == length(.o)) { .j <- match(.key, .gk) diff --git a/tests/testthat/test-opt-expr.R b/tests/testthat/test-opt-expr.R index 5b8e3de06..6d62ad411 100644 --- a/tests/testthat/test-opt-expr.R +++ b/tests/testthat/test-opt-expr.R @@ -419,19 +419,40 @@ rxTest({ .dup1 <- paste(c("rx_expr_0~exp(lT)", "d/dt(G)=-delay(G, rx_expr_0)-delay(G, rx_expr_0)", "past(G,exp(lT))=2"), collapse = "\n") expect_identical(.pastOf(.r(.dup1, .dup0)), "past(G,rx_expr_0)=2") - # the scan reads a line at a time, so a delay() split over lines is not read at all -- - # the guard above needs something to have been read before it can refuse a rewrite + # the scan reads a line at a time, so a delay() split over lines is not read at all. + # Either text holding one is only a subset of the model's delay() calls and nothing can + # be concluded from it -- not that a duration was already wrong (it may be the call + # that was dropped), and not which optimized duration a past() line meant. Neither is + # realigned, which is what happened before this pass existed .ml0 <- "lT=2.5\nd/dt(G)=-delay(G,\n exp(lT))\npast(G, exp(lT))=10\n" .ml1 <- "rx_expr_0~exp(lT)\nd/dt(G)=-delay(G, rx_expr_0)\npast(G, exp(lT))=10\n" - expect_identical(.pastOf(.r(.ml1, .ml0)), "past(G,rx_expr_0)=10") + expect_identical(.r(.ml1, .ml0), .ml1) + expect_identical(.r("d/dt(G)=-delay(G,\n rx_expr_0)\npast(G,exp(lT))=2\n"), + "d/dt(G)=-delay(G,\n rx_expr_0)\npast(G,exp(lT))=2\n") + # in particular a duration is never matched by position against a scan that dropped a + # call: here the two readable durations of `orig` line up with the two of the optimized + # text only by coincidence, and past(G,exp(lT)*1) would take tau2's temporary + .co0 <- paste(c("d/dt(G)=-delay(G, exp(lT))-delay(G,", "tau2)-delay(G, exp(lT)*1)", + "past(G, exp(lT))=1", "past(G, tau2)=2", + "past(G, exp(lT)*1)=3"), collapse = "\n") + .co1 <- paste(c("rx_expr_1~exp(lT)", "rx_expr_2~tau2", + "d/dt(G)=-delay(G, rx_expr_1)-delay(G, rx_expr_2)-delay(G, rx_expr_1)", + "past(G, exp(lT))=1", "past(G, tau2)=2", + "past(G, exp(lT)*1)=3"), collapse = "\n") + expect_identical(.r(.co1, .co0), .co1) }) test_that("the chunked path rejects a wrong duration the way the whole model does", { .pad <- paste(sprintf("v%d=%d", 1:60, 1:60), collapse = "\n") - .mod <- function(.tau) { + .mod <- function(.tau, .dt = "delay(G,exp(lT))") { paste0("lT=0.2\nb=0.5\nG(0)=1\n", .pad, - "\nd/dt(G)=-exp(lT)*delay(G,exp(lT))\npast(G,", .tau, ")=exp(b*t)\n") + "\nd/dt(G)=-exp(lT)*", .dt, "\npast(G,", .tau, ")=exp(b*t)\n") } + # ... including when the model's own delay() is split over lines, which the realign + # scan cannot read: an unreadable model must not be guessed into a valid one + expect_error(.rxValidatePast(rxModelVars(suppressMessages( + rxOptExpr(.mod("typo", "delay(G,\n exp(lT))"), "m", chunkLines = 15L)))), + "'typo' does not match") for (.chunk in c(0L, 10L)) { .o <- suppressMessages(rxOptExpr(.mod("exp(lT)"), "m", chunkLines = .chunk)) expect_error(.rxValidatePast(rxModelVars(.o)), NA) From 4678551a9bd77b815f992ac909f47cdb1e413b55 Mon Sep 17 00:00:00 2001 From: mattfidler Date: Fri, 7 Aug 2026 02:35:56 -0500 Subject: [PATCH 07/10] fix(dde): do not read a delay() written in a comment Fourth independent review pass. .rxDelayDurs() matched delay( anywhere on a line, comments included, and the pre-optimization text keeps its comments. A comment naming a delay() the model does not have gave the state a duration no delay() call carries, and .rxRealignPastTau() then refused the rewrite the past() line needed, so the optimized model was rejected by .rxValidatePast(). The scan now takes the code part of a line, tracking string literals so a "#" inside one is not a comment; an unbalanced parenthesis in a comment no longer stops it either. --- R/rxOptExpr.R | 29 ++++++++++++++++++++++++++++- tests/testthat/test-opt-expr.R | 19 +++++++++++++++++++ 2 files changed, 47 insertions(+), 1 deletion(-) diff --git a/R/rxOptExpr.R b/R/rxOptExpr.R index ccf2678b5..9023b6683 100644 --- a/R/rxOptExpr.R +++ b/R/rxOptExpr.R @@ -578,6 +578,32 @@ if (is.null(.e)) trimws(tau) else deparse1(.e) } +# The code part of a line: everything before the first "#" outside a string. A delay() +# written in a comment is not a delay() call, and the scan below must not read one -- nor +# be stopped by an unbalanced parenthesis in one. +.rxStripComment <- function(line) { + if (!grepl("#", line, fixed = TRUE)) return(line) + .ch <- strsplit(line, "", fixed = TRUE)[[1]] + .q <- "" + .i <- 1L + while (.i <= length(.ch)) { + .c <- .ch[.i] + if (nzchar(.q)) { + if (.c == "\\") { + .i <- .i + 1L # escaped: whatever follows is not a delimiter + } else if (.c == .q) { + .q <- "" + } + } else if (.c == "\"" || .c == "'") { + .q <- .c + } else if (.c == "#") { + return(substr(line, 1L, .i - 1L)) + } + .i <- .i + 1L + } + line +} + # Durations of every delay(state, tau) in `txt`, per state, in order of first appearance. # Found by matching parentheses rather than by parsing, the way .rxDisguiseDelayChunks() # already scans for the same calls: `txt` is reassembled optimizer output, which is rxode2 @@ -591,7 +617,8 @@ .re <- "(? Date: Fri, 7 Aug 2026 02:50:12 -0500 Subject: [PATCH 08/10] refactor(dde): require the pre-optimization text to realign a past() duration Fifth review pass. .rxRealignPastTau()'s `orig` defaulted to NULL, and on that branch the "did it match a delay() before optimizing" guard was skipped and the single-duration fallback re-pointed anyway -- so the helper could still turn a duration .rxValidatePast() rejects into one it accepts. Without that text there is nothing to tell a duration that stopped matching from one that never did, and the only caller always has it, so it is now required. Also covered: an operator duration (`a*b`), where the emitted past() line carries deparse1()'s spacing and the augmented d/dt() the rxFromSE() form -- it matches and solves identically, which the comment now states accurately. --- R/dde.R | 8 +++++--- R/rxOptExpr.R | 23 +++++++++++------------ tests/testthat/test-dde-past.R | 15 +++++++++++++++ tests/testthat/test-opt-expr.R | 27 +++++++++++++++++---------- 4 files changed, 48 insertions(+), 25 deletions(-) diff --git a/R/dde.R b/R/dde.R index 95a675d56..28d1559ec 100644 --- a/R/dde.R +++ b/R/dde.R @@ -93,9 +93,11 @@ #' Resolve a stored past() delay duration through a symengine env #' #' The duration is rendered by evaluating a surrogate `delay(state, tau)` in the -#' env and taking its second argument back off, so it comes out byte-identical to -#' the duration `.rxDelaySensAugment()` reads off the augmented `d/dt()` (which is -#' `deparse1()` of the same `rxFromSE()` round trip). Evaluating the duration on +#' env and taking its second argument back off, so it comes out as the same +#' expression the duration `.rxDelaySensAugment()` reads off the augmented +#' `d/dt()` is (both are `deparse1()` of the same `rxFromSE()` round trip; the +#' spacing `deparse1()` puts around an operator is normalized away when a history +#' is matched to its `delay()`). Evaluating the duration on #' its own is the fallback; a constant-folded intermediate is stored as a plain R #' numeric rather than a `Basic`, which is exactly the case the surrogate gets #' right and a bare `eval()` does not. An unresolvable duration (env binding diff --git a/R/rxOptExpr.R b/R/rxOptExpr.R index 9023b6683..ef690f623 100644 --- a/R/rxOptExpr.R +++ b/R/rxOptExpr.R @@ -672,19 +672,18 @@ # This is text only, and no model semantics are involved: the duration on a past() line is # never evaluated (it exists so a history can be matched to its delay(); see # src/parseCmtProperties.h). Optimizing never reorders statements, so a state's delay() -# durations keep their order of first appearance and `orig` (the text before optimizing) -# says which optimized duration each past() line meant. Without it -- or when the two -# disagree on how many durations a state has -- a duration is only re-pointed when the -# state's delay() calls agree on exactly one, and otherwise the line is left for the -# validator to report. +# durations keep their order of first appearance, and `orig` -- the text before optimizing +# -- says which optimized duration each past() line meant. It is required: without it a +# duration that stopped matching cannot be told from one that never matched. # # Only a duration that DID match a delay() before optimizing is ever re-pointed. A # duration that matched nothing then matches nothing now for a reason of the model's own -- # a typo, say -- and re-pointing it would turn a duration .rxValidatePast() rejects into -# one it accepts, which is the one thing this pass must not do. For the same reason the -# single-duration fallback is only taken when the state has a single past() line: two +# one it accepts, which is the one thing this pass must not do. When the two texts +# disagree on how many durations a state has, a duration is only re-pointed when the +# state's delay() calls agree on exactly one AND a single past() line claims it: two # histories rewritten to one duration would leave one silently shadowing the other. -.rxRealignPastTau <- function(txt, orig = NULL) { +.rxRealignPastTau <- function(txt, orig) { .ln <- strsplit(txt, "\n", fixed = TRUE)[[1]] .parts <- lapply(.ln, .rxPastLineParts) .isPast <- which(!vapply(.parts, is.null, logical(1))) @@ -696,7 +695,7 @@ # from it may be there in the model. Leave every line alone, which is what this pass did # before it existed: the validator still says whatever it would have said. if (isTRUE(attr(.opt, "incomplete"))) return(txt) - .org <- if (is.null(orig)) .opt else .rxDelayDurs(orig) + .org <- .rxDelayDurs(orig) if (isTRUE(attr(.org, "incomplete"))) return(txt) .nPast <- table(vapply(.parts[.isPast], function(z) z$state, character(1))) .did <- FALSE @@ -709,14 +708,14 @@ .g <- .org[[.p$state]] .gk <- if (is.null(.g)) character(0) else vapply(.g, .rxTauKey, character(1)) # it did not match a delay() before optimizing either: not ours to rewrite - if (!is.null(orig) && !(.key %in% .gk)) next + if (!(.key %in% .gk)) next .new <- NULL if (length(.g) == length(.o)) { .j <- match(.key, .gk) if (!is.na(.j)) .new <- .o[[.j]] } - # the pre-optimization text could not say which one it was (or was not given): a - # single duration is still unambiguous, as long as a single history claims it + # the pre-optimization text could not say which one it was: a single duration is + # still unambiguous, as long as a single history claims it if (is.null(.new) && length(.o) == 1L && .nPast[[.p$state]] == 1L) .new <- .o[[1L]] if (is.null(.new)) next # keep the caller's spacing: only the duration inside past(...) is rewritten diff --git a/tests/testthat/test-dde-past.R b/tests/testthat/test-dde-past.R index 7962d58b0..e6eb60749 100644 --- a/tests/testthat/test-dde-past.R +++ b/tests/testthat/test-dde-past.R @@ -231,6 +231,21 @@ rxTest({ expect_error(.rxValidatePast(.g), NA) }) + test_that("an operator duration still matches its delay() in a generated model", { + # the emitted duration is deparse1()'d, which spaces an operator out (`a * b`) where + # the augmented d/dt() carries the rxFromSE() form (`a*b`) -- matching a history to + # its delay() normalizes that away, and the solution is the proof + .m <- "a=2\nb=3\nk=0.3\nG(0)=1\nd/dt(G)=-k*delay(G,a*b)\npast(G,a*b)=exp(0.5*t)\n" + .ev <- et(seq(0, 6, by = 0.5)) # tau=6, so the history is used over the whole range + .ref <- rxSolve(rxode2(.m), .ev, method = "dop853", dense = TRUE) + for (.g in list(rxode2(.m, calcJac = TRUE), + suppressMessages(rxode2(.m, calcSens = "k")))) { + expect_error(.rxValidatePast(.g), NA) + expect_equal(rxSolve(.g, .ev, method = "dop853", dense = TRUE)$G, .ref$G, + tolerance = 1e-8) + } + }) + test_that("a THETA[]/ETA[] history resolves, so it can be differentiated", { # an unresolved history is not a Basic, and .rxDelaySensAugment() then silently # emits no per-parameter sensitivity pre-history at all diff --git a/tests/testthat/test-opt-expr.R b/tests/testthat/test-opt-expr.R index 3d8a69f42..dfd9f8415 100644 --- a/tests/testthat/test-opt-expr.R +++ b/tests/testthat/test-opt-expr.R @@ -372,19 +372,21 @@ rxTest({ .pastOf <- function(.x) grep("past\\(", strsplit(.x, "\n")[[1]], value = TRUE) # nothing to do: no past() at all, and a past() already naming its delay's duration .none <- "d/dt(G)=-delay(G,rx_expr_0)\nrx_expr_0~exp(lT)\n" - expect_identical(.r(.none), .none) + expect_identical(.r(.none, "d/dt(G)=-delay(G,exp(lT))\n"), .none) .ok <- "past(G,exp(lT))=2\nd/dt(G)=-delay(G,exp(lT))\n" - expect_identical(.r(.ok), .ok) + expect_identical(.r(.ok, .ok), .ok) # the left-hand side is delimited by the parenthesis matching past(, not by the first # "=", so a duration holding one is still re-pointed .eq <- "past(G, h(x)==1)=2\nd/dt(G)=-delay(G,rx_expr_0)\nrx_expr_0~h(x)==1\n" - expect_identical(.pastOf(.r(.eq)), "past(G,rx_expr_0)=2") + expect_identical(.pastOf(.r(.eq, "past(G, h(x)==1)=2\nd/dt(G)=-delay(G,h(x)==1)\n")), + "past(G,rx_expr_0)=2") # the delay() scan matches parentheses rather than parsing, so a model whose # if/else the R parser would reject is still realigned .ie <- paste(c("if (t>0) {", "v1=1", "}", "else {", "v1=2", "}", "rx_expr_0~exp(lT)", "d/dt(G)=-delay(G, rx_expr_0)", "past(G,exp(lT))=2"), collapse = "\n") - expect_identical(.pastOf(.r(.ie)), "past(G,rx_expr_0)=2") + expect_identical(.pastOf(.r(.ie, "d/dt(G)=-delay(G, exp(lT))\npast(G,exp(lT))=2")), + "past(G,rx_expr_0)=2") # two distinct durations on one state: with the pre-optimization text each past() # line follows the delay() it came from (order of first appearance is preserved) ... .two0 <- paste(c("d/dt(G)=-delay(G, exp(lT))-delay(G, 2*lT)", @@ -394,11 +396,14 @@ rxTest({ "past(G,exp(lT))=2", "past(G,2*lT)=3"), collapse = "\n") expect_identical(.pastOf(.r(.two1, .two0)), c("past(G,rx_expr_0)=2", "past(G,rx_expr_1)=3")) - # ... and without it neither line is guessed at - expect_identical(.r(.two1), .two1) + # ... and when it does not line up with them, neither line is guessed at + expect_identical(.r(.two1, "d/dt(G)=-delay(G, exp(lT))\npast(G,exp(lT))=2\npast(G,2*lT)=3"), + .two1) # when it does rewrite, only the duration changes -- spacing is kept .sp <- " past(G,exp(lT)) = 2\nd/dt(G)=-delay(G,rx_expr_0)\nrx_expr_0~exp(lT)" - expect_identical(strsplit(.r(.sp), "\n")[[1]][1L], " past(G,rx_expr_0) = 2") + expect_identical(strsplit(.r(.sp, " past(G,exp(lT)) = 2\nd/dt(G)=-delay(G,exp(lT))"), + "\n")[[1]][1L], + " past(G,rx_expr_0) = 2") # a duration that matched no delay() BEFORE optimizing is the model's own error and # is left for the validator: re-pointing it would make a rejected duration accepted .bad1 <- "rx_expr_0~exp(lT)\nd/dt(G)=-delay(G,rx_expr_0)\npast(G,typo)=2\n" @@ -413,7 +418,8 @@ rxTest({ expect_identical(.r(.mrg1, .mrg0), .mrg1) # a state may lead with a "." -- d/dt(.y.1) parses, so the scan must take it .dot <- "past(.y.1,exp(lT))=2\nd/dt(.y.1)=-delay(.y.1,rx_expr_0)\nrx_expr_0~exp(lT)\n" - expect_identical(.pastOf(.r(.dot)), "past(.y.1,rx_expr_0)=2") + expect_identical(.pastOf(.r(.dot, "past(.y.1,exp(lT))=2\nd/dt(.y.1)=-delay(.y.1,exp(lT))\n")), + "past(.y.1,rx_expr_0)=2") # the same duration twice is one duration, so the past() line still follows it .dup0 <- "d/dt(G)=-delay(G, exp(lT))-delay(G, exp(lT))\npast(G,exp(lT))=2" .dup1 <- paste(c("rx_expr_0~exp(lT)", "d/dt(G)=-delay(G, rx_expr_0)-delay(G, rx_expr_0)", @@ -427,7 +433,7 @@ rxTest({ .ml0 <- "lT=2.5\nd/dt(G)=-delay(G,\n exp(lT))\npast(G, exp(lT))=10\n" .ml1 <- "rx_expr_0~exp(lT)\nd/dt(G)=-delay(G, rx_expr_0)\npast(G, exp(lT))=10\n" expect_identical(.r(.ml1, .ml0), .ml1) - expect_identical(.r("d/dt(G)=-delay(G,\n rx_expr_0)\npast(G,exp(lT))=2\n"), + expect_identical(.r("d/dt(G)=-delay(G,\n rx_expr_0)\npast(G,exp(lT))=2\n", .ml0), "d/dt(G)=-delay(G,\n rx_expr_0)\npast(G,exp(lT))=2\n") # in particular a duration is never matched by position against a scan that dropped a # call: here the two readable durations of `orig` line up with the two of the optimized @@ -449,7 +455,8 @@ rxTest({ expect_identical(.pastOf(.r(.cm1, .cm0)), "past(G,rx_expr_0)=2") # ... and an unbalanced parenthesis in one does not stop the scan either .cm2 <- "rx_expr_0~exp(lT)\nd/dt(G)=-delay(G,rx_expr_0) # (see above\npast(G,exp(lT))=2" - expect_identical(.pastOf(.r(.cm2)), "past(G,rx_expr_0)=2") + expect_identical(.pastOf(.r(.cm2, "d/dt(G)=-delay(G,exp(lT)) # (see above\npast(G,exp(lT))=2")), + "past(G,rx_expr_0)=2") # a "#" inside a string is not a comment expect_identical(.rxStripComment("printf(\"a#b\") # c"), "printf(\"a#b\") ") expect_identical(.rxStripComment("d/dt(G)=-delay(G,rx_expr_0)"), From e8b6463405181a3161a77e34ad25a51b95bc6955 Mon Sep 17 00:00:00 2001 From: mattfidler Date: Fri, 7 Aug 2026 03:04:09 -0500 Subject: [PATCH 09/10] fix(dde): never guess a past() duration the optimizer dropped, and read code only Sixth review pass, one wrong-solution bug and one wrongly-rejected model. Optimizing can DROP a delay() duration -- 0*delay(G,10) folds to 0 -- and the single-duration fallback then re-pointed past(G,10) at the surviving delay(G,20), so a model that .rxValidatePast() should reject was accepted and solved with one delay() term carrying another's history. A state's durations are now only matched up when the two texts agree on how many it has; nothing else is guessed at, and what does not line up is left for the validator to report. The scan also read inside string literals, so a line as harmless as s="delay(G," marked the model unreadable and stopped the realign for all of it, leaving a model the validator rejects. It now takes the code part of a line: the comment dropped and every string's contents blanked, columns preserved. --- R/rxOptExpr.R | 49 +++++++++++++++++----------------- tests/testthat/test-opt-expr.R | 23 +++++++++++++--- 2 files changed, 45 insertions(+), 27 deletions(-) diff --git a/R/rxOptExpr.R b/R/rxOptExpr.R index ef690f623..b0cb8e4d6 100644 --- a/R/rxOptExpr.R +++ b/R/rxOptExpr.R @@ -578,30 +578,35 @@ if (is.null(.e)) trimws(tau) else deparse1(.e) } -# The code part of a line: everything before the first "#" outside a string. A delay() -# written in a comment is not a delay() call, and the scan below must not read one -- nor -# be stopped by an unbalanced parenthesis in one. -.rxStripComment <- function(line) { - if (!grepl("#", line, fixed = TRUE)) return(line) +# The code part of a line: the comment dropped, and the inside of every string literal +# blanked out. Neither is code, so a delay() written in one is not a delay() call, and the +# scan below must neither read one nor be stopped by an unbalanced parenthesis in one. +# Blanking rather than removing keeps every column where it was, so what the scan does read +# it reads from the right place. +.rxCodeOnly <- function(line) { + if (!grepl("[#\"']", line)) return(line) .ch <- strsplit(line, "", fixed = TRUE)[[1]] .q <- "" .i <- 1L while (.i <= length(.ch)) { .c <- .ch[.i] if (nzchar(.q)) { - if (.c == "\\") { - .i <- .i + 1L # escaped: whatever follows is not a delimiter + .ch[.i] <- " " + if (.c == "\\") { # escaped: whatever follows is not a delimiter + .i <- .i + 1L + if (.i <= length(.ch)) .ch[.i] <- " " } else if (.c == .q) { + .ch[.i] <- .c # keep the quote that closes it .q <- "" } } else if (.c == "\"" || .c == "'") { .q <- .c } else if (.c == "#") { - return(substr(line, 1L, .i - 1L)) + return(paste(.ch[seq_len(.i - 1L)], collapse = "")) } .i <- .i + 1L } - line + paste(.ch, collapse = "") } # Durations of every delay(state, tau) in `txt`, per state, in order of first appearance. @@ -617,7 +622,7 @@ .re <- "(? Date: Fri, 7 Aug 2026 03:13:05 -0500 Subject: [PATCH 10/10] fix(dde): read a duration that holds a string, do not just mask it away Seventh review pass, a regression from the sixth. Masking string literals kept the scan from reading a delay() written inside one, but it also rewrote a duration that legitimately holds a string -- rxode2 takes a string comparison in a model expression, so delay(G, 1+(OCC=="first")) was read as 1+(OCC==" ") and the past() line naming the real duration no longer matched it, leaving a valid model rejected. A call is now LOCATED on the code-only form of a line and READ off the line itself; the top-level comma is found in the code-only form too, so a comma or a parenthesis inside a string no longer splits the call. The two forms agree column for column, which is what .rxCodeOnly() blanking rather than removing is for. --- R/rxOptExpr.R | 31 +++++++++++++++++++++++-------- tests/testthat/test-opt-expr.R | 11 +++++++++++ 2 files changed, 34 insertions(+), 8 deletions(-) diff --git a/R/rxOptExpr.R b/R/rxOptExpr.R index b0cb8e4d6..66db1ba16 100644 --- a/R/rxOptExpr.R +++ b/R/rxOptExpr.R @@ -561,8 +561,11 @@ # Split "state, tau" at its top-level comma. NULL when there is no such comma or the # first argument is not a plain name (`delay(f(x), tau)` is not a state). A state may # lead with "." (`d/dt(.y.1)` parses), so a name is not required to start with a letter. -.rxSplitStateTau <- function(inner) { - .ch <- strsplit(inner, "", fixed = TRUE)[[1]] +# `code` is the code-only form of `inner` (see .rxCodeOnly()); the comma is found in it, +# so a string holding one does not split the arguments, and the text is taken from +# `inner`, which still has the string. The two agree column for column. +.rxSplitStateTau <- function(inner, code = inner) { + .ch <- strsplit(code, "", fixed = TRUE)[[1]] .depth <- cumsum((.ch == "(") - (.ch == ")")) .at <- which(.ch == "," & .depth == 0L)[1L] if (is.na(.at)) return(NULL) @@ -618,12 +621,19 @@ # A call the scan cannot read -- one split over lines, say -- sets the "incomplete" # attribute: the result is then a subset of the model's delay() calls, so neither the # order of what it did read nor the absence of a duration from it says anything. +# +# A call is LOCATED on the code-only form of the line and READ off the line itself: a +# duration may legitimately hold a string (`delay(G, 1+(OCC=="first"))`), and the masking +# that keeps the scan out of a string exists only to say what is code, not to alter it. +# The two agree column for column, which is why .rxCodeOnly() blanks rather than removes. .rxDelayDurs <- function(txt) { .re <- "(?