Merge pull request #177 from nlmixr2/176-some-nonmem-xml-is-prefixed-…

…by-nm-some-drop-this-prefix-in-tags

176 some nonmem xml is prefixed by nm some drop this prefix in tags

.github/workflows/R-CMD-check.yaml

@@ -50,7 +50,7 @@ jobs:
 
       - uses: r-lib/actions/setup-r-dependencies@v2
         with:
-          cache-version: 4
+          cache-version: 5
           pak-version: devel
           extra-packages: |
             any::rcmdcheck

.github/workflows/pkgdown.yaml

@@ -30,6 +30,7 @@ jobs:
 
       - uses: r-lib/actions/setup-r-dependencies@v2
         with:
+          cache-version: 2
           extra-packages: |
             any::pkgdown
             nlmixr2/lotri

.github/workflows/test-coverage.yaml

@@ -23,7 +23,7 @@ jobs:
 
       - uses: r-lib/actions/setup-r-dependencies@v2
         with:
-          cache-version: 3
+          cache-version: 4
           pak-version: devel
           extra-packages: |
             any::covr

NEWS.md

@@ -1,6 +1,12 @@
 # nonmem2rx 0.1.4
 
-* Omega and Sigma prior estimates are currently ignored
+* When reading NONMEM results from xml will try `nm:` prefixed tags
+  and non-`nm:` prefixed tags.
+
+* Omega and Sigma prior estimates are currently ignored (theta priors
+  were already ignored)
+
+* Improve reading in `theta` values from the `xml`
 
 * Read all NONMEM files using latin1 encoding to allow single byte
   parser to work

R/xml.R

@@ -7,10 +7,14 @@
   .dn
 }
 
