File: methods_BayesFM.R

package info (click to toggle)
r-cran-parameters 0.24.2-2
  • links: PTS, VCS
  • area: main
  • in suites: forky, sid, trixie
  • size: 3,852 kB
  • sloc: sh: 16; makefile: 2
file content (141 lines) | stat: -rw-r--r-- 4,667 bytes parent folder | download
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
#' Parameters from Bayesian Exploratory Factor Analysis
#'
#' Format Bayesian Exploratory Factor Analysis objects from the BayesFM package.
#'
#' @param model Bayesian EFA created by the `BayesFM::befa`.
#' @inheritParams principal_components
#' @inheritParams bayestestR::describe_posterior
#' @inheritParams model_parameters.default
#' @param ... Arguments passed to or from other methods.
#'
#' @examples
#' library(parameters)
#' \donttest{
#' if (require("BayesFM")) {
#'   efa <- BayesFM::befa(mtcars, iter = 1000)
#'   results <- model_parameters(efa, sort = TRUE, verbose = FALSE)
#'   results
#'   efa_to_cfa(results, verbose = FALSE)
#' }
#' }
#' @return A data frame of loadings.
#' @export
model_parameters.befa <- function(model,
                                  sort = FALSE,
                                  centrality = "median",
                                  dispersion = FALSE,
                                  ci = 0.95,
                                  ci_method = "eti",
                                  test = NULL,
                                  verbose = TRUE,
                                  ...) {
  if (!attr(model, "post.column.switch") || !attr(model, "post.sign.switch")) {
    insight::check_if_installed("BayesFM")
    if (!attr(model, "post.column.switch")) model <- BayesFM::post.column.switch(model)
    if (!attr(model, "post.sign.switch")) model <- BayesFM::post.sign.switch(model)
  }

  factor_loadings <- as.data.frame(model$alpha)
  names(factor_loadings) <- gsub("alpha:", "", names(factor_loadings), fixed = TRUE)
  factor_loadings <- stats::reshape(
    factor_loadings,
    direction = "long",
    varying = list(names(factor_loadings)),
    sep = "_",
    timevar = "Variable",
    v.names = "Loading",
    idvar = "Draw",
    times = names(factor_loadings)
  )

  components <- as.data.frame(model$dedic)
  names(components) <- gsub("dedic:", "", names(components), fixed = TRUE)
  components <- stats::reshape(
    components,
    direction = "long",
    varying = list(names(components)),
    sep = "_",
    timevar = "Variable",
    v.names = "Component",
    idvar = "Draw",
    times = names(components)
  )

  factor_loadings <- merge(components, factor_loadings)

  # Compute posterior by dedic
  long_loadings <- data.frame()
  for (var in unique(factor_loadings$Variable)) {
    for (comp in unique(factor_loadings$Component)) {
      chunk <- factor_loadings[factor_loadings$Variable == var & factor_loadings$Component == comp, ] # nolint
      if (nrow(chunk) == 0) {
        rez <-
          bayestestR::describe_posterior(
            factor_loadings$Loading,
            centrality = centrality,
            dispersion = dispersion,
            ci = ci,
            ci_method = ci_method,
            test = test,
            verbose = verbose,
            ...
          )
        rez[1, ] <- NA
      } else {
        rez <-
          bayestestR::describe_posterior(
            chunk$Loading,
            centrality = centrality,
            dispersion = dispersion,
            ci = ci,
            ci_method = ci_method,
            test = test,
            verbose = verbose,
            ...
          )
      }
      long_loadings <- rbind(
        long_loadings,
        cbind(data.frame(Component = comp, Variable = var), rez)
      )
    }
  }
  long_loadings$Component <- paste0("F", long_loadings$Component)

  # Clean
  long_loadings$Parameter <- NULL
  if ("CI" %in% names(long_loadings) && insight::n_unique(long_loadings$CI) == 1) {
    long_loadings$CI <- NULL
  }
  long_loadings <- long_loadings[long_loadings$Component != 0, ]

  factor_loadings <- .wide_loadings(
    long_loadings,
    loadings_columns = names(long_loadings)[3],
    component_column = "Component",
    variable_column = "Variable"
  )

  # Add attributes
  attr(factor_loadings, "model") <- model
  attr(factor_loadings, "additional_arguments") <- list(...)
  attr(factor_loadings, "n") <- insight::n_unique(long_loadings$Component)
  attr(factor_loadings, "loadings_columns") <- names(factor_loadings)[2:ncol(factor_loadings)]
  attr(factor_loadings, "ci") <- ci

  # Sorting
  if (isTRUE(sort)) {
    factor_loadings <- .sort_loadings(factor_loadings)
  }


  # Add some more attributes
  long_loadings <- stats::na.omit(long_loadings)
  row.names(long_loadings) <- NULL
  attr(factor_loadings, "loadings_long") <- long_loadings

  # add class-attribute for printing
  class(factor_loadings) <- c("parameters_efa", class(factor_loadings))

  factor_loadings
}