Skip to content

Commit

Permalink
Add podo0 derivatives and update dsl tests
Browse files Browse the repository at this point in the history
  • Loading branch information
@mattfidler
mattfidler committed Dec 5, 2024
1 parent bb33aba commit 59ad142
Show file tree
Hide file tree
Showing 5 changed files with 91 additions and 64 deletions.
6 changes: 6 additions & 0 deletions R/d.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -546,13 +546,19 @@
.rxD$podo <- list(function(a) {
return("0")
})
.rxD$podo0 <- .rxD$podo
.rxD$dose0 <- .rxD$dose

.rxD$tlast <- list(function(a) {
return("0")
})
.rxD$tfirst <- list(function(a) {
return("0")
})

.rxD$tlast0 <- .rxD$tlast
.rxD$tfirst0 <- .rxD$tfirst

.rxD$first <- list(function(a) {
return("0")
})
Expand Down
102 changes: 52 additions & 50 deletions R/parseFuns.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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,
Expand All @@ -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,
Expand Down
30 changes: 20 additions & 10 deletions R/symengine.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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,
Expand Down Expand Up @@ -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
#'
Expand Down Expand Up @@ -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)
Expand Down Expand Up @@ -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) {
Expand All @@ -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)
}
Expand Down Expand Up @@ -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))
Expand All @@ -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))
Expand Down Expand Up @@ -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) {
Expand Down
1 change: 1 addition & 0 deletions man/reexports.Rd
View file

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

16 changes: 12 additions & 4 deletions tests/testthat/test-dsl.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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))")

})

Expand Down Expand Up @@ -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))")
Expand Down

0 comments on commit 59ad142

Please sign in to comment.