Running ‘testthat.R’ [33s/34s]
Running the tests in ‘tests/testthat.R’ failed.
Complete output:
  > library(testthat)
  > library(xpose)
  Loading required package: ggplot2
  
  Attaching package: 'xpose'
  
  The following object is masked from 'package:stats':
  
      filter
  
  > 
  > test_check("xpose")
  ── 1. Error: get_prm works properly (@test-xpdb_access.R#178)  ─────────────────
  replacement has 1 row, data has 0
  1: xpdb_ex_pk %>% filter(.source = "ext", .problem = 1, ITERATION != "-1000000001") %>% 
         get_prm(transform = FALSE, quiet = TRUE) at testthat/test-xpdb_access.R:178
  2: withVisible(eval(quote(`_fseq`(`_lhs`)), env, env))
  3: eval(quote(`_fseq`(`_lhs`)), env, env)
  4: eval(quote(`_fseq`(`_lhs`)), env, env)
  5: `_fseq`(`_lhs`)
  6: freduce(value, `_function_list`)
  7: withVisible(function_list[[k]](value))
  8: function_list[[k]](value)
  9: get_prm(., transform = FALSE, quiet = TRUE)
  10: prm_df %>% dplyr::mutate(prm_names = purrr::map(.x = as.list(.$problem), .f = function(x, 
         code) {
         code <- code[code$problem == x & nchar(code$code) > 0, ]
         list(theta = code$comment[code$subroutine == "the"], omega = code[code$subroutine == 
             "ome", ] %>% dplyr::filter(!(stringr::str_detect(.$code, "BLOCK\\(\\d+\\)(?!.*SAME)") & 
             .$comment == "")) %>% {
             purrr::flatten_chr(.[, "comment"])
         }, sigma = code$comment[code$subroutine == "sig"])
     }, code = xpdb$code)) %>% purrr::transpose() %>% purrr::map(.f = function(data) {
         prm_mean <- grab_iter(ext = data$ext, iter = -1e+09)
         prm_se <- grab_iter(ext = data$ext, iter = -1000000001)
         prm_fix <- grab_iter(ext = data$ext, iter = -1000000006)
         if (all(is.na(prm_fix))) {
             warning("Iteration `-1000000006` not found in the `.ext` file. Assuming no fixed parameters, check the output carefully.", 
                 call. = FALSE)
             prm_fix[is.na(prm_fix)] <- 0
         }
         if (transform) {
             if (!is.null(data$cov)) {
                 prm_cov <- as.data.frame(data$cov) %>% tibble::column_to_rownames("NAME") %>% 
                     as.matrix()
             }
             else {
                 prm_cov <- diag(prm_se)^2
                 attr(prm_cov, "dimnames") <- list(names(prm_se), names(prm_se))
                 if (!all(is.na(prm_se))) {
                     warning("Covariance matrix (`.cov`) not available, RSE for covariance parameters will be incorrect.", 
                       call. = FALSE)
                 }
             }
             prm_trans_formula <- get_prm_transformation_formulas(names(prm_mean))
             prms <- purrr::map_df(prm_trans_formula, ~transform_prm(.x, mu = prm_mean, 
                 sigma = prm_cov, method = "delta")) %>% dplyr::mutate(se = sqrt(.$variance))
         }
         else {
             prms <- dplyr::data_frame(mean = purrr::flatten_dbl(prm_mean), se = purrr::flatten_dbl(prm_se)) %>% 
                 dplyr::mutate(rse = .$se/abs(.$mean))
         }
         prms <- prms %>% dplyr::mutate(fixed = as.logical(as.numeric(prm_fix)), name = names(prm_mean)) %>% 
             dplyr::mutate(type = dplyr::case_when(stringr::str_detect(.$name, "THETA") ~ 
                 "the", stringr::str_detect(.$name, "OMEGA") ~ "ome", stringr::str_detect(.$name, 
                 "SIGMA") ~ "sig"), number = stringr::str_replace_all(.$name, "[^\\d,]+", 
                 ""), se = ifelse(.$fixed, NA_real_, as.numeric(.$se)), rse = ifelse(.$fixed, 
                 NA_real_, abs(as.numeric(.$rse)))) %>% tidyr::separate(col = "number", 
             into = c("m", "n"), sep = ",", fill = "right") %>% dplyr::mutate(diagonal = dplyr::if_else(.$m == 
             .$n, TRUE, FALSE)) %>% dplyr::rename_(.dots = list(value = "mean")) %>% dplyr::mutate(label = "", 
             value = signif(.$value, digits = digits), se = signif(.$se, digits = digits), 
             rse = signif(.$rse, digits = digits), n = as.numeric(.$n), m = as.numeric(.$m), 
             order = dplyr::case_when(type == "the" ~ 1, type == "ome" ~ 2, TRUE ~ 3)) %>% 
             dplyr::arrange_(.dots = "order") %>% dplyr::select(dplyr::one_of("type", 
             "name", "label", "value", "se", "rse", "fixed", "diagonal", "m", "n"))
         n_theta <- sum(prms$type == "the")
         theta_names <- data$prm_names$theta
         if (n_theta != length(theta_names)) {
             warning("[$prob no.", data$problem, ", subprob no.", data$subprob, ", ", 
                 data$method, "] $THETA labels did not match the number of THETAs in the `.ext` file.", 
                 call. = FALSE)
         }
         else {
             prms$label[prms$type == "the"] <- theta_names
         }
         n_omega <- sum(prms$type == "ome" & prms$diagonal, na.rm = TRUE)
         omega_names <- data$prm_names$omega
         if (n_omega != length(omega_names)) {
             warning("[$prob no.", data$problem, ", subprob no.", data$subprob, ", ", 
                 data$method, "] $OMEGA labels did not match the number of OMEGAs in the `.ext` file.", 
                 call. = FALSE)
         }
         else {
             prms$label[prms$type == "ome" & prms$diagonal] <- omega_names
         }
         n_sigma <- sum(prms$type == "sig" & prms$diagonal, na.rm = TRUE)
         sigma_names <- data$prm_names$sigma
         if (n_sigma != length(sigma_names)) {
             warning("[$prob no.", data$problem, ", subprob no.", data$subprob, ", ", 
                 data$method, "] $SIGMA labels did not match the number of SIGMAs in the `.ext` file.", 
                 call. = FALSE)
         }
         else {
             prms$label[prms$type == "sig" & prms$diagonal] <- sigma_names
         }
         if (!show_all) {
             prms <- dplyr::filter(.data = prms, !(prms$type %in% c("ome", "sig") & prms$value == 
                 0 & !prms$diagonal))
         }
         structure(.Data = prms, file = "ext", problem = data$problem, subprob = data$subprob, 
             method = data$method)
     })
  ...
  17: function_list[[k]](value)
  18: purrr::map(., .f = function(data) {
         prm_mean <- grab_iter(ext = data$ext, iter = -1e+09)
         prm_se <- grab_iter(ext = data$ext, iter = -1000000001)
         prm_fix <- grab_iter(ext = data$ext, iter = -1000000006)
         if (all(is.na(prm_fix))) {
             warning("Iteration `-1000000006` not found in the `.ext` file. Assuming no fixed parameters, check the output carefully.", 
                 call. = FALSE)
             prm_fix[is.na(prm_fix)] <- 0
         }
         if (transform) {
             if (!is.null(data$cov)) {
                 prm_cov <- as.data.frame(data$cov) %>% tibble::column_to_rownames("NAME") %>% 
                     as.matrix()
             }
             else {
                 prm_cov <- diag(prm_se)^2
                 attr(prm_cov, "dimnames") <- list(names(prm_se), names(prm_se))
                 if (!all(is.na(prm_se))) {
                     warning("Covariance matrix (`.cov`) not available, RSE for covariance parameters will be incorrect.", 
                       call. = FALSE)
                 }
             }
             prm_trans_formula <- get_prm_transformation_formulas(names(prm_mean))
             prms <- purrr::map_df(prm_trans_formula, ~transform_prm(.x, mu = prm_mean, 
                 sigma = prm_cov, method = "delta")) %>% dplyr::mutate(se = sqrt(.$variance))
         }
         else {
             prms <- dplyr::data_frame(mean = purrr::flatten_dbl(prm_mean), se = purrr::flatten_dbl(prm_se)) %>% 
                 dplyr::mutate(rse = .$se/abs(.$mean))
         }
         prms <- prms %>% dplyr::mutate(fixed = as.logical(as.numeric(prm_fix)), name = names(prm_mean)) %>% 
             dplyr::mutate(type = dplyr::case_when(stringr::str_detect(.$name, "THETA") ~ 
                 "the", stringr::str_detect(.$name, "OMEGA") ~ "ome", stringr::str_detect(.$name, 
                 "SIGMA") ~ "sig"), number = stringr::str_replace_all(.$name, "[^\\d,]+", 
                 ""), se = ifelse(.$fixed, NA_real_, as.numeric(.$se)), rse = ifelse(.$fixed, 
                 NA_real_, abs(as.numeric(.$rse)))) %>% tidyr::separate(col = "number", 
             into = c("m", "n"), sep = ",", fill = "right") %>% dplyr::mutate(diagonal = dplyr::if_else(.$m == 
             .$n, TRUE, FALSE)) %>% dplyr::rename_(.dots = list(value = "mean")) %>% dplyr::mutate(label = "", 
             value = signif(.$value, digits = digits), se = signif(.$se, digits = digits), 
             rse = signif(.$rse, digits = digits), n = as.numeric(.$n), m = as.numeric(.$m), 
             order = dplyr::case_when(type == "the" ~ 1, type == "ome" ~ 2, TRUE ~ 3)) %>% 
             dplyr::arrange_(.dots = "order") %>% dplyr::select(dplyr::one_of("type", 
             "name", "label", "value", "se", "rse", "fixed", "diagonal", "m", "n"))
         n_theta <- sum(prms$type == "the")
         theta_names <- data$prm_names$theta
         if (n_theta != length(theta_names)) {
             warning("[$prob no.", data$problem, ", subprob no.", data$subprob, ", ", 
                 data$method, "] $THETA labels did not match the number of THETAs in the `.ext` file.", 
                 call. = FALSE)
         }
         else {
             prms$label[prms$type == "the"] <- theta_names
         }
         n_omega <- sum(prms$type == "ome" & prms$diagonal, na.rm = TRUE)
         omega_names <- data$prm_names$omega
         if (n_omega != length(omega_names)) {
             warning("[$prob no.", data$problem, ", subprob no.", data$subprob, ", ", 
                 data$method, "] $OMEGA labels did not match the number of OMEGAs in the `.ext` file.", 
                 call. = FALSE)
         }
         else {
             prms$label[prms$type == "ome" & prms$diagonal] <- omega_names
         }
         n_sigma <- sum(prms$type == "sig" & prms$diagonal, na.rm = TRUE)
         sigma_names <- data$prm_names$sigma
         if (n_sigma != length(sigma_names)) {
             warning("[$prob no.", data$problem, ", subprob no.", data$subprob, ", ", 
                 data$method, "] $SIGMA labels did not match the number of SIGMAs in the `.ext` file.", 
                 call. = FALSE)
         }
         else {
             prms$label[prms$type == "sig" & prms$diagonal] <- sigma_names
         }
         if (!show_all) {
             prms <- dplyr::filter(.data = prms, !(prms$type %in% c("ome", "sig") & prms$value == 
                 0 & !prms$diagonal))
         }
         structure(.Data = prms, file = "ext", problem = data$problem, subprob = data$subprob, 
             method = data$method)
     })
  19: .f(.x[[i]], ...)
  20: grab_iter(ext = data$ext, iter = -1000000001)
  21: `[<-`(`*tmp*`, 1, , value = NA_real_)
  22: `[<-.data.frame`(`*tmp*`, 1, , value = NA_real_)
  23: xpdrows.data.frame(x, rows, new.rows)
  24: `[[<-`(`*tmp*`, i, value = NA_real_)
  25: `[[<-.data.frame`(`*tmp*`, i, value = NA_real_)
  26: stop(sprintf(ngettext(N, "replacement has %d row, data has %d", "replacement has %d rows, data has %d"), 
         N, nrows), domain = NA)
  
  ══ testthat results  ═══════════════════════════════════════════════════════════
  OK: 520 SKIPPED: 6 FAILED: 1
  1. Error: get_prm works properly (@test-xpdb_access.R#178) 
  
  Error: testthat unit tests failed
  Execution halted