-.nmxmlGetCov <- function(xml) {
-  .cov <- xml2::xml_double(xml2::xml_find_all(xml2::xml_find_first(xml,"//nm:covariance"),"nm:row/nm:col"))
+.nmxmlGetCov <- function(xml, prefix="nm:") {
+  .cov <- paste0("//", prefix, "covariance")
+  .rowcol <- paste0(prefix, "row/", prefix, "col")
+  .row <- paste0(prefix, "row")
+  .cov <- xml2::xml_double(xml2::xml_find_all(xml2::xml_find_first(xml,.cov),
+                                              .rowcol))
   if (length(.cov) > 0) {
-    .names <- xml2::xml_attrs(xml2::xml_find_all(xml, "nm:row"))
+    .names <- xml2::xml_attrs(xml2::xml_find_all(xml, .row))
     .inputNames <- setNames(unlist(.names), NULL)
     .finalNames <-  .replaceNmDimNames(.inputNames)
     .cov <- parse(text=paste0("lotri({", paste(.finalNames, collapse = " + "),
@@ -26,7 +30,8 @@
              function(i) {
                lapply(seq(i, length(.finalNames)),
                       function(j) {
-                        .val <- xml2::xml_double(xml2::xml_find_first(xml2::xml_find_first(xml, paste0("//nm:row[@nm:rname='", .inputNames[i], "']")), paste0("//nm:col[@nm:cname='", .inputNames[j], "']")))
+                        .val <- xml2::xml_double(xml2::xml_find_first(xml2::xml_find_first(xml, paste0("//", prefix, "row[@", prefix, "rname='", .inputNames[i], "']")),
+                                                                      paste0("//", prefix, "col[@", prefix, "cname='", .inputNames[j], "']")))
                         .env$matrix[.finalNames[i], .finalNames[j]] <-
                           .env$matrix[.finalNames[j], .finalNames[i]] <- .val
 
@@ -55,32 +60,62 @@
 nmxml <- function(xml) {
   .xml <-try(xml2::read_xml(xml), silent=TRUE)
   if (inherits(.xml, "try-error")) return(NULL)
-  .ctl <- strsplit(xml2::xml_text(xml2::xml_find_first(.xml, "nm:control_stream")), "\n")[[1]]
-  .nmtran <- xml2::xml_text(xml2::xml_find_first(.xml,"nm:nmtran"))
-  .obj <- xml2::xml_double(xml2::xml_find_first(.xml,"//nm:final_objective_function"))
-  .termInfo <- xml2::xml_text(xml2::xml_find_first(.xml, "//nm:termination_information"))
-  .nonmem <- xml2::xml_attr(xml2::xml_find_first(.xml, "nm:nonmem"), "version")
-
-  .time <- sum(c(xml2::xml_double(xml2::xml_find_first(.xml,"//nm:estimation_elapsed_time")),
-    xml2::xml_double(xml2::xml_find_first(.xml,"//nm:covariance_elapsed_time")),
-    xml2::xml_double(xml2::xml_find_first(.xml,"//nm:post_elapsed_time")),
-    xml2::xml_double(xml2::xml_find_first(.xml,"//nm:finaloutput_elapsed_time"))), na.rm=TRUE)
+  .prefix <- "nm:"
+  .ctl <- suppressWarnings(xml2::xml_find_first(.xml, paste0(.prefix, "control_stream")))
+  if (is.na(.ctl)) {
+    .prefix <- ""
+    .ctl <- suppressWarnings(xml2::xml_find_first(.xml, paste0(.prefix, "control_stream")))
+    if (is.na(.ctl)) {
+      warning("could not find nm:control_stream or control_stream in xml",
+              call.=FALSE)
+      return(NULL)
+    }
+  }
+  .ctl <- paste0(.prefix, "control_stream")
+  .ctl <- strsplit(xml2::xml_text(xml2::xml_find_first(.xml, .ctl)), "\n")[[1]]
+  .nmtran <- paste0(.prefix, "nmtran")
+  .nmtran <- xml2::xml_text(xml2::xml_find_first(.xml,.nmtran))
+  .obj <- paste0("//", .prefix, "final_objective_function")
+  .obj <- xml2::xml_double(xml2::xml_find_first(.xml,.obj))
+  .termInfo <- paste0("//", .prefix, "termination_information")
+  .termInfo <- xml2::xml_text(xml2::xml_find_first(.xml, .termInfo))
+  .nonmem <- paste0("//", .prefix, "nonmem")
+  .nonmem <- xml2::xml_attr(xml2::xml_find_first(.xml, .nonmem), "version")
+  .time1 <- paste0("//", .prefix, "estimation_elapsed_time")
+  .time2 <- paste0("//", .prefix, "covariance_elapsed_time")
+  .time3 <- paste0("//", .prefix, "post_elapsed_time")
+  .time4 <- paste0("//", .prefix, "finaloutput_elapsed_time")
+  .time <- sum(c(xml2::xml_double(xml2::xml_find_first(.xml,.time1)),
+    xml2::xml_double(xml2::xml_find_first(.xml,.time2)),
+    xml2::xml_double(xml2::xml_find_first(.xml,.time3)),
+    xml2::xml_double(xml2::xml_find_first(.xml,.time4))), na.rm=TRUE)
 
   # use list parsing for this
   .resetLst(strictLst=FALSE)
-  .lst <- strsplit(xml2::xml_text(xml2::xml_find_first(.xml,"//nm:problem_information")),"\n")[[1]]
+  .lst <- paste0("//", .prefix, "problem_information")
+  .lst <- strsplit(xml2::xml_text(xml2::xml_find_first(.xml,.lst)),"\n")[[1]]
 
   .nmlst$section <- .nmlst.nobs
   lapply(.lst, .nmlst.fun)
 
-  .theta <- xml2::xml_double(xml2::xml_find_all(xml2::xml_find_first(.xml,"//nm:theta"), "nm:val"))
+  .theta <-  paste0("//", .prefix, "theta")
+  .val <- paste0("//", .prefix, "val")
+  .node <- xml2::xml_find_first(.xml,.theta)
+  .children <- xml2::xml_children(.node)
+  .theta <- vapply(seq_along(.children),
+                   function(i) {
+                     xml2::xml_double(.children[i])
+                   }, numeric(1), USE.NAMES = FALSE)
   if (length(.theta) > 0) {
     names(.theta) <- paste0("theta", seq_along(.theta))
   } else {
     .theta <- NULL
   }
 
-  .omega <- xml2::xml_double(xml2::xml_find_all(xml2::xml_find_first(.xml,"//nm:omega"),"nm:row/nm:col"))
+  .omega <- paste0("//", .prefix, "omega")
+  .rowcol <- paste0(.prefix, "row/", .prefix, "col")
+  .omega <- xml2::xml_double(xml2::xml_find_all(xml2::xml_find_first(.xml,.omega),
+                                                .rowcol))
   if (length(.omega) > 0) {
     .maxElt <- sqrt(1 + length(.omega) * 8)/2 - 1/2
     .omega <- eval(parse(text=paste0("lotri::lotri({",
@@ -90,7 +125,8 @@ nmxml <- function(xml) {
     .omgea <- NULL
   }
 
-  .sigma <- xml2::xml_double(xml2::xml_find_all(xml2::xml_find_first(.xml,"//nm:sigma"),"nm:row/nm:col"))
+  .sigma <- paste0("//", .rowcol, "sigma")
+  .sigma <- xml2::xml_double(xml2::xml_find_all(xml2::xml_find_first(.xml, .sigma),.rowcol))
   if (length(.sigma) > 0) {
     .maxElt <- sqrt(1 + length(.sigma) * 8)/2 - 1/2
     .sigma <- eval(parse(text=paste0("lotri::lotri({",
@@ -100,8 +136,9 @@ nmxml <- function(xml) {
     .sigma <- NULL
   }
 
-  .cov <- .nmxmlGetCov(xml2::xml_find_first(.xml,"//nm:covariance"))
-
+  .cov <- paste0("//", .prefix, "covariance")
+  .cov <- .nmxmlGetCov(xml2::xml_find_first(.xml, .cov),
+                       prefix=.prefix)
   list(theta=.theta,
        omega=.omega,
        sigma=.sigma,