Post-processing steps

DESCRIPTION

@@ -23,10 +23,10 @@ Description: Provides a common set of functions used in the exploratory
 URL: https://tmsalab.github.io/edmcore, https://github.com/tmsalab/edmcore
 BugReports: https://github.com/tmsalab/edmcore/issues
 License: GPL (>= 2)
-Depends: R (>= 3.5.0)
+Depends: R (>= 3.6.0)
 LinkingTo: Rcpp, RcppArmadillo
 Imports: 
-    Rcpp,
+    Rcpp (>= 1.0.7),
     gtools,
     ggplot2
 Suggests: 

NAMESPACE

@@ -41,6 +41,7 @@ export(new_edm_summary)
 export(permutate_attribute_level_table)
 export(permutate_binary_matrix)
 export(permutate_theta_order)
+export(postprocess_attribute_correlation)
 export(q_matrix)
 export(read_item_matrix)
 export(read_q_matrix)

R/edm-model.R

@@ -26,7 +26,9 @@ new_edm_default_property_list = function(n, j, k, runtime, ..., class = characte
 #' Display Exploratory Diagnostic Model Properties
 #'
 #' Custom print method for viewing Exploratory Diagnostic Model properties.
-#' @inherit base::print
+#'
+#' @param x	  an edm modeling object
+#' @param ...	additional arguments passed to or from other methods.
 #' @export
 print.edm_property_list = function(x, ...) {
   # Display call
@@ -83,7 +85,9 @@ new_edm_model = function(chain, property_list, estimate = NA, ..., class = chara
 #' Print Exploratory Diagnostic Model Components
 #'
 #' Custom print method for viewing Exploratory Diagnostic Model components.
-#' @inherit base::print
+#'
+#' @param x	  an edm modeling object
+#' @param ...	additional arguments passed to or from other methods.
 #' @export
 print.edm_model = function(x, ...) {
   print(x$property_list)

R/postprocess.R

@@ -0,0 +1,59 @@
+
+# Latent Class Membership ----
+
+#' Correlation Among Attribute Membership
+#'
+#' Given the estimated latent class membership probabilities, we compute the
+#' correlation across classes.
+#'
+#' @param pi_hat Estimated latent class membership probabilities
+#' @param k      Number of attributes
+#' @param order  Number of interactions in the model
+#'
+#' @return
+#' A `matrix` containing the correlations. Note, as it is a correlation matrix,
+#' the diagonal will be equivalent to 1.
+#'
+#' @export
+#' @examples
+#'
+#' # Sample calculation when K = 3 and number of classses is 2^3 = 8
+#' pi_hat = c(0.10, 0.10, 0.01, 0.13, 0.03, 0.26, 0.05, 0.31)
+#' k = 3
+#'
+#' # Compute attribute correlation matrix
+#' postprocess_attribute_correlation(pi_hat, k)
+postprocess_attribute_correlation = function(pi_hat, k, order = k) {
+
+  # Obtain the attribute profiles that follow the bijection
+  alpha_profiles =
+    t(GenerateAtable(
+      nClass = 2 ^ k,
+      k,
+      M = 2,
+      order = order
+    )$DtoQtable)
+
+  # Obtain the expected value (mean) and standard deviation
+  # using formulas for the binomial distribution
+  E_alpha = pi_hat %*% alpha_profiles      # p * n
+  sd_alpha = sqrt(E_alpha * (1 - E_alpha)) # p * n * q
+
+  # Construct a correlation matrix
+  cor_alpha = matrix(0, k, k)
+
+  # Compute under the assumption of an upper triangular matrix
+  for (k_1 in seq_len(k - 1)) {
+    for (k_2 in (k_1 + 1):k) {
+      cov_tmp =
+        pi_hat %*% (alpha_profiles[, k_1] * alpha_profiles[, k_2]) - E_alpha[k_1] * E_alpha[k_2]
+      cor_alpha[k_1, k_2] =
+        cov_tmp / (sd_alpha[k_1] * sd_alpha[k_2])
+    }
+  }
+  # Modify to incorporate
+  cor_alpha = cor_alpha + t(cor_alpha) + diag(k)
+
+  # Return correlation matrix
+  cor_alpha
+}

src/RcppExports.cpp

@@ -7,6 +7,11 @@
 
 using namespace Rcpp;
 
+#ifdef RCPP_USE_GLOBAL_ROSTREAM
+Rcpp::Rostream<true>&  Rcpp::Rcout = Rcpp::Rcpp_cout_get();
+Rcpp::Rostream<false>& Rcpp::Rcerr = Rcpp::Rcpp_cerr_get();
+#endif
+
 // attribute_bijection
 arma::uvec attribute_bijection(unsigned int K);
 RcppExport SEXP _edmcore_attribute_bijection(SEXP KSEXP) {