#if (any(grepl("Limit", title))) {
#  save(resp_vars, outputSlot, current_results, file = "/tmp/con.RData")
#}
if (is.list(resp_vars) && length(resp_vars) == 1 && is.character(resp_vars[[1]])) {
  resp_vars <- resp_vars[[1]]
}
if ((all(!is.na(resp_vars)) && (length(resp_vars) == 1)) || outputSlot == "SummaryPlot") {
  stop("Plot result")
}
if (outputSlot == "SummaryTable") {
  stop("Not a table result")
}
all_res <- lapply(current_results, `[[`, outputSlot)
if (chunk_error) {
  errors <- lapply(current_results, attr, "error")
  invisible(lapply(errors, function(e) {
    if (length(e) == 1) if (inherits(e[[1]], "error")) {
      cond <- simpleError(conditionMessage(e[[1]]), call(iform, variable)); 
      try(stop(cond))
    }
  }))
}
if (chunk_warning) {
  errors <- lapply(current_results, attr, "warning")
  invisible(lapply(errors, function(e) {
    if (length(e) == 1) if (inherits(e[[1]], "warning")) {
      cond <- simpleWarning(conditionMessage(e[[1]]), call(iform, variable)); 
      try(warning(cond))
    }
  }))
}
if (chunk_message) {
  errors <- lapply(current_results, attr, "message")
  invisible(lapply(errors, function(e) {
    if (length(e) == 1) if (inherits(e[[1]], "message")) {
      cond <- simpleMessage(conditionMessage(e[[1]]), call(iform, variable)); 
      try(message(cond))
    }
  }))
}
have_a_result <- any(unlist(lapply(all_res, function(r) variable %in% names(r))))
if (!have_a_result) {
  stop("No results here")
}
cat(sprintf(title, dQuote(dataquieR::prep_title_escape(variable, html = FALSE))))
cat("\n")
# if (variable == "SBP_0" && iform == "acc_univariate_outlier") save(all_res, variable, file = "/tmp/yyy.RData")
invisible(lapply(all_res, function(r) {
  if (!is.null(r[[variable]])) print(r[[variable]])
  }))


Try the dataquieR package in your browser

Any scripts or data that you put into this service are public.

dataquieR documentation built on July 26, 2023, 6:10 p.m.