diff --git a/.Rbuildignore b/.Rbuildignore index f21a9db..f3c1aa3 100644 --- a/.Rbuildignore +++ b/.Rbuildignore @@ -9,3 +9,4 @@ ^\.github$ ^rebuild_vignettes.R$ ^vignettes/articles$ +^\.lintr$ \ No newline at end of file diff --git a/.lintr b/.lintr new file mode 100644 index 0000000..d94c31b --- /dev/null +++ b/.lintr @@ -0,0 +1,3 @@ +linters: linters_with_defaults( + indentation_linter = NULL + ) diff --git a/DESCRIPTION b/DESCRIPTION index c631183..e718af9 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: semlbci Title: Likelihood-Based Confidence Interval in Structural Equation Models -Version: 0.10.3.5 +Version: 0.10.4 Authors@R: c( person(given = "Shu Fai", diff --git a/NEWS.md b/NEWS.md index b677651..839e821 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,4 +1,13 @@ -# semlbci 0.10.3.5 +# semlbci 0.10.4 + +## New Feature + +- The print method of the output of + `semlbci()` (`print.semlbci()`) can + print the results in a `lavaan`-like + format. (0.10.4). + +## Miscellaneous - Updated README.md for CRAN release. Identical to the CRAN release in code. (0.10.3.1) @@ -7,6 +16,7 @@ for a coming changes to the parser of `lavaan` (0.10.3.3). - Updated a few tests (0.10.3.4, 0.10.3.5). +- Finalized to 0.10.4. # semlbci 0.10.3 diff --git a/R/print_semlbci.R b/R/print_semlbci.R index 7bbc50c..bd5ce9c 100644 --- a/R/print_semlbci.R +++ b/R/print_semlbci.R @@ -30,6 +30,74 @@ #' @param drop_no_lbci If `TRUE`, parameters without LBCIs will be #' removed. Default is `TRUE`. #' +#' @param output The type of printout. +#' If `"table"`, the default, the +#' results will be printed in a table. +#' If `"text"` or `"lavaan"`, then the +#' results will be printed in the +#' `lavaan` style, as in the [summary()] +#' method for the output of `lavaan`. +#' +#' @param sem_out If `output` is +#' `"text"` or `"lavaan"`, the original +#' output of `lavaan` used in calling +#' [semlbci()] needs to be supplied +#' to this argument. +#' +#' @param lbci_only Used only if `output` +#' is `"text"` or `"lavaan"`. If `TRUE`, +#' only the likelihood-based confidence +#' intervals (LBCIs) will be printed. +#' If `FALSE`, and LBCIs will be +#' printed alongside the confidence +#' intervals by `lavaan`. Its default +#' value depend on the argument +#' `drop_no_lbci`. If `drop_no_lbci` +#' is `TRUE`, then `lbci_only` is +#' `TRUE` by default. If `drop_no_lbci` +#' is `FALSE`, then `lbci_only` is +#' `FALSE` by default. +#' +#' @param ratio_digits The number of +#' digits after the decimal points +#' for the ratios of distance from +#' the confidence limits +#' to the point estimates. Default is +#' 1. +#' +#' @param se Logical. To be passed to +#' [lavaan::parameterEstimates()]. +#' Whether standard error (S.E.) will be +#' printed. Only applicable if `output` +#' is `"text"` or `"lavaan"`. +#' +#' @param zstat Logical. To be passed to +#' [lavaan::parameterEstimates()]. +#' Whether z-values will be printed. +#' Only applicable if `output` is +#' `"text"` or `"lavaan"`. +#' +#' @param pvalue Logical. To be passed +#' to [lavaan::parameterEstimates()]. +#' Whether p-values will be printed. +#' Only applicable if `output` is +#' `"text"` or `"lavaan"`. +#' +#' @param boot.ci.type Logical. To be +#' passed to +#' [lavaan::parameterEstimates()]. The +#' type of bootstrap confidence +#' intervals to be printed if +#' bootstrapping confidence intervals +#' available. Possible values are +#' `"norm"`, `"basic"`, `"perc"`, or +#' `"bca.simple"`. The default value is +#' `"perc"`. Refer to the help of +#' [lavaan::parameterEstimates()] for +#' further information. Only applicable +#' if `output` is `"text"` or +#' `"lavaan"`. +#' #' @param ... Other arguments. They will be ignored. #' #' @author Shu Fai Cheung @@ -62,6 +130,15 @@ #' #' print(lbci_med, digits = 4) #' +#' # Text output +#' +#' print(lbci_med, output = "lavaan", sem_out = fit_med) +#' +#' print(lbci_med, output = "lavaan", sem_out = fit_med, lbci_only = FALSE) +#' +#' print(lbci_med, output = "lavaan", sem_out = fit_med, lbci_only = FALSE, +#' se = FALSE, zstat = FALSE, pvalue = FALSE) +#' #' @export print.semlbci <- function(x, @@ -71,8 +148,45 @@ print.semlbci <- function(x, verbose = FALSE, verbose_if_needed = TRUE, drop_no_lbci = TRUE, + output = c("table", "text", "lavaan"), + sem_out = NULL, + lbci_only = drop_no_lbci, + ratio_digits = 1, + se = TRUE, + zstat = TRUE, + pvalue = TRUE, + boot.ci.type = "perc", ...) { + output <- match.arg(output) + if (isTRUE(output == "lavaan")) output <- "text" if (verbose) verbose_if_needed <- FALSE + if (isTRUE(output == "text")) { + if (is.null(sem_out)) { + stop("Argument 'sem_out' must be supplied ", + "if output type is 'text' or 'lavaan'.") + } + if (!compare_semlbci_sem_out(x, + sem_out = sem_out)) { + stop("The value of 'sem_out' does not appear ", + "to be the fit object used in the call ", + "to 'semlbci()'.") + } + print_semlbci_text(x = x, + nd = digits, + sem_out = sem_out, + lbci_only = lbci_only, + drop_no_lbci = drop_no_lbci, + annotation = annotation, + verbose = verbose, + verbose_if_needed = verbose_if_needed, + ratio_digits = ratio_digits, + se = se, + zstat = zstat, + pvalue = pvalue, + boot.ci.type = boot.ci.type, + ...) + return(invisible(x)) + } out <- x if (max(out$group) == 1) { out$group <- NULL @@ -106,30 +220,35 @@ print.semlbci <- function(x, } if (verbose_if_needed) { - if (is.null(call_org$ci_limit_ratio_tol)) { - ci_limit_ratio_tol <- formals(ci_bound_wn_i)$ci_limit_ratio_tol - } else { - ci_limit_ratio_tol <- call_org$ci_limit_ratio_tol - } - ratio_x <- c(out$ratio_lb, out$ratio_ub) - ratio_note <- any(ratio_x > ci_limit_ratio_tol, na.rm = TRUE) | - any(ratio_x < 1 / ci_limit_ratio_tol, na.rm = TRUE) + verbose_chk <- verbose_needed(out) + ratio_note <- verbose_chk$ratio_note + post_check_note <- verbose_chk$post_check_note + status_note <- verbose_chk$status_note + + # if (is.null(call_org$ci_limit_ratio_tol)) { + # ci_limit_ratio_tol <- formals(ci_bound_wn_i)$ci_limit_ratio_tol + # } else { + # ci_limit_ratio_tol <- call_org$ci_limit_ratio_tol + # } + # ratio_x <- c(out$ratio_lb, out$ratio_ub) + # ratio_note <- any(ratio_x > ci_limit_ratio_tol, na.rm = TRUE) | + # any(ratio_x < 1 / ci_limit_ratio_tol, na.rm = TRUE) if (!ratio_note) { out$ratio_lb <- NULL out$ratio_ub <- NULL } - post_check_note <- !all(out$post_check_lb, - out$post_check_ub, - na.rm = TRUE) + # post_check_note <- !all(out$post_check_lb, + # out$post_check_ub, + # na.rm = TRUE) if (!post_check_note) { out$post_check_lb <- NULL out$post_check_ub <- NULL } - status_note <- !all(out$post_check_lb == 0, - out$post_check_ub == 0, - na.rm = TRUE) + # status_note <- !all(out$status_lb == 0, + # out$status_ub == 0, + # na.rm = TRUE) if (!status_note) { out$status_lb <- NULL out$status_ub <- NULL @@ -243,3 +362,374 @@ print.semlbci <- function(x, } invisible(x) } + +#' @noRd +# A helper for printing in the 'lavaan' way. + +print_semlbci_text <- function(x, + sem_out = sem_out, + nd = 3, + lbci_only = FALSE, + drop_no_lbci = FALSE, + annotation = TRUE, + verbose = FALSE, + verbose_if_needed = TRUE, + ratio_digits = 1, + se = TRUE, + zstat = TRUE, + pvalue = TRUE, + boot.ci.type = "perc", + ...) { + # Adapted from lavaan::print.lavaan.parameterEstimates() + num_format <- paste("%", max(8L, nd + 5L), ".", nd, "f", sep = "") + int_format <- paste("%", max(8L, nd + 5L), "d", sep = "") + char_format <- paste("%", max(8L, nd + 5L), "s", sep = "") + + x_call <- attr(x, "call") + i_no_lbci <- is.na(x$status_lb) & is.na(x$status_ub) + verbose_chk <- verbose_needed(x) + + ciperc <- x_call$ciperc + if (is.null(ciperc)) { + ciperc <- formals(semlbci)$ciperc + } + x_df <- as.data.frame(x) + x_df$block <- x_df$group + x_df$ratio_check_lb <- verbose_chk$ratio_check_lb + x_df$ratio_check_ub <- verbose_chk$ratio_check_ub + if ("est.std" %in% colnames(x)) { + std <- TRUE + } else { + std <- FALSE + } + est0 <- lavaan::parameterEstimates(sem_out, + standardized = FALSE, + level = ciperc, + output = "text", + header = TRUE, + se = se, + zstat = zstat, + pvalue = pvalue, + boot.ci.type = boot.ci.type) + est1 <- est0 + est1$id <- seq_len(nrow(est1)) + if (std) { + # If CIs for standardized solution, + # always print standardized estimates. + std1 <- lavaan::standardizedSolution(sem_out, + type = "std.all", + ci = TRUE, + level = ciperc) + i0 <- colnames(std1) %in% c("lhs", "op", "rhs", + "group", "label", + "est.std", + "se", "z", "pvalue", + "ci.lower", "ci.upper") + est1$est <- NULL + est1$se <- NULL + est1$z <- NULL + est1$pvalue <- NULL + est1$ci.lower <- NULL + est1$ci.upper <- NULL + est1 <- merge(est1, + std1[, i0], + all.x = TRUE) + tmp <- colnames(est1) + tmp <- gsub("est.std", "est", tmp, fixed = TRUE) + colnames(est1) <- tmp + } + i0 <- colnames(x_df) %in% c("lhs", "op", "rhs", + "group", "label", + "lbci_lb", "lbci_ub", + "status_lb", "status_ub", + "ratio_lb", "ratio_ub", + "post_check_lb", "post_check_ub", + "cl_lb", "cl_ub", + "ratio_check_lb", "ratio_check_ub") + est1 <- merge(est1, + x_df[, i0], + all.x = TRUE) + est1 <- est1[order(est1$id), ] + est1$id <- NULL + est1 <- merge_attributes(est1, + est0) + class(est1) <- c("lavaan.parameterEstimates", class(est1)) + i_drop <- is.na(est1$status_lb) & is.na(est1$status_ub) + est1$lbci_lb <- sprintf(num_format, + as.numeric(est1$lbci_lb)) + est1$lbci_lb[i_drop] <- "--" + est1$lbci_ub <- sprintf(num_format, + as.numeric(est1$lbci_ub)) + est1$lbci_ub[i_drop] <- "--" + if (drop_no_lbci) { + est1 <- est1[!i_drop, ] + } + if (verbose_if_needed) { + ratio_note <- verbose_chk$ratio_note + post_check_note <- verbose_chk$post_check_note + status_note <- verbose_chk$status_note + if (!ratio_note) { + est1$ratio_lb <- NULL + est1$ratio_ub <- NULL + est1$ratio_check_lb <- NULL + est1$ratio_check_ub <- NULL + + } + if (!post_check_note) { + est1$post_check_lb <- NULL + est1$post_check_ub <- NULL + } + if (!status_note) { + est1$status_lb <- NULL + est1$status_ub <- NULL + } + } else { + ratio_note <- TRUE + post_check_note <- TRUE + status_note <- TRUE + } + est1$cl_lb <- NULL + est1$cl_ub <- NULL + if (lbci_only) { + est1$ci.lower <- NULL + est1$ci.upper <- NULL + } + ngroups <- lavaan::lavTech(sem_out, "ngroups") + if (ngroups == 1) { + est1$group <- NULL + } + est2 <- est1 + if (status_note) { + est2$status_lb <- format_status(est2$status_lb) + est2$status_ub <- format_status(est2$status_ub) + est2$Status <- paste0(est2$status_lb, + ";", + est2$status_ub) + est2$Status <- sprintf(char_format, est2$Status) + est2$Status[which(est2$lbci_lb == "--")] <- "--" + est2$status_lb <- NULL + est2$status_ub <- NULL + } + if (ratio_note) { + est2$ratio_lb <- format_ratio(est2$ratio_lb, + digits = ratio_digits, + flag = est2$ratio_check_lb, + where = "none") + est2$ratio_ub <- format_ratio(est2$ratio_ub, + digits = ratio_digits, + flag = est2$ratio_check_ub, + where = "none") + est2$Ratio <- paste0(est2$ratio_lb, + ";", + est2$ratio_ub) + est2$Ratio <- sprintf(char_format, est2$Ratio) + est2$Ratio[which(est2$lbci_lb == "--")] <- "--" + est2$ratio_lb <- NULL + est2$ratio_ub <- NULL + est2$ratio_check_lb <- NULL + est2$ratio_check_ub <- NULL + } + if (post_check_note) { + est2$post_check_lb <- format_post_check(est2$post_check_lb) + est2$post_check_ub <- format_post_check(est2$post_check_ub) + est2$Check <- paste0(est2$post_check_lb, + ";", + est2$post_check_ub) + est2$Check <- sprintf(char_format, est2$Check) + est2$Check[which(est2$lbci_lb == "--")] <- "--" + est2$post_check_lb <- NULL + est2$post_check_ub <- NULL + } + tmp <- colnames(est2) + tmp <- gsub("lbci_lb", "lb.lower", tmp, fixed = TRUE) + tmp <- gsub("lbci_ub", "lb.upper", tmp, fixed = TRUE) + colnames(est2) <- tmp + out <- utils::capture.output(print(est2, nd = nd)) + if (annotation) { + # i0 <- grepl(" Standard errors ", out, fixed = TRUE) + # tmp <- out + # tmp[seq_len(which(i0))] <- "%%" + # i1 <- match("", tmp) + tmp0 <- "- lb.lower, lb.upper: " + tmp <- paste0(tmp0, + "The lower and upper likelihood-based ", + "confidence bounds.") + tmp <- strwrap(tmp, + indent = 0, + exdent = nchar(tmp0)) + msg <- tmp + if (status_note) { + tmp0 <- "- Status: " + tmp <- paste0(tmp0, "Whether the search encountered any problem for the two bounds. ", + "If no problem encountered, the code is 0 (displayed as 'OK'). Any value ", + "other than 0 indicates something was wrong in the search.") + tmp <- strwrap(tmp, + indent = 0, + exdent = nchar(tmp0)) + msg <- c(msg, tmp) + } + if (ratio_note) { + tmp0 <- "- Ratio: " + tmp <- paste0(tmp0, + "Ratio of a to b, ", + "a = Distance from the point estimate to a likelihood-based", + " confidence bound, b = Distance from the point estimate to the original", + " confidence bound. A bound should be interpreted with caution if", + " the ratio is too large or too small, indicating a large", + " difference between the original interval and the", + " likelihood-based interval.") + tmp <- strwrap(tmp, + indent = 0, + exdent = nchar(tmp0)) + msg <- c(msg, tmp) + } + if (post_check_note) { + tmp0 <- "- Check: " + tmp <- paste0(tmp0, + "Whether the final solution of ", + "a confidence bound passed the post optimization check of lavaan ", + "by lavaan::lavInspect(fit, 'post.check'), where ", + "fit is the final solution.") + tmp <- strwrap(tmp, + indent = 0, + exdent = nchar(tmp0)) + msg <- c(msg, tmp) + } + msg <- c("Likelihood-Based CI Notes:", "", msg) + # out <- append(out, + # msg, + # after = i1) + out <- c(msg, out) + } + if (!std) { + cat(out, sep = "\n") + return(invisible(x)) + } else { + i <- grepl("Parameter Estimates:", out, fixed = TRUE) + out[i] <- "Standardized Estimates Only" + out <- gsub_heading(old = "\\s\\s\\s\\sEstimate", + new = "Standardized", + object = out) + cat(out, sep = "\n") + return(invisible(x)) + } + } + +#' @noRd + +merge_attributes <- function(target, source) { + tmp1 <- names(attributes(source)) + tmp2 <- names(attributes(target)) + tmp3 <- setdiff(tmp1, tmp2) + if (length(tmp3) > 0) { + for (xx in tmp3) { + attr(target, xx) <- attr(source, xx) + } + } + target + } + +#' @noRd + +gsub_heading <- function(old, + new, + object) { + i1 <- grepl(old, object) + # i2 <- grepl("lbci", object) + # i <- i1 & i2 + i <- i1 + for (xx in which(i)) { + tmp <- object[i] + tmp <- gsub(old, new, tmp) + object[i] <- tmp + } + object + } + +#' @noRd + +verbose_needed <- function(x) { + call_org <- attr(x, "call") + if (is.null(call_org$ci_limit_ratio_tol)) { + ci_limit_ratio_tol <- formals(ci_bound_wn_i)$ci_limit_ratio_tol + } else { + ci_limit_ratio_tol <- call_org$ci_limit_ratio_tol + } + ratio_x <- c(x$ratio_lb, x$ratio_ub) + ratio_check_lb <- (x$ratio_lb > ci_limit_ratio_tol) | + (x$ratio_lb < 1 / ci_limit_ratio_tol) + ratio_check_ub <- (x$ratio_ub > ci_limit_ratio_tol) | + (x$ratio_ub < 1 / ci_limit_ratio_tol) + ratio_note <- any(ratio_x > ci_limit_ratio_tol, na.rm = TRUE) | + any(ratio_x < 1 / ci_limit_ratio_tol, na.rm = TRUE) + + post_check_note <- !all(x$post_check_lb, + x$post_check_ub, + na.rm = TRUE) + + status_note <- !all(x$status_lb == 0, + x$status_ub == 0, + na.rm = TRUE) + + out <- list(ratio_note = ratio_note, + ratio_check_lb = ratio_check_lb, + ratio_check_ub = ratio_check_ub, + post_check_note = post_check_note, + status_note = status_note) + out + } + +#' @noRd + +format_status <- function(object) { + tmp <- character(length(object)) + tmp[which(object == 0)] <- "OK" + i <- object != 0 + tmp[which(i)] <- paste0("<", object[which(i)], ">") + tmp[is.na(object)] <- "" + tmp + } + +#' @noRd + +format_ratio <- function(object, + digits = 1, + flag, + where = c("left", "right", "none")) { + where <- match.arg(where) + tmp <- formatC(as.numeric(object), + digits = digits, + format = "f") + tmp2 <- tmp + if (where == "left") { + tmp2[which(!flag)] <- paste0(" ", tmp[which(!flag)]) + tmp2[which(flag)] <- paste0("<", tmp[which(flag)]) + } else if (where == "right") { + tmp2[which(!flag)] <- paste0(tmp[which(!flag)], " ") + tmp2[which(flag)] <- paste0(tmp[which(flag)], ">") + } + tmp2[is.na(flag)] <- "" + tmp2 + } + +#' @noRd + +format_post_check <- function(object) { + tmp <- character(length(object)) + tmp[which(object)] <- "OK" + tmp[which(!object)] <- "Failed" + tmp[is.na(object)] <- "" + tmp + } + +#' @noRd + +compare_semlbci_sem_out <- function(semlbci_out, + sem_out) { + tmp1 <- lavaan::lav_partable_labels(semlbci_out) + ptable <- lavaan::parameterTable(sem_out) + tmp2 <- lavaan::lav_partable_labels(ptable) + out <- (length(setdiff(tmp1, tmp2)) == 0) && + (length(setdiff(tmp2, tmp1)) == 0) + return(out) + } \ No newline at end of file diff --git a/README.md b/README.md index 91a081e..0ed490a 100644 --- a/README.md +++ b/README.md @@ -9,7 +9,7 @@ [![DOI](https://img.shields.io/badge/doi-10.1080/10705511.2023.2183860-blue.svg)](https://doi.org/10.1080/10705511.2023.2183860) -(Version 0.10.3.5, updated on 2023-10-23, [release history](https://sfcheung.github.io/semlbci/news/index.html)) +(Version 0.10.4, updated on 2023-10-31, [release history](https://sfcheung.github.io/semlbci/news/index.html)) # semlbci diff --git a/_pkgdown.yml b/_pkgdown.yml index f4b5fd9..87e676c 100644 --- a/_pkgdown.yml +++ b/_pkgdown.yml @@ -13,7 +13,7 @@ template: # primary: "#000055" base_font: {google: "Inter"} heading_font: {google: "Inter"} - code_font: {google: "Martian Mono"} + code_font: {google: "Cousine"} includes: in_header: diff --git a/man/print.semlbci.Rd b/man/print.semlbci.Rd index d01277d..0c9f635 100644 --- a/man/print.semlbci.Rd +++ b/man/print.semlbci.Rd @@ -12,6 +12,14 @@ verbose = FALSE, verbose_if_needed = TRUE, drop_no_lbci = TRUE, + output = c("table", "text", "lavaan"), + sem_out = NULL, + lbci_only = drop_no_lbci, + ratio_digits = 1, + se = TRUE, + zstat = TRUE, + pvalue = TRUE, + boot.ci.type = "perc", ... ) } @@ -38,6 +46,74 @@ is \code{TRUE}.} \item{drop_no_lbci}{If \code{TRUE}, parameters without LBCIs will be removed. Default is \code{TRUE}.} +\item{output}{The type of printout. +If \code{"table"}, the default, the +results will be printed in a table. +If \code{"text"} or \code{"lavaan"}, then the +results will be printed in the +\code{lavaan} style, as in the \code{\link[=summary]{summary()}} +method for the output of \code{lavaan}.} + +\item{sem_out}{If \code{output} is +\code{"text"} or \code{"lavaan"}, the original +output of \code{lavaan} used in calling +\code{\link[=semlbci]{semlbci()}} needs to be supplied +to this argument.} + +\item{lbci_only}{Used only if \code{output} +is \code{"text"} or \code{"lavaan"}. If \code{TRUE}, +only the likelihood-based confidence +intervals (LBCIs) will be printed. +If \code{FALSE}, and LBCIs will be +printed alongside the confidence +intervals by \code{lavaan}. Its default +value depend on the argument +\code{drop_no_lbci}. If \code{drop_no_lbci} +is \code{TRUE}, then \code{lbci_only} is +\code{TRUE} by default. If \code{drop_no_lbci} +is \code{FALSE}, then \code{lbci_only} is +\code{FALSE} by default.} + +\item{ratio_digits}{The number of +digits after the decimal points +for the ratios of distance from +the confidence limits +to the point estimates. Default is +1.} + +\item{se}{Logical. To be passed to +\code{\link[lavaan:parameterEstimates]{lavaan::parameterEstimates()}}. +Whether standard error (S.E.) will be +printed. Only applicable if \code{output} +is \code{"text"} or \code{"lavaan"}.} + +\item{zstat}{Logical. To be passed to +\code{\link[lavaan:parameterEstimates]{lavaan::parameterEstimates()}}. +Whether z-values will be printed. +Only applicable if \code{output} is +\code{"text"} or \code{"lavaan"}.} + +\item{pvalue}{Logical. To be passed +to \code{\link[lavaan:parameterEstimates]{lavaan::parameterEstimates()}}. +Whether p-values will be printed. +Only applicable if \code{output} is +\code{"text"} or \code{"lavaan"}.} + +\item{boot.ci.type}{Logical. To be +passed to +\code{\link[lavaan:parameterEstimates]{lavaan::parameterEstimates()}}. The +type of bootstrap confidence +intervals to be printed if +bootstrapping confidence intervals +available. Possible values are +\code{"norm"}, \code{"basic"}, \code{"perc"}, or +\code{"bca.simple"}. The default value is +\code{"perc"}. Refer to the help of +\code{\link[lavaan:parameterEstimates]{lavaan::parameterEstimates()}} for +further information. Only applicable +if \code{output} is \code{"text"} or +\code{"lavaan"}.} + \item{...}{Other arguments. They will be ignored.} } \value{ @@ -76,6 +152,15 @@ print(lbci_med, annotation = FALSE) print(lbci_med, digits = 4) +# Text output + +print(lbci_med, output = "lavaan", sem_out = fit_med) + +print(lbci_med, output = "lavaan", sem_out = fit_med, lbci_only = FALSE) + +print(lbci_med, output = "lavaan", sem_out = fit_med, lbci_only = FALSE, + se = FALSE, zstat = FALSE, pvalue = FALSE) + } \seealso{ \code{\link[=semlbci]{semlbci()}} diff --git a/tests/testthat/test-semlbci_print_text.R b/tests/testthat/test-semlbci_print_text.R new file mode 100644 index 0000000..6747c55 --- /dev/null +++ b/tests/testthat/test-semlbci_print_text.R @@ -0,0 +1,457 @@ +skip_on_cran() + +library(testthat) +library(semlbci) + +# Fit the model + +library(lavaan) + +data(cfa_two_factors_mg) +dat <- cfa_two_factors_mg +mod <- +" +f1 =~ x1 + c(a1, a2)*x2 + c(c1, c2)*x3 +f2 =~ x4 + c(b1, b2)*x5 + c(d1, d2)*x6 +f1 ~ c(fr1, fr2)*f2 +ab := a1 * b2 +c1 == c2 +" +fit <- lavaan::sem(mod, cfa_two_factors_mg, group = "gp") + +mod_nogp <- +" +f1 =~ x1 + a1*x2 + c2*x3 +f2 =~ x4 + b2*x5 + x6 +f1 ~ f2 +ab := a1 * b2 +" +fit_nogp <- lavaan::sem(mod_nogp, cfa_two_factors_mg) + +# Find the LBCIs + +# pars <- c("c2 :=", +# "f1 ~ f2", +# "ab :=") +pars <- c("f1 =~ x3", + "ab :=") +system.time( + lbci_fit <- semlbci(fit, + pars = pars, + method = "wn", + verbose = TRUE, + opts = list(ftol_rel = 1e-5)) + ) + +lbci_fit_warn1 <- lbci_fit +lbci_fit_warn1[3, "ratio_lb"] <- 3 +lbci_fit_warn2 <- lbci_fit +lbci_fit_warn2[26, "post_check_ub"] <- FALSE +lbci_fit_warn3 <- lbci_fit +lbci_fit_warn3[47, "status_ub"] <- 99 + +pars_nogp <- c("f1 =~ x3", + "ab :=") +system.time( + lbci_fit_nogp <- semlbci(fit_nogp, + pars = pars, + method = "wn", + verbose = TRUE, + opts = list(ftol_rel = 1e-5)) + ) + +lbci_fit_nogp_warn1 <- lbci_fit_nogp +lbci_fit_nogp_warn1[3, "ratio_lb"] <- 3 +lbci_fit_nogp_warn2 <- lbci_fit_nogp +lbci_fit_nogp_warn2[16, "post_check_ub"] <- FALSE +lbci_fit_nogp_warn3 <- lbci_fit_nogp +lbci_fit_nogp_warn3[3, "status_ub"] <- 99 + +test_that("print.semlbci, text", { + expect_output(print(lbci_fit, + output = "text", + sem_out = fit), + "lb.lower") + expect_output(print(lbci_fit, + output = "text", + sem_out = fit, + se = FALSE), + "lb.lower") + expect_false(any(grepl("ci.upper", + capture.output(print(lbci_fit, + output = "text", + sem_out = fit, + lbci_only = TRUE))))) + expect_output(print(lbci_fit, + output = "text", + sem_out = fit, + drop_no_lbci = FALSE), + "--") + expect_false(any(grepl("ci.upper", + capture.output(print(lbci_fit, + output = "text", + sem_out = fit, + lbci_only = TRUE, + drop_no_lbci = FALSE))))) + expect_output(print(lbci_fit, + output = "text", + sem_out = fit, + lbci_only = TRUE, + drop_no_lbci = FALSE), + "--") + expect_output(print(lbci_fit_warn1, + output = "text", + sem_out = fit), + "Ratio:") + expect_output(print(lbci_fit_warn2, + output = "text", + sem_out = fit), + "Check:") + expect_output(print(lbci_fit_warn3, + output = "text", + sem_out = fit), + "Status:") + expect_output(print(lbci_fit_warn1, + output = "text", + sem_out = fit, + verbose = TRUE), + "Check:") + expect_output(print(lbci_fit, + output = "text", + sem_out = fit, + verbose = TRUE), + "Check:") + expect_output(print(lbci_fit_warn1, + output = "text", + sem_out = fit, + verbose = TRUE, + drop_no_lbci = FALSE), + "Check:") + expect_output(print(lbci_fit_warn1, + output = "text", + sem_out = fit, + verbose = TRUE, + drop_no_lbci = FALSE), + "--") + expect_false(any(grepl("Likelihood-Based ", + capture.output(print(lbci_fit, + output = "text", + sem_out = fit, + annotation = FALSE))))) + }) + +test_that("print.semlbci, text", { + expect_output(print(lbci_fit_nogp, + output = "text", + sem_out = fit_nogp), + "lb.lower") + expect_false(any(grepl("ci.upper", + capture.output(print(lbci_fit_nogp, + output = "text", + sem_out = fit_nogp, + lbci_only = TRUE))))) + expect_output(print(lbci_fit_nogp, + output = "text", + sem_out = fit_nogp, + drop_no_lbci = FALSE), + "--") + expect_false(any(grepl("ci.upper", + capture.output(print(lbci_fit_nogp, + output = "text", + sem_out = fit_nogp, + lbci_only = TRUE, + drop_no_lbci = FALSE))))) + expect_output(print(lbci_fit_nogp, + output = "text", + sem_out = fit_nogp, + lbci_only = TRUE, + drop_no_lbci = FALSE), + "--") + expect_output(print(lbci_fit_nogp_warn1, + output = "text", + sem_out = fit_nogp), + "Ratio:") + expect_output(print(lbci_fit_nogp_warn2, + output = "text", + sem_out = fit_nogp), + "Check:") + expect_output(print(lbci_fit_nogp_warn3, + output = "text", + sem_out = fit_nogp), + "Status:") + expect_output(print(lbci_fit_nogp_warn1, + output = "text", + sem_out = fit_nogp, + verbose = TRUE), + "Check:") + expect_output(print(lbci_fit_nogp, + output = "text", + sem_out = fit_nogp, + verbose = TRUE), + "Check:") + expect_output(print(lbci_fit_nogp_warn1, + output = "text", + sem_out = fit_nogp, + verbose = TRUE, + drop_no_lbci = FALSE), + "Check:") + expect_output(print(lbci_fit_nogp_warn1, + output = "text", + sem_out = fit_nogp, + verbose = TRUE, + drop_no_lbci = FALSE), + "--") + }) + +# pars <- c("c2 :=", +# "f1 ~ f2", +# "ab :=") +pars <- c("f2 =~ c(1)*x5") +system.time( + lbci_std <- semlbci(fit, + pars = pars, + method = "wn", + verbose = TRUE, + p_tol = 5e-2, + opts = list(ftol_rel = 1e-5, + maxeval = 10), + standardized = TRUE) + ) + +lbci_std_warn1 <- lbci_std +lbci_std_warn1[5, "ratio_lb"] <- 3 +lbci_std_warn2 <- lbci_std +lbci_std_warn2[5, "post_check_ub"] <- FALSE +lbci_std_warn3 <- lbci_std +lbci_std_warn3[5, "status_ub"] <- 99 + +# pars_nogp <- c("f1 =~ x3", +# "f1 ~ f2", +# "ab :=") +pars_nogp <- c("f1 ~ f2") +system.time( + lbci_std_nogp <- semlbci(fit_nogp, + pars = pars, + method = "wn", + verbose = TRUE, + standardized = TRUE, + opts = list(ftol_rel = 1e-6)) + ) + +lbci_std_nogp_warn1 <- lbci_std_nogp +lbci_std_nogp_warn1[5, "ratio_lb"] <- 3 +lbci_std_nogp_warn2 <- lbci_std_nogp +lbci_std_nogp_warn2[5, "post_check_ub"] <- FALSE +lbci_std_nogp_warn3 <- lbci_std_nogp +lbci_std_nogp_warn3[5, "status_ub"] <- 99 + +test_that("print.semlbci, text", { + expect_output(print(lbci_std, + output = "text", + sem_out = fit), + "Standardized") + expect_output(print(lbci_std, + output = "text", + sem_out = fit), + "lb.lower") + expect_false(any(grepl("ci.upper", + capture.output(print(lbci_std, + output = "text", + sem_out = fit, + lbci_only = TRUE))))) + expect_output(print(lbci_std, + output = "text", + sem_out = fit, + drop_no_lbci = FALSE), + "--") + expect_false(any(grepl("ci.upper", + capture.output(print(lbci_std, + output = "text", + sem_out = fit, + lbci_only = TRUE, + drop_no_lbci = FALSE))))) + expect_output(print(lbci_std, + output = "text", + sem_out = fit, + lbci_only = TRUE, + drop_no_lbci = FALSE), + "--") + expect_output(print(lbci_std_warn1, + output = "text", + sem_out = fit), + "Ratio:") + expect_output(print(lbci_std_warn2, + output = "text", + sem_out = fit), + "Check:") + expect_output(print(lbci_std_warn3, + output = "text", + sem_out = fit), + "Status:") + expect_output(print(lbci_std_warn1, + output = "text", + sem_out = fit, + verbose = TRUE), + "Check:") + expect_output(print(lbci_std, + output = "text", + sem_out = fit, + verbose = TRUE), + "Check:") + expect_output(print(lbci_std_warn1, + output = "text", + sem_out = fit, + verbose = TRUE, + drop_no_lbci = FALSE), + "Check:") + expect_output(print(lbci_std_warn1, + output = "text", + sem_out = fit, + verbose = TRUE, + drop_no_lbci = FALSE), + "--") + expect_false(any(grepl("Likelihood-Based ", + capture.output(print(lbci_std, + output = "text", + sem_out = fit, + annotation = FALSE))))) + }) + + +test_that("print.semlbci, text", { + expect_output(print(lbci_std_nogp, + output = "text", + sem_out = fit_nogp), + "Standardized") + expect_output(print(lbci_std_nogp, + output = "text", + sem_out = fit_nogp), + "lb.lower") + expect_false(any(grepl("ci.upper", + capture.output(print(lbci_std_nogp, + output = "text", + sem_out = fit_nogp, + lbci_only = TRUE))))) + expect_output(print(lbci_std_nogp, + output = "text", + sem_out = fit_nogp, + drop_no_lbci = FALSE), + "--") + expect_false(any(grepl("ci.upper", + capture.output(print(lbci_std_nogp, + output = "text", + sem_out = fit_nogp, + lbci_only = TRUE, + drop_no_lbci = FALSE))))) + expect_output(print(lbci_std_nogp, + output = "text", + sem_out = fit_nogp, + lbci_only = TRUE, + drop_no_lbci = FALSE), + "--") + expect_output(print(lbci_std_nogp_warn1, + output = "text", + sem_out = fit_nogp), + "Ratio:") + expect_output(print(lbci_std_nogp_warn2, + output = "text", + sem_out = fit_nogp), + "Check:") + expect_output(print(lbci_std_nogp_warn3, + output = "text", + sem_out = fit_nogp), + "Status:") + expect_output(print(lbci_std_nogp_warn1, + output = "text", + sem_out = fit_nogp, + verbose = TRUE), + "Check:") + expect_output(print(lbci_std_nogp, + output = "text", + sem_out = fit_nogp, + verbose = TRUE), + "Check:") + expect_output(print(lbci_std_nogp_warn1, + output = "text", + sem_out = fit_nogp, + verbose = TRUE, + drop_no_lbci = FALSE), + "Check:") + expect_output(print(lbci_std_nogp_warn1, + output = "text", + sem_out = fit_nogp, + verbose = TRUE, + drop_no_lbci = FALSE), + "--") + }) + +# Test check + +test_that("sem_out", { + expect_true(compare_semlbci_sem_out(lbci_fit, + fit)) + expect_true(compare_semlbci_sem_out(lbci_fit_nogp, + fit_nogp)) + expect_false(compare_semlbci_sem_out(lbci_fit, + fit_nogp)) + expect_false(compare_semlbci_sem_out(lbci_fit_nogp, + fit)) + expect_error(print(lbci_fit, + output = "lavaan", + sem_out = fit_nogp)) + expect_error(print(lbci_fit_nogp, + output = "lavaan", + sem_out = fit)) + }) + +# Robust + +mod_nogp_rb <- +" +f1 =~ x1 + a1*x2 + c2*x3 +f2 =~ x4 + b2*x5 + x6 +f1 ~ f2 +ab := a1 * b2 +" +fit_nogp_rob <- lavaan::sem(mod_nogp, cfa_two_factors_mg, test = "satorra.bentler") + +pars_nogp <- c("f1 =~ x3", + "ab :=") +system.time( + lbci_fit_nogp_rb <- semlbci(fit_nogp_rob, + pars = pars, + method = "wn", + robust = "satorra.2000", + verbose = TRUE, + opts = list(ftol_rel = 1e-5)) + ) + + +test_that("print.semlbci, text, robust", { + expect_output(print(lbci_fit_nogp_rb, + output = "text", + sem_out = fit_nogp_rob), + "lb.lower") + expect_false(any(grepl("ci.upper", + capture.output(print(lbci_fit_nogp_rb, + output = "text", + sem_out = fit_nogp_rob, + lbci_only = TRUE))))) + expect_output(print(lbci_fit_nogp_rb, + output = "text", + sem_out = fit_nogp_rob, + drop_no_lbci = FALSE), + "--") + expect_false(any(grepl("ci.upper", + capture.output(print(lbci_fit_nogp_rb, + output = "text", + sem_out = fit_nogp_rob, + lbci_only = TRUE, + drop_no_lbci = FALSE))))) + expect_output(print(lbci_fit_nogp_rb, + output = "text", + sem_out = fit_nogp_rob, + lbci_only = TRUE, + drop_no_lbci = FALSE), + "--") + }) diff --git a/vignettes/semlbci.Rmd b/vignettes/semlbci.Rmd index 69b66d9..2d39263 100644 --- a/vignettes/semlbci.Rmd +++ b/vignettes/semlbci.Rmd @@ -1,7 +1,7 @@ --- title: "Get Started" author: "Shu Fai Cheung" -date: "2023-05-04" +date: "2023-10-31" output: rmarkdown::html_vignette vignette: > @@ -54,6 +54,8 @@ head(dat) #> 5 -0.9628162 -4.015469 -7.288511 #> 6 -1.0749302 -11.538140 -4.153572 library(lavaan) +#> This is lavaan 0.6-16 +#> lavaan is FREE software! Please report any bugs. mod <- " m ~ a*x @@ -76,7 +78,7 @@ This is the summary: ```r summary(fit, standardized = TRUE) -#> lavaan 0.6.15 ended normally after 1 iteration +#> lavaan 0.6.16 ended normally after 1 iteration #> #> Estimator ML #> Optimization method NLMINB @@ -179,6 +181,56 @@ and the LBCI is to 2.525. +### Customizing the printout + +For users familiar with the column names, +the annotation can be disabled by calling `print()` +and add `annotation = FALSE`: + + +```r +print(out, annotation = FALSE) +#> +#> Results: +#> id lhs op rhs label est lbci_lb lbci_ub lb ub cl_lb cl_ub +#> 1 1 m ~ x a 1.676 0.828 2.525 0.832 2.520 0.950 0.950 +#> 2 2 y ~ m b 0.535 0.391 0.679 0.391 0.679 0.950 0.950 +``` + +The results can also be printed in a `lavaan`-like +format by calling `print()`, setting `sem_out` +to the original fit object (`fit` in this example), +and add `output = "lavaan"`: + + +```r +print(out, + sem_out = fit, + output = "lavaan") +#> Likelihood-Based CI Notes: +#> +#> - lb.lower, lb.upper: The lower and upper likelihood-based confidence +#> bounds. +#> +#> Parameter Estimates: +#> +#> Standard errors Standard +#> Information Expected +#> Information saturated (h1) model Structured +#> +#> Regressions: +#> Estimate Std.Err z-value P(>|z|) lb.lower lb.upper +#> m ~ +#> x (a) 1.676 0.431 3.891 0.000 0.828 2.525 +#> y ~ +#> m (b) 0.535 0.073 7.300 0.000 0.391 0.679 +``` + +By default, the original confidence intervals +will not be printed. See the +help page of `print.semlbci()` for other +options available. + ## Find the LBCI for a User-Defined Parameter To find the LBCI for a user-defined @@ -192,11 +244,23 @@ after `:=` will be ignored by `semlbci()`. ```r out <- semlbci(sem_out = fit, pars = c("ab := ")) -print(out, annotation = FALSE) +print(out, + sem_out = fit, + output = "lavaan") +#> Likelihood-Based CI Notes: #> -#> Results: -#> id lhs op rhs label est lbci_lb lbci_ub lb ub cl_lb cl_ub -#> 6 6 ab := a*b ab 0.897 0.427 1.464 0.385 1.409 0.950 0.950 +#> - lb.lower, lb.upper: The lower and upper likelihood-based confidence +#> bounds. +#> +#> Parameter Estimates: +#> +#> Standard errors Standard +#> Information Expected +#> Information saturated (h1) model Structured +#> +#> Defined Parameters: +#> Estimate Std.Err z-value P(>|z|) lb.lower lb.upper +#> ab 0.897 0.261 3.434 0.001 0.427 1.464 ``` In this example, the point estimate of @@ -226,14 +290,35 @@ out <- semlbci(sem_out = fit, pars = c("y ~ m", "m ~ x"), standardized = TRUE) -print(out, annotation = FALSE) +print(out, + sem_out = fit, + output = "lavaan") +#> Likelihood-Based CI Notes: #> -#> Results: -#> lhs op rhs id label est.std lbci_lb lbci_ub lb ub cl_lb cl_ub -#> 1 m ~ x 1 a 0.265 0.133 0.389 0.136 0.394 0.950 0.950 -#> 2 y ~ m 2 b 0.459 0.342 0.561 0.349 0.568 0.950 0.950 +#> - lb.lower, lb.upper: The lower and upper likelihood-based confidence +#> bounds. +#> +#> Standardized Estimates Only +#> +#> Standard errors Standard +#> Information Expected +#> Information saturated (h1) model Structured +#> +#> Regressions: +#> Standardized Std.Err z-value P(>|z|) lb.lower lb.upper +#> m ~ +#> x (a) 0.265 0.066 4.035 0.000 0.133 0.389 +#> y ~ +#> m (b) 0.459 0.056 8.215 0.000 0.342 0.561 ``` +If LBCIs are for the standardized solution +and `output` set to `"lavaan"` when +printing the results, the parameter +estimates, standard errors, *z*-values, +and *p*-values are those from the +standardized solution. + The LBCIs for standardized user-defined parameters can be requested similarly. @@ -242,11 +327,23 @@ parameters can be requested similarly. out <- semlbci(sem_out = fit, pars = c("ab :="), standardized = TRUE) -print(out, annotation = FALSE) +print(out, + sem_out = fit, + output = "lavaan") +#> Likelihood-Based CI Notes: #> -#> Results: -#> lhs op rhs id label est.std lbci_lb lbci_ub lb ub cl_lb cl_ub -#> 6 ab := a*b 6 ab 0.122 0.059 0.194 0.054 0.189 0.950 0.950 +#> - lb.lower, lb.upper: The lower and upper likelihood-based confidence +#> bounds. +#> +#> Standardized Estimates Only +#> +#> Standard errors Standard +#> Information Expected +#> Information saturated (h1) model Structured +#> +#> Defined Parameters: +#> Standardized Std.Err z-value P(>|z|) lb.lower lb.upper +#> ab 0.122 0.034 3.538 0.000 0.059 0.194 ``` # Basic Arguments in `semlbci()` @@ -418,15 +515,35 @@ visual ability and textual ability: ```r fcov <- semlbci(fit_cfa, pars = c("visual ~~ textual")) -print(fcov, annotation = FALSE) +print(fcov, + sem_out = fit_cfa, + output = "lavaan") +#> Likelihood-Based CI Notes: #> -#> Results: -#> id lhs op rhs group label est lbci_lb lbci_ub lb ub cl_lb -#> 22 22 visual ~~ textual 1 0.416 0.221 0.654 0.225 0.606 0.950 -#> 58 58 visual ~~ textual 2 0.437 0.263 0.663 0.243 0.631 0.950 -#> cl_ub -#> 22 0.950 -#> 58 0.950 +#> - lb.lower, lb.upper: The lower and upper likelihood-based confidence +#> bounds. +#> +#> Parameter Estimates: +#> +#> Standard errors Standard +#> Information Expected +#> Information saturated (h1) model Structured +#> +#> +#> Group 1 [Pasteur]: +#> +#> Covariances: +#> Estimate Std.Err z-value P(>|z|) lb.lower lb.upper +#> visual ~~ +#> textual 0.416 0.097 4.271 0.000 0.221 0.654 +#> +#> +#> Group 2 [Grant-White]: +#> +#> Covariances: +#> Estimate Std.Err z-value P(>|z|) lb.lower lb.upper +#> visual ~~ +#> textual 0.437 0.099 4.423 0.000 0.263 0.663 ``` This is the LBCI for correlation @@ -438,17 +555,41 @@ ability: fcor <- semlbci(fit_cfa, pars = c("visual ~~ textual"), standardized = TRUE) -print(fcor, annotation = FALSE) +print(fcor, + sem_out = fit_cfa, + output = "lavaan") +#> Likelihood-Based CI Notes: #> -#> Results: -#> lhs op rhs group id label est.std lbci_lb lbci_ub lb ub cl_lb -#> 22 visual ~~ textual 1 22 0.485 0.291 0.640 0.315 0.654 0.950 -#> 58 visual ~~ textual 2 58 0.540 0.357 0.692 0.373 0.708 0.950 -#> cl_ub -#> 22 0.950 -#> 58 0.950 +#> - lb.lower, lb.upper: The lower and upper likelihood-based confidence +#> bounds. +#> +#> Standardized Estimates Only +#> +#> Standard errors Standard +#> Information Expected +#> Information saturated (h1) model Structured +#> +#> +#> Group 1 [Pasteur]: +#> +#> Covariances: +#> Standardized Std.Err z-value P(>|z|) lb.lower lb.upper +#> visual ~~ +#> textual 0.485 0.087 5.601 0.000 0.291 0.640 +#> +#> +#> Group 2 [Grant-White]: +#> +#> Covariances: +#> Standardized Std.Err z-value P(>|z|) lb.lower lb.upper +#> visual ~~ +#> textual 0.540 0.086 6.317 0.000 0.357 0.692 ``` +Note that the example above can take more +than one minute to one if parallel +processing is not enabled. + ## Robust LBCI `semlbci()` also supports the robust @@ -471,13 +612,23 @@ fit_robust <- sem(mod, simple_med, fit_lbci_ab_robust <- semlbci(fit_robust, pars = "ab := ", robust = "satorra.2000") -print(fit_lbci_ab_robust, annotation = FALSE) +print(fit_lbci_ab_robust, + sem_out = fit_robust, + output = "lavaan") +#> Likelihood-Based CI Notes: #> -#> Results: -#> id lhs op rhs label est lbci_lb lbci_ub lb ub cl_lb cl_ub -#> 6 6 ab := a*b ab 0.897 0.353 1.571 0.299 1.495 0.950 0.950 -#> robust -#> 6 satorra.2000 +#> - lb.lower, lb.upper: The lower and upper likelihood-based confidence +#> bounds. +#> +#> Parameter Estimates: +#> +#> Standard errors Sandwich +#> Information bread Observed +#> Observed information based on Hessian +#> +#> Defined Parameters: +#> Estimate Std.Err z-value P(>|z|) lb.lower lb.upper +#> ab 0.897 0.305 2.941 0.003 0.353 1.571 ``` ## Latent level parameters diff --git a/vignettes/semlbci.Rmd.original b/vignettes/semlbci.Rmd.original index 87904cf..cdd1304 100644 --- a/vignettes/semlbci.Rmd.original +++ b/vignettes/semlbci.Rmd.original @@ -120,6 +120,32 @@ and the LBCI is to `r formatC(out[out$id == 1, "lbci_ub"], 3, format = "f")`. +### Customizing the printout + +For users familiar with the column names, +the annotation can be disabled by calling `print()` +and add `annotation = FALSE`: + +```{r} +print(out, annotation = FALSE) +``` + +The results can also be printed in a `lavaan`-like +format by calling `print()`, setting `sem_out` +to the original fit object (`fit` in this example), +and add `output = "lavaan"`: + +```{r} +print(out, + sem_out = fit, + output = "lavaan") +``` + +By default, the original confidence intervals +will not be printed. See the +help page of `print.semlbci()` for other +options available. + ## Find the LBCI for a User-Defined Parameter To find the LBCI for a user-defined @@ -132,7 +158,9 @@ after `:=` will be ignored by `semlbci()`. ```{r} out <- semlbci(sem_out = fit, pars = c("ab := ")) -print(out, annotation = FALSE) +print(out, + sem_out = fit, + output = "lavaan") ``` In this example, the point estimate of @@ -161,9 +189,18 @@ out <- semlbci(sem_out = fit, pars = c("y ~ m", "m ~ x"), standardized = TRUE) -print(out, annotation = FALSE) +print(out, + sem_out = fit, + output = "lavaan") ``` +If LBCIs are for the standardized solution +and `output` set to `"lavaan"` when +printing the results, the parameter +estimates, standard errors, *z*-values, +and *p*-values are those from the +standardized solution. + The LBCIs for standardized user-defined parameters can be requested similarly. @@ -171,7 +208,9 @@ parameters can be requested similarly. out <- semlbci(sem_out = fit, pars = c("ab :="), standardized = TRUE) -print(out, annotation = FALSE) +print(out, + sem_out = fit, + output = "lavaan") ``` # Basic Arguments in `semlbci()` @@ -328,7 +367,9 @@ visual ability and textual ability: ```{r} fcov <- semlbci(fit_cfa, pars = c("visual ~~ textual")) -print(fcov, annotation = FALSE) +print(fcov, + sem_out = fit_cfa, + output = "lavaan") ``` This is the LBCI for correlation @@ -339,9 +380,15 @@ ability: fcor <- semlbci(fit_cfa, pars = c("visual ~~ textual"), standardized = TRUE) -print(fcor, annotation = FALSE) +print(fcor, + sem_out = fit_cfa, + output = "lavaan") ``` +Note that the example above can take more +than one minute to one if parallel +processing is not enabled. + ## Robust LBCI `semlbci()` also supports the robust @@ -363,7 +410,9 @@ fit_robust <- sem(mod, simple_med, fit_lbci_ab_robust <- semlbci(fit_robust, pars = "ab := ", robust = "satorra.2000") -print(fit_lbci_ab_robust, annotation = FALSE) +print(fit_lbci_ab_robust, + sem_out = fit_robust, + output = "lavaan") ``` ## Latent level parameters