In trbrick/MICr: Matrices of Implied Causation in R

This document generates the example MICs from Tomarken & Waller (2003).

knitr::opts_chunk$set(
  collapse = TRUE,
  comment = "#>"
)

library(OpenMx)
library(MICr)
library(knitr)
drawPlots <- FALSE
if(drawPlots & interactive()) {
  drawPlots <- require(umx)  # Plot only if UMX is available
}

For these, I moused the models together in Onyx (http://onyx.brandmaier.de/), and exported the scripts across to here with minimal changes to make the style work. Apologies to readers that the style is imperfect.

Note also that this description differs slightly from the results posted in Brick & Bailey (submitted). This is because the models here resemble the Tomarken examples exactly, whereas Brick & Bailey collapse the residual factors Rx, Ry, and Rz into X, Y, and Z respectively.

The transformation is straightforward: instead of a latent factor with loading 1 and variance 1, we simply add a variance arrow directly on the manifest variable. This results in identical model predictions each time. The only resulting difference is that Ry (the only residual factor is included in all models) carries the same causal force as Y in the current vignette.

Example 1A:

tomarken1A <- mxModel("Tomarken1A", 
  type="RAM", manifestVars = c("X", "Y", "Z"), latentVars = c("Ry", "Rz"),
    mxPath(from="Ry", to="Y",  free=c(FALSE), value=1.0, arrows=1, label=c("Ry_TO_Y") ),
    mxPath(from="Rz", to="Z",  free=c(FALSE), value=1.0, arrows=1, label=c("Rz_TO_Z") ),
    mxPath(from="X",  to="Y",  free=c(TRUE),  value=0.8, arrows=1, label=c("_alpha") ),
    mxPath(from="Y",  to="Z",  free=c(TRUE),  value=0.8, arrows=1, label=c("_beta") ),
    mxPath(from="Ry", to="Ry", free=c(TRUE),  value=1.0, arrows=2, label=c("_V__Ry_") ),
    mxPath(from="Rz", to="Rz", free=c(TRUE),  value=1.0, arrows=2, label=c("_V__Rz_") ),
    mxPath(from="X",  to="X",  free=c(TRUE),  value=1.0, arrows=2, label=c("_V_X") )
)
if(drawPlots) {
  umx_set_plot_format("DiagrammeR")
  plot(tomarken1A, pathLabels="both")
}
kable(MIC(tomarken1A), caption="Tomarken Model 1A")

Example 1B

tomarken1B <- mxModel("Tomarken1B", 
  type="RAM", manifestVars = c("X","Y","Z"), latentVars = c("Rx", "Ry"),
  mxPath(from="Y",  to=c("X"),  free=TRUE,  value=.8, arrows=1, label="__alpha_2"),
  mxPath(from="Z",  to=c("Y"),  free=TRUE,  value=.8, arrows=1, label="__beta_2"),
  mxPath(from="Rx", to=c("X"),  free=FALSE, value=1.0,  arrows=1, label="Rx_TO_X"),
  mxPath(from="Ry", to=c("Y"),  free=FALSE, value=1.0,  arrows=1, label="Ry_TO_Y"),
  mxPath(from="Z",  to=c("Z"),  free=TRUE,  value=1.0, arrows=2, label="_V_Z"),
  mxPath(from="Rx", to=c("Rx"), free=TRUE,  value=1.0, arrows=2, label="_V__Rx_"),
  mxPath(from="Ry", to=c("Ry"), free=TRUE,  value=1.0, arrows=2, label="_V__Ry_")
)
if(drawPlots) {
  umx_set_plot_format("DiagrammeR")
  plot(tomarken1B, pathLabels="both")
}
kable(MIC(tomarken1B), caption="Tomarken Model 1B")

Example 1C

tomarken1C <- mxModel("Tomarken1C", 
    type="RAM", manifestVars = c("X","Y","Z"), latentVars = c("Rz","Ry"),
    mxPath(from="X",to=c("Z","Y"), free=c(TRUE,TRUE), value=c(.8,.8) , arrows=1,     label=c("beta_3","alpha_3") ),
    mxPath(from="Rz", to="Z",   free=TRUE, value=1.0,  arrows=1, label="Rz_TO_Z" ),
    mxPath(from="Ry", to="Y",   free=TRUE, value=1.0,  arrows=1, label="Ry_TO_Y" ),
    mxPath(from="X",  to="X",   free=TRUE, value=1.0, arrows=2, label="V_X" ),
    mxPath(from="Rz", to="Rz",  free=TRUE, value=1.0, arrows=2, label="V__Rz_" ),
    mxPath(from="Ry", to="Ry",  free=TRUE, value=1.0, arrows=2, label="V__Ry_" )
)
if(drawPlots) {
  umx_set_plot_format("DiagrammeR")
  plot(tomarken1C, pathLabels="both")
}
kable(MIC(tomarken1C), caption="Tomarken Model 1C")

And the comparison table:

MICTable(tomarken1A, tomarken1B, tomarken1C)

This table can be complicated and difficult to read, so it may be helpful to split it into separate chunks based on the types of difference in each.

theTables <- MICTable(tomarken1A, tomarken1B, tomarken1C, splitByType = TRUE)

The result is a list of tables. The most important in this case is the exist table, which carries all paths that differ by the existence of causal effect between at least two models.

kable(theTables$exist, caption="Tomarken Model: MIC Existence Table")

We can cull out the ones we don't want via the %in% operator:

existTable <- theTables$exist
kable(existTable[existTable$from %in% c("X", "Y", "Z"),], caption="Tomarken Model: MIC Existence Table (Reduced)", row.names=FALSE)

In this case, this filters out the rows that are from the additional Residual term Ry, and makes the table look like the one reported by Brick and Bailey.

Of particular note, recognize that manipulations to Y (or Ry, if you prefer) will result in distinctive patterns for each of the different models. Manipulating X results in an existence difference between 1B and the others, since X is an outcome only in 1B. There is also a scale difference between 1A and 1C in the predictions about Z, although it is not tremendous.

The next table is sign, which shows cases where a series of one-tailed tests might distinguish the models (here, empty).

kable(theTables$sign, caption="Tomarken Model: MIC Sign Table")

Then scale, which carries those elements that differ only by scale across all three models (again, here empty).

kable(theTables$scale, caption="Tomarken Model: MIC Scale Table")

The helper table any includes all elements of the previous three tables, ordered. Here, it is identical to the exist table.

kable(theTables$any, caption="Tomarken Model: MIC Any Differences Table")

Finally other contains those paths that are identical in every case.

kable(theTables$other, caption="Tomarken Model: MIC Other Paths Table")

And finally, all contains causal predictions for all pairs of all variables that exist in all three models--this is the default MIC Table.

kable(theTables$all, caption="Tomarken Model: MIC All Paths Table")

trbrick/MICr documentation built on March 7, 2020, 3:30 p.m.