diff --git a/R/d.R b/R/d.R index 8b62a6d1e..1ce974b25 100644 --- a/R/d.R +++ b/R/d.R @@ -546,6 +546,8 @@ .rxD$podo <- list(function(a) { return("0") }) +.rxD$podo0 <- .rxD$podo +.rxD$dose0 <- .rxD$dose .rxD$tlast <- list(function(a) { return("0") @@ -553,6 +555,10 @@ .rxD$tfirst <- list(function(a) { return("0") }) + +.rxD$tlast0 <- .rxD$tlast +.rxD$tfirst0 <- .rxD$tfirst + .rxD$first <- list(function(a) { return("0") }) diff --git a/R/parseFuns.R b/R/parseFuns.R index aded6523c..b94e31252 100644 --- a/R/parseFuns.R +++ b/R/parseFuns.R @@ -12,34 +12,35 @@ "fprec", "fround", "ftrunc", "transit", "gammaq", "gammapDer", "gammapInv", "gammapInva", "gammaqInv", "gammaqInva", "lowergamma", "uppergamma", "max", "min", "logit", "expit", "probit", "probitInv", -"tlast", "tfirst", "lag", "lead", "dose", "podo", "dabs", "dabs2", -"abs1", "dabs1", "erfinv", "abs0", "dosenum", "first", "last", -"diff", "is.nan", "is.na", "is.finite", "is.infinite", "llikPois", -"llikPoisDlambda", "llikBinom", "llikBinomDprob", "llikNbinom", -"llikNbinomDprob", "llikNbinomMu", "llikNbinomMuDmu", "llikBeta", -"llikBetaDshape1", "llikBetaDshape2", "llikT", "llikTDdf", "llikTDmean", -"llikTDsd", "llikChisq", "llikChisqDdf", "llikExp", "llikExpDrate", -"llikF", "llikFDdf1", "llikFDdf2", "llikGeom", "llikGeomDprob", -"llikUnif", "llikUnifDalpha", "llikUnifDbeta", "llikWeibull", -"llikWeibullDshape", "llikWeibullDscale", "llikGamma", "llikGammaDshape", -"llikGammaDrate", "llikCauchy", "llikCauchyDlocation", "llikCauchyDscale", -"llikNorm", "llikNormDmean", "llikNormDsd", "llikXPois", "llikXPoisDlambda", -"llikXBinom", "llikXBinomDprob", "llikXNbinomMu", "llikXNbinomMuDmu", -"llikXNbinom", "llikXNbinomDprob", "llikXBeta", "llikXBetaDshape1", -"llikXBetaDshape2", "llikXT", "llikXTDdf", "llikXTDmean", "llikXTDsd", -"llikXChisq", "llikXChisqDdf", "llikXExp", "llikXExpDrate", "llikXF", -"llikXFDdf1", "llikXFDdf2", "llikXGeom", "llikXGeomDprob", "llikXUnif", -"llikXUnifDalpha", "llikXUnifDbeta", "llikXWeibull", "llikXWeibullDshape", -"llikXWeibullDscale", "llikXGamma", "llikXGammaDshape", "llikXGammaDrate", -"llikXCauchy", "llikXCauchyDlocation", "llikXCauchyDscale", "llikXNorm", -"llikXNormDmean", "llikXNormDsd", "ReLU", "dReLU", "GELU", "dGELU", -"d2GELU", "d3GELU", "d4GELU", "ELU", "dELU", "d2ELU", "d2aELU", -"dELUa", "d2ELUa", "softplus", "dsoftplus", "d2softplus", "d3softplus", -"d4softplus", "SELU", "dSELU", "lReLU", "dlReLU", "PReLU", "dPReLU", -"d2PReLU", "dPReLUa", "dPReLUa1", "Swish", "dSwish", "linCmt", -"rnorm", "rxnorm", "rxbinom", "rbinom", "rxcauchy", "rcauchy", -"rchisq", "rxchisq", "rexp", "rxexp", "rbeta", "rxbeta", "rgeom", -"rxgeom", "rxpois", "rpois", "rxt", "rt") +"tlast", "tlast0", "tfirst", "tfirst0", "lag", "lead", "dose", +"podo", "dose0", "podo0", "dabs", "dabs2", "abs1", "dabs1", "erfinv", +"abs0", "dosenum", "first", "last", "diff", "is.nan", "is.na", +"is.finite", "is.infinite", "llikPois", "llikPoisDlambda", "llikBinom", +"llikBinomDprob", "llikNbinom", "llikNbinomDprob", "llikNbinomMu", +"llikNbinomMuDmu", "llikBeta", "llikBetaDshape1", "llikBetaDshape2", +"llikT", "llikTDdf", "llikTDmean", "llikTDsd", "llikChisq", "llikChisqDdf", +"llikExp", "llikExpDrate", "llikF", "llikFDdf1", "llikFDdf2", +"llikGeom", "llikGeomDprob", "llikUnif", "llikUnifDalpha", "llikUnifDbeta", +"llikWeibull", "llikWeibullDshape", "llikWeibullDscale", "llikGamma", +"llikGammaDshape", "llikGammaDrate", "llikCauchy", "llikCauchyDlocation", +"llikCauchyDscale", "llikNorm", "llikNormDmean", "llikNormDsd", +"llikXPois", "llikXPoisDlambda", "llikXBinom", "llikXBinomDprob", +"llikXNbinomMu", "llikXNbinomMuDmu", "llikXNbinom", "llikXNbinomDprob", +"llikXBeta", "llikXBetaDshape1", "llikXBetaDshape2", "llikXT", +"llikXTDdf", "llikXTDmean", "llikXTDsd", "llikXChisq", "llikXChisqDdf", +"llikXExp", "llikXExpDrate", "llikXF", "llikXFDdf1", "llikXFDdf2", +"llikXGeom", "llikXGeomDprob", "llikXUnif", "llikXUnifDalpha", +"llikXUnifDbeta", "llikXWeibull", "llikXWeibullDshape", "llikXWeibullDscale", +"llikXGamma", "llikXGammaDshape", "llikXGammaDrate", "llikXCauchy", +"llikXCauchyDlocation", "llikXCauchyDscale", "llikXNorm", "llikXNormDmean", +"llikXNormDsd", "ReLU", "dReLU", "GELU", "dGELU", "d2GELU", "d3GELU", +"d4GELU", "ELU", "dELU", "d2ELU", "d2aELU", "dELUa", "d2ELUa", +"softplus", "dsoftplus", "d2softplus", "d3softplus", "d4softplus", +"SELU", "dSELU", "lReLU", "dlReLU", "PReLU", "dPReLU", "d2PReLU", +"dPReLUa", "dPReLUa1", "Swish", "dSwish", "linCmt", "rnorm", +"rxnorm", "rxbinom", "rbinom", "rxcauchy", "rcauchy", "rchisq", +"rxchisq", "rexp", "rxexp", "rbeta", "rxbeta", "rgeom", "rxgeom", +"rxpois", "rpois", "rxt", "rt") .parseEnv$.parseNum <- c(lgamma = 1, abs = 1, acos = 1, acosh = 1, asin = 1, asinh = 1, atan = 1, atan2 = 2, atanh = 1, beta = 2, cos = 1, cosh = 1, erf = 1, erfc = 1, exp = 1, gamma = 1, linCmtA = 20, linCmtC = 20, @@ -52,28 +53,29 @@ fprec = 2, fround = 2, ftrunc = 2, transit = NA, gammaq = 2, gammapDer = 2, gammapInv = 2, gammapInva = 2, gammaqInv = 2, gammaqInva = 2, lowergamma = 2, uppergamma = 2, max = NA, min = NA, logit = NA, expit = NA, probit = NA, probitInv = NA, tlast = NA, -tfirst = NA, lag = NA, lead = NA, dose = NA, podo = NA, dabs = 1, -dabs2 = 1, abs1 = 1, dabs1 = 1, erfinv = 1, abs0 = 1, dosenum = 0, -first = 1, last = 1, diff = 1, is.nan = 1, is.na = 1, is.finite = 1, -is.infinite = 1, llikPois = 2, llikPoisDlambda = 2, llikBinom = 3, -llikBinomDprob = 3, llikNbinom = 3, llikNbinomDprob = 3, llikNbinomMu = 3, -llikNbinomMuDmu = 3, llikBeta = 3, llikBetaDshape1 = 3, llikBetaDshape2 = 3, -llikT = 4, llikTDdf = 4, llikTDmean = 4, llikTDsd = 4, llikChisq = 2, -llikChisqDdf = 2, llikExp = 2, llikExpDrate = 2, llikF = 3, llikFDdf1 = 3, -llikFDdf2 = 3, llikGeom = 2, llikGeomDprob = 2, llikUnif = 3, -llikUnifDalpha = 3, llikUnifDbeta = 3, llikWeibull = 3, llikWeibullDshape = 3, -llikWeibullDscale = 3, llikGamma = 3, llikGammaDshape = 3, llikGammaDrate = 3, -llikCauchy = 3, llikCauchyDlocation = 3, llikCauchyDscale = 3, -llikNorm = 3, llikNormDmean = 3, llikNormDsd = 3, llikXPois = 3, -llikXPoisDlambda = 3, llikXBinom = 4, llikXBinomDprob = 4, llikXNbinomMu = 4, -llikXNbinomMuDmu = 4, llikXNbinom = 4, llikXNbinomDprob = 4, -llikXBeta = 4, llikXBetaDshape1 = 4, llikXBetaDshape2 = 4, llikXT = 5, -llikXTDdf = 5, llikXTDmean = 5, llikXTDsd = 5, llikXChisq = 3, -llikXChisqDdf = 3, llikXExp = 3, llikXExpDrate = 3, llikXF = 4, -llikXFDdf1 = 4, llikXFDdf2 = 4, llikXGeom = 3, llikXGeomDprob = 3, -llikXUnif = 4, llikXUnifDalpha = 4, llikXUnifDbeta = 4, llikXWeibull = 4, -llikXWeibullDshape = 4, llikXWeibullDscale = 4, llikXGamma = 4, -llikXGammaDshape = 4, llikXGammaDrate = 4, llikXCauchy = 4, llikXCauchyDlocation = 4, +tlast0 = NA, tfirst = NA, tfirst0 = NA, lag = NA, lead = NA, +dose = NA, podo = NA, dose0 = NA, podo0 = NA, dabs = 1, dabs2 = 1, +abs1 = 1, dabs1 = 1, erfinv = 1, abs0 = 1, dosenum = 0, first = 1, +last = 1, diff = 1, is.nan = 1, is.na = 1, is.finite = 1, is.infinite = 1, +llikPois = 2, llikPoisDlambda = 2, llikBinom = 3, llikBinomDprob = 3, +llikNbinom = 3, llikNbinomDprob = 3, llikNbinomMu = 3, llikNbinomMuDmu = 3, +llikBeta = 3, llikBetaDshape1 = 3, llikBetaDshape2 = 3, llikT = 4, +llikTDdf = 4, llikTDmean = 4, llikTDsd = 4, llikChisq = 2, llikChisqDdf = 2, +llikExp = 2, llikExpDrate = 2, llikF = 3, llikFDdf1 = 3, llikFDdf2 = 3, +llikGeom = 2, llikGeomDprob = 2, llikUnif = 3, llikUnifDalpha = 3, +llikUnifDbeta = 3, llikWeibull = 3, llikWeibullDshape = 3, llikWeibullDscale = 3, +llikGamma = 3, llikGammaDshape = 3, llikGammaDrate = 3, llikCauchy = 3, +llikCauchyDlocation = 3, llikCauchyDscale = 3, llikNorm = 3, +llikNormDmean = 3, llikNormDsd = 3, llikXPois = 3, llikXPoisDlambda = 3, +llikXBinom = 4, llikXBinomDprob = 4, llikXNbinomMu = 4, llikXNbinomMuDmu = 4, +llikXNbinom = 4, llikXNbinomDprob = 4, llikXBeta = 4, llikXBetaDshape1 = 4, +llikXBetaDshape2 = 4, llikXT = 5, llikXTDdf = 5, llikXTDmean = 5, +llikXTDsd = 5, llikXChisq = 3, llikXChisqDdf = 3, llikXExp = 3, +llikXExpDrate = 3, llikXF = 4, llikXFDdf1 = 4, llikXFDdf2 = 4, +llikXGeom = 3, llikXGeomDprob = 3, llikXUnif = 4, llikXUnifDalpha = 4, +llikXUnifDbeta = 4, llikXWeibull = 4, llikXWeibullDshape = 4, +llikXWeibullDscale = 4, llikXGamma = 4, llikXGammaDshape = 4, +llikXGammaDrate = 4, llikXCauchy = 4, llikXCauchyDlocation = 4, llikXCauchyDscale = 4, llikXNorm = 4, llikXNormDmean = 4, llikXNormDsd = 4, ReLU = 1, dReLU = 1, GELU = 1, dGELU = 1, d2GELU = 1, d3GELU = 1, d4GELU = 1, ELU = 2, dELU = 2, d2ELU = 2, d2aELU = 2, dELUa = 2, diff --git a/R/symengine.R b/R/symengine.R index 07bf6babc..e8331aec2 100644 --- a/R/symengine.R +++ b/R/symengine.R @@ -142,11 +142,15 @@ regIfOrElse <- rex::rex(or(regIf, regElse)) "probit" = NA, "probitInv" = NA, "tlast" = NA, + "tlast0" = NA, "tfirst" = NA, + "tfirst0" = NA, "lag" = NA, "lead" = NA, "dose" =NA, "podo" =NA, + "dose0" =NA, + "podo0" =NA, "dabs" = 1, "dabs2" = 1, "abs1" = 1, @@ -662,7 +666,7 @@ rxToSE <- function(x, envir = NULL, progress = FALSE, } .rxToSEDualVarFunction <- c("tlast", "tlast0", "tad", "tad0", "tafd", "tafd0", - "dose", "podo") + "dose", "podo", "dose0", "podo0") #' Change rxode2 syntax to symengine syntax for symbols and numbers #' @@ -1090,6 +1094,9 @@ rxToSE <- function(x, envir = NULL, progress = FALSE, if (identical(x[[1]], quote(`podo`))) { return(paste0("podo(", .rxLastAssignedDdt, ")")) } + if (identical(x[[1]], quote(`podo0`))) { + return(paste0("podo0(", .rxLastAssignedDdt, ")")) + } } else if (.len == 2L) { if (length(x[[2]]) != 1) { stop(as.character(x[[1]]), "() must be used with a state", call. = FALSE) @@ -1284,11 +1291,11 @@ rxToSE <- function(x, envir = NULL, progress = FALSE, .bio <- .rxToSE(x[[4]], envir = envir) if (isEnv) envir$..curCall <- .lastCall return(paste0( - "exp(log((", .bio, ")*(podo(", .rxLastAssignedDdt, ")))+log(", + "exp(log((", .bio, ")*(podo0(", .rxLastAssignedDdt, ")))+log(", .n, " + 1)-log(", .mtt, ")+(", .n, ")*((log(", .n, "+1)-log(", .mtt, - "))+log(t-tlast(", .rxLastAssignedDdt, ")))-((", .n, "+1)/(", .mtt, - "))*(t-tlast(", .rxLastAssignedDdt, "))-lgamma(1+", .n, "))" + "))+log(t-tlast0(", .rxLastAssignedDdt, ")))-((", .n, "+1)/(", .mtt, + "))*(t-tlast0(", .rxLastAssignedDdt, "))-lgamma(1+", .n, "))" )) } else if (length(x) == 3) { if (isEnv) { @@ -1298,7 +1305,7 @@ rxToSE <- function(x, envir = NULL, progress = FALSE, .n <- .rxToSE(x[[2]], envir = envir) .mtt <- .rxToSE(x[[3]], envir = envir) if (isEnv) envir$..curCall <- .lastCall - return(paste0("exp(log(podo(", .rxLastAssignedDdt, "))+(log(", .n, "+1)-log(", .mtt, "))+(", .n, ")*((log(", .n, "+1)-log(", .mtt, "))+ log(t-tlast(", .rxLastAssignedDdt, ")))-((", .n, " + 1)/(", .mtt, "))*(t-tlast(",.rxLastAssignedDdt, "))-lgamma(1+", .n, "))")) + return(paste0("exp(log(podo0(", .rxLastAssignedDdt, "))+(log(", .n, "+1)-log(", .mtt, "))+(", .n, ")*((log(", .n, "+1)-log(", .mtt, "))+ log(t-tlast0(", .rxLastAssignedDdt, ")))-((", .n, " + 1)/(", .mtt, "))*(t-tlast0(",.rxLastAssignedDdt, "))-lgamma(1+", .n, "))")) } else { stop("'transit' can only take 2-3 arguments", call. = FALSE) } @@ -1351,7 +1358,7 @@ rxToSE <- function(x, envir = NULL, progress = FALSE, } else if (identical(x[[1]], quote(`tad`))) { return(.rxToSETad(x, envir = envir, progress = progress, isEnv=isEnv)) } else if (identical(x[[1]], quote(`tad0`))) { - return(.rxToSETad(x, envir = envir, progress = progress, isEnv=isEnv)) + return(.rxToSETad0(x, envir = envir, progress = progress, isEnv=isEnv)) } else if (identical(x[[1]], quote(`lag`)) || identical(x[[1]], quote(`lead`))) { return(.rxToSELagOrLead(x, envir = envir, progress = progress, isEnv=isEnv)) @@ -1361,10 +1368,12 @@ rxToSE <- function(x, envir = NULL, progress = FALSE, return(.rxToSETlastOrTafd0(x, envir = envir, progress = progress, isEnv=isEnv)) } else if (identical(x[[1]], quote(`tlast`)) || identical(x[[1]], quote(`tfirst`)) || - identical(x[[1]], quote(`last0`)) || - identical(x[[1]], quote(`first0`)) || + identical(x[[1]], quote(`tlast0`)) || + identical(x[[1]], quote(`tfirst0`)) || identical(x[[1]], quote(`dose`)) || - identical(x[[1]], quote(`podo`))) { + identical(x[[1]], quote(`podo`)) || + identical(x[[1]], quote(`dose0`)) || + identical(x[[1]], quote(`podo0`))) { return(.rxToSETlastOrTfirst(x, envir = envir, progress = progress, isEnv=isEnv)) } else if (identical(x[[1]], quote(`psigamma`))) { return(.rxToSEPsigamma(x, envir = envir, progress = progress, isEnv=isEnv)) @@ -2375,7 +2384,8 @@ rxFromSE <- function(x, unknownDerivatives = c("forward", "central", "error"), ")" ) return(.ret) - } else if (any(paste(.ret0[[1]]) == c("tlast", "tfirst", "dose", "podo"))) { + } else if (any(paste(.ret0[[1]]) == c("tlast", "tfirst", "dose", "podo", + "tlast0", "first0", "dose0", "podo0"))) { if (length(.ret0) == 1L) { return(paste0(.ret0[[1]], "()")) } else if (length(.ret0) == 2L) { diff --git a/man/reexports.Rd b/man/reexports.Rd index 8cba3d62e..2857ff16d 100644 --- a/man/reexports.Rd +++ b/man/reexports.Rd @@ -38,3 +38,4 @@ below to see their documentation. \item{magrittr}{\code{\link[magrittr:pipe]{\%>\%}}} }} +\value{ Inherited from parent routine } diff --git a/tests/testthat/test-dsl.R b/tests/testthat/test-dsl.R index 4ad417168..51bb9c536 100644 --- a/tests/testthat/test-dsl.R +++ b/tests/testthat/test-dsl.R @@ -210,21 +210,22 @@ rxTest({ expect_equal( rxToSE(transit(n, mtt, bio)), - "exp(log((bio)*(podo()))+log(n + 1)-log(mtt)+(n)*((log(n+1)-log(mtt))+log(t-tlast()))-((n+1)/(mtt))*(t-tlast())-lgamma(1+n))") + "exp(log((bio)*(podo0()))+log(n + 1)-log(mtt)+(n)*((log(n+1)-log(mtt))+log(t-tlast0()))-((n+1)/(mtt))*(t-tlast0())-lgamma(1+n))") expect_equal( rxToSE(transit(n, mtt)), - "exp(log(podo())+(log(n+1)-log(mtt))+(n)*((log(n+1)-log(mtt))+ log(t-tlast()))-((n + 1)/(mtt))*(t-tlast())-lgamma(1+n))") + "exp(log(podo0())+(log(n+1)-log(mtt))+(n)*((log(n+1)-log(mtt))+ log(t-tlast0()))-((n + 1)/(mtt))*(t-tlast0())-lgamma(1+n))") tmp <- rxode("d/dt(depot) <- transit(n, mtt, bio)-ka*depot\nd/dt(center)=ka*depot-kel*center") + tmp2 <- rxS(tmp) tmp3 <- tmp2$rx__d_dt_depot__ - expect_equal(rxFromSE(tmp3), "-ka*depot+exp(n*(-log(mtt)+log1p(n)+log(t-tlast(depot)))-(t-tlast(depot))*(1+n)/mtt-log(mtt)+log(bio*podo(depot))+log1p(n)-lgamma1p(n))") + expect_equal(rxFromSE(tmp3), "-ka*depot+exp(n*(-log(mtt)+log1p(n)+log(t-tlast0(depot)))-(1+n)*(t-tlast0(depot))/mtt-log(mtt)+log(bio*podo0(depot))+log1p(n)-lgamma1p(n))") tmp <- rxode("d/dt(depot) <- transit(n, mtt) - ka*depot\nd/dt(center)=ka*depot-kel*center") tmp2 <- rxS(tmp) tmp3 <- tmp2$rx__d_dt_depot__ - expect_equal(rxFromSE(tmp3), "-ka*depot+exp(n*(-log(mtt)+log1p(n)+log(t-tlast(depot)))-(t-tlast(depot))*(1+n)/mtt-log(mtt)+log1p(n)+log(podo(depot))-lgamma1p(n))") + expect_equal(rxFromSE(tmp3), "-ka*depot+exp(n*(-log(mtt)+log1p(n)+log(t-tlast0(depot)))-(1+n)*(t-tlast0(depot))/mtt-log(mtt)+log1p(n)+log(podo0(depot))-lgamma1p(n))") }) @@ -519,6 +520,13 @@ rxTest({ expect_error(rxToSE("tad(matt+f)")) }) + test_that("tad0()", { + expect_equal(rxToSE("tad0()"), "(t-tlast0())") + expect_equal(rxToSE("tad0(matt)"), "(t-tlast0(matt))") + expect_error(rxToSE("tad0(matt,f)")) + expect_error(rxToSE("tad0(matt+f)")) + }) + test_that("tafd()", { expect_equal(rxToSE("tafd()"), "(t-tfirst())") expect_equal(rxToSE("tafd(matt)"), "(t-tfirst(matt))")