Merge remote-tracking branch 'origin/main' into test-convertId-issue

nlmixr2 · Dec 5, 2023 · c6e2276 · c6e2276
2 parents 06cc1cf + 78c04c7
commit c6e2276
Show file tree

Hide file tree

Showing 6 changed files with 34 additions and 4 deletions.
diff --git a/data/rxReservedKeywords.rda b/data/rxReservedKeywords.rda
diff --git a/data/rxResidualError.rda b/data/rxResidualError.rda
diff --git a/data/rxSyntaxFunctions.rda b/data/rxSyntaxFunctions.rda
diff --git a/man/rxode2.Rd b/man/rxode2.Rd
diff --git a/src/rxode2_df.cpp b/src/rxode2_df.cpp
@@ -296,6 +296,9 @@ extern "C" SEXP rxode2_df(int doDose0, int doTBS) {
       df[i] = assign_fkeepAttr(j, NumericVector(rx->nr));
     } else if (curType == 1) {
       df[i] = assign_fkeepAttr(j, StringVector(rx->nr));
+      df[i] = StringVector(rx->nr);
+    } else if (curType == 5) {
+      df[i] = assign_fkeepAttr(j, LogicalVector(rx->nr));
     } else {
       IntegerVector cur(rx->nr);
       if (curType == 2) {
@@ -745,6 +748,10 @@ extern "C" SEXP rxode2_df(int doDose0, int doTBS) {
               dfp[ii] = get_fkeep(j, curi + ind->ix[i], ind);
             } else if (TYPEOF(tmp) == STRSXP){
               SET_STRING_ELT(tmp, ii, get_fkeepChar(j, get_fkeep(j, curi + ind->ix[i], ind)));
+            } else if (TYPEOF(tmp) == LGLSXP) {
+              // Everything here is double
+              dfi = LOGICAL(tmp);
+              dfi[ii] = (int) (get_fkeep(j, curi + ind->ix[i], ind));
             } else {
               dfi = INTEGER(tmp);
               /* if (j == 0) RSprintf("j: %d, %d; %f\n", j, i, get_fkeep(j, curi + i)); */

diff --git a/tests/testthat/test-keep.R b/tests/testthat/test-keep.R
@@ -84,7 +84,7 @@ test_that("Make sure the keep gives the right values", {
   expect_equal(PK.ev_ref2$AGE, PK.ev_ref2$AGE2)
 })
 
-test_that("rxSolve 'keep' maintains character output (#190)", {
+test_that("rxSolve 'keep' maintains character output (#190/#622)", {
 
   one.cmt <- function() {
     ini({
@@ -110,14 +110,15 @@ test_that("rxSolve 'keep' maintains character output (#190)", {
   d$oSEX <- d$fSEX
   class(d$oSEX) <- c("ordered", "factor")
   d$iSEX <- as.integer(d$fSEX)
+  d$lSEX <- as.logical(d$iSEX == 1)
   d$dSEX <- d$iSEX + 0.5
   library(units)
   d$uSEX <- set_units(d$dSEX, kg)
   d$eSEX <- lapply(d$SEX, function(e) {
     str2lang(e)
   })
 
-  sim <- rxSolve(one.cmt, events = d, keep = c("SEX", "fSEX", "iSEX", "dSEX", "oSEX", "uSEX"))
+  sim <- rxSolve(one.cmt, events = d, keep = c("SEX", "fSEX", "iSEX", "dSEX", "oSEX", "uSEX", "lSEX"))
 
   expect_type(sim$SEX, "character")
   expect_s3_class(sim$fSEX, "factor")
@@ -126,6 +127,28 @@ test_that("rxSolve 'keep' maintains character output (#190)", {
   expect_type(sim$dSEX, "double")
   expect_true(inherits(sim$oSEX, "ordered"))
   expect_true(inherits(sim$uSEX, "units"))
+  expect_true(is.logical(sim$lSEX))
+
+  d <- nlmixr2data::theo_sd
+  d$SEX <- ifelse(d$ID < 7, "M", "F")
+  d$SEX[4] <- NA_character_
+  d$fSEX <- factor(d$SEX)
+  d$fSEX[4] <- NA_integer_
+  d$iSEX <- as.integer(d$fSEX)
+  d$iSEX[4] <- NA_integer_
+  d$lSEX <- as.logical(d$iSEX == 1)
+  d$lSEX[4] <- NA
+  d$dSEX <- d$iSEX + 0.5
+  d$eSEX <- lapply(d$SEX, function(e) {
+    str2lang(e)
+  })
+
+  sim <- rxSolve(one.cmt, events = d, keep = c("SEX", "fSEX", "iSEX", "dSEX", "lSEX"))
+
+  expect_true(is.na(d$SEX[4]))
+  expect_true(is.na(d$fSEX[4]))
+  expect_true(is.na(d$iSEX[4]))
+  expect_true(is.na(d$lSEX[4]))
 
   expect_error(rxSolve(one.cmt, events = d, keep = c("eSEX")))