accessor functions

NAMESPACE

@@ -1,9 +1,14 @@
 # Generated by roxygen2: do not edit by hand
 
+S3method(RID,rmedsem)
+S3method(RIT,rmedsem)
+S3method(as.data.frame,rmedsem)
 S3method(print,rmedsem)
 S3method(rmedsem,blavaan)
 S3method(rmedsem,cSEMResults)
 S3method(rmedsem,lavaan)
+export(RID)
+export(RIT)
 export(plot_coef)
 export(plot_effect)
 export(rmedsem)

R/accessors.R

@@ -0,0 +1,58 @@
+#' Return ratio of indirect to total effect (RIT).
+#'
+#' @param res fitted `rmedsem` object
+#'
+#' @export
+RIT <- function (res, ...)
+  UseMethod("RIT")
+
+#' Return ratio of indirect to direct effect (RID).
+#'
+#' @param res fitted `rmedsem` object
+#'
+#' @export
+RID <- function (res, ...)
+  UseMethod("RID")
+
+
+#' Return ratio of indirect to total effect (RIT).
+#'
+#' @param res The `rmedsem` object.
+#' @returns a number
+#' @export
+#'
+RIT.rmedsem <- function(res) {
+  if(with(res$effect.size$RIT, ind_eff>tot_eff)){
+    warning("Indirect effect is larger than total effect! RIT should not be interpreted")
+  }
+   return(res$effect.size$RIT$es)
+}
+
+#' Return ratio of indirect to direct effect (RID).
+#'
+#' @param res The `rmedsem` object.
+#' @returns a number
+#' @export
+#'
+RID.rmedsem <- function(res) {
+  if(res$effect.size$RID$ind_eff>res$effect.size$RIT$tot_eff){
+    warning("Indirect effect is larger than total effect! RID should not be interpreted")
+  }
+  return(res$effect.size$RID$es)
+}
+
+#' Convert `rmedsem` object to data-frame.
+#'
+#' @param res the `rmedsem` object
+#' @return a data.frame
+#' @export
+#'
+as.data.frame.rmedsem <- function(res, ...){
+  df <- purrr::map_dfr(res$est.methods, ~ res[[.x]]) |>
+    dplyr::bind_cols(method=res$est.methods, package=res$package) |>
+    dplyr::relocate(package,method)
+  #if(format=="long"){
+  #  df <- df |> tidyr::gather(variable, value, -package, -method)
+  #}
+  return(df)
+}

R/plotting.R

@@ -12,7 +12,7 @@ plot_effect <- function(res, description=TRUE){
   )
 
   effs |>
-    dplyr::arrange(desc(eff)) |>
+    dplyr::arrange(dplyr::desc(eff)) |>
     dplyr::mutate(ypos = cumsum(value) - 0.5*value ) -> effs
 
   descr.label <- ""

R/rmedsem_blavaan.R

@@ -22,9 +22,10 @@
 #'     dem60 ~ ind60
 #'     dem65 ~ ind60 + dem60
 #' "
-#' mod <- blavaan::bsem(model02, data=lavaan::PoliticalDemocracy, std.lv=T,
-#'             meanstructure=T, n.chains=3,
-#'             save.lvs=T, burnin=1000, sample=1000, bcontrol = list(cores = 3))
+#' library(blavaan)
+#' mod <- bsem(model02, data=lavaan::PoliticalDemocracy, std.lv=TRUE,
+#'             meanstructure=TRUE, n.chains=1,
+#'             save.lvs=TRUE, burnin=500, sample=500)
 #' out <- rmedsem(mod,  indep="ind60", med="dem60", dep="dem65")
 #' print(out)
 #'
@@ -54,13 +55,13 @@ rmedsem.blavaan <- function(mod, indep, med, dep,
   # direct effect samples
   desamp <- draws[,doi]
   RITsamp <- ptsamp/(ptsamp+desamp)
-  RIT <- median(RITsamp)
-  RID <- bayes_coef/mean(desamp)
+  RIT <- stats::median(RITsamp)
+  RID <- bayes_coef/base::mean(desamp)
 
   # direct effect estimates
-  coef_doi <- mean(desamp)
+  coef_doi <- base::mean(desamp)
   se_doi <- stats::sd(desamp)
-  pval_doi <- 1-mean(desamp>0)
+  pval_doi <- 1-base::mean(desamp>0)
   qs_doi <- stats::quantile(desamp, c(0.025, 0.975))
   lci_doi <- qs_doi[1]
   uci_doi <- qs_doi[2]

R/rmedsem_csem.R

@@ -65,6 +65,12 @@ rmedsem.cSEMResults <- function(mod, indep, med, dep,
   sobel_lci <- prodterm - 1.959964*sobel_se
   sobel_uci <- prodterm + 1.959964*sobel_se
 
+  # see https://github.com/FloSchuberth/cSEM/issues/542 for how to get the
+  # covariance matrix of the path estimates for PLS-SEM based on
+  # bootstrapping
+  V <- stats::cov(smod$Estimates$Estimates_resample$Estimates1$Path_estimates$Resampled)
+  corrmoidom = abs(V[moi,dom])
+
   #delta_se <- sqrt( (coef_dom^2)*var_moi + (coef_moi^2)*var_dom + (var_moi*var_dom) )
   delta_se <- sqrt( (coef_dom^2)*var_moi + (coef_moi^2)*var_dom + 2*coef_dom*coef_moi*corrmoidom )
   delta_z  <- prodterm/delta_se

test_rmedsem_example_models/example_models.R

@@ -45,7 +45,20 @@ model03 <- "
    Muscle ~ Appearance + Attractive + age
    Weight ~ Appearance + Attractive + age
 "
+model03.csem <- "
+   Attractive =~ face + sexy
+   Appearance =~ body + appear + attract
+   Muscle =~ muscle + strength + endur
+   Weight =~ lweight + calories + cweight
+   Age =~ age
+   Appearance ~ Attractive + Age
+   Muscle ~ Appearance + Attractive + Age
+   Weight ~ Appearance + Attractive + Age
+"
+
 mod <- sem(model03, data=rmedsem::workout)
+mod2 <- cSEM::csem(model03.csem, .data=na.omit(rmedsem::workout), .disattenuate = T)
+
 out1 <- rmedsem(mod, indep="Attractive", med="Appearance", dep="Muscle",
                standardized=T, mcreps=5000,
                approach = c("bk","zlc"))
@@ -93,3 +106,27 @@ res.lav <- rmedsem(mod.lav, indep="Attractive", med="Appearance", dep="Muscle")
 res.csem <- rmedsem(mod.csem, indep="Attractive", med="Appearance", dep="Muscle")
 res.blav <- rmedsem(mod.blav, indep="Attractive", med="Appearance", dep="Muscle")
 res
+
+
+
+model <- "
+EXPE ~ IMAG
+QUAL ~ EXPE
+VAL ~ EXPE + QUAL
+SAT ~ IMAG + EXPE + QUAL + VAL
+LOY ~ IMAG + SAT
+
+IMAG <~ imag1 + imag2 + imag3
+EXPE <~ expe1 + expe2 + expe3
+QUAL <~ qual1 + qual2 + qual3 + qual4 + qual5
+VAL <~ val1 + val2 + val3
+
+SAT =~ sat1 + sat2 + sat3 + sat4
+LOY =~ loy1 + loy2 + loy3 + loy4
+"
+
+res <- csem(.data = satisfaction, .model = model,.resample_method = 'bootstrap')
+cov(res$Estimates$Estimates_resample$Estimates1$Path_estimates$Resampled)
+
+
+