Factor-Scores
Factor-Scores.Rmdbnlearn can also be used to compute the factor scores of the SEM. Those factor scores appear to be identical to the regression scores in OpenMx:
library(bnSEM)
model <- '
# latent variable definitions
ind60 =~ x1 + x2 + x3
dem60 =~ y1 + a*y2 + b*y3 + c*y4
dem65 =~ y5 + a*y6 + b*y7 + c*y8
# regressions
dem60 ~ ind60
dem65 ~ ind60 + dem60
# residual correlations
y1 ~~ y5
y2 ~~ y4 + y6
y3 ~~ y7
y4 ~~ y8
y6 ~~ y8
'
mx_model <- mxsem(model,
data = OpenMx::Bollen) |>
mxTryHard()
fs <- mxFactorScores(mx_model, type = "Regression")
network <- bnSEM::bnSEM(mx_model = mx_model)Let’s predict the values of a single node, dem65:
# Predict dem65
fs[,3,1] - predict(network$bayes_net,
"dem65",
# Note: We need the extended data returned by bnSEM.
data = network$internal$extended_data,
# Note: We have to change the method, otherwise only
# parent nodes will be used for prediction.
method = "exact")
#> Warning in check.data(data, allow.missing = TRUE, allow.levels = TRUE): at
#> least one variable in the data has no observed values.
#> 1 2 3 4 5
#> -4.635870e-06 -7.918362e-06 -1.325634e-06 4.955989e-06 3.869641e-06
#> 6 7 8 9 10
#> 6.379365e-06 3.955593e-06 -3.164562e-06 -3.546607e-06 -6.035940e-08
#> 11 12 13 14 15
#> -8.706849e-07 1.737689e-07 2.202865e-06 5.396952e-06 -4.915891e-06
#> 16 17 18 19 20
#> 3.922772e-06 -1.064065e-06 -3.944372e-06 1.288428e-06 4.721335e-06
#> 21 22 23 24 25
#> 9.353120e-07 1.891592e-06 -1.148821e-07 -1.196189e-07 1.540951e-06
#> 26 27 28 29 30
#> 1.592389e-06 -4.789979e-06 8.009985e-07 1.218288e-06 7.118435e-06
#> 31 32 33 34 35
#> -3.843439e-06 -1.985394e-06 4.170358e-08 8.052055e-06 -4.784676e-06
#> 36 37 38 39 40
#> 2.162195e-06 3.910798e-06 3.421305e-06 -5.754240e-06 1.013822e-06
#> 41 42 43 44 45
#> 1.790519e-06 -5.579245e-06 -4.670489e-07 -9.618734e-06 -4.200464e-07
#> 46 47 48 49 50
#> -2.696317e-06 1.723765e-06 -1.264133e-06 4.536601e-06 2.535424e-06
#> 51 52 53 54 55
#> -3.811127e-06 -4.283666e-06 -4.094281e-06 -4.683330e-06 2.029820e-06
#> 56 57 58 59 60
#> -3.825246e-06 -1.993729e-06 8.060819e-07 -2.216438e-06 -1.121092e-06
#> 61 62 63 64 65
#> 2.252346e-07 -2.921718e-06 -8.743934e-06 4.920787e-07 -5.074529e-06
#> 66 67 68 69 70
#> -7.747441e-06 -2.620433e-06 -1.682052e-06 5.583355e-06 -5.050839e-06
#> 71 72 73 74 75
#> -9.685783e-07 -1.714532e-06 2.497857e-06 -1.570414e-06 2.243636e-06Alternatively, we can create predictions for all missing data (here: all latent variables) with impute:
predicted_data <- impute(network$bayes_net,
data = network$internal$extended_data,
method = "exact")
#> Warning in check.data(data, allow.levels = TRUE, allow.missing = TRUE,
#> warn.if.no.missing = TRUE): at least one variable in the data has no observed
#> values.
# Predict dem60
fs[,2,1] - predicted_data$dem60
#> 1 2 3 4 5
#> -3.611181e-06 -5.281288e-07 2.295693e-06 1.800541e-06 1.723438e-06
#> 6 7 8 9 10
#> 2.584867e-07 -2.756573e-07 2.004544e-06 -9.330251e-07 3.853503e-06
#> 11 12 13 14 15
#> 2.306105e-06 2.299492e-06 -4.779050e-07 1.060227e-06 1.130528e-06
#> 16 17 18 19 20
#> 3.839286e-07 -2.239562e-06 -5.053398e-06 2.986536e-06 -2.856004e-07
#> 21 22 23 24 25
#> 3.970155e-06 -6.326457e-06 -5.386012e-06 1.110631e-06 2.629767e-06
#> 26 27 28 29 30
#> -3.100840e-06 1.066706e-07 -3.273799e-06 4.955284e-06 1.290793e-06
#> 31 32 33 34 35
#> -1.000326e-06 -3.893687e-06 -7.275473e-07 -5.539031e-06 -2.546715e-06
#> 36 37 38 39 40
#> 1.247406e-06 -2.784034e-06 -2.436749e-06 -9.156825e-07 -1.893377e-06
#> 41 42 43 44 45
#> -1.106016e-06 1.514838e-06 -8.112065e-07 4.118060e-06 3.564526e-06
#> 46 47 48 49 50
#> 1.586738e-06 -2.039004e-06 2.762364e-06 6.420942e-07 -6.773339e-07
#> 51 52 53 54 55
#> -2.355744e-06 -8.498137e-07 -1.081798e-06 1.422297e-06 -5.562748e-06
#> 56 57 58 59 60
#> -4.653816e-06 -4.566213e-06 6.834370e-07 -2.305091e-06 1.407990e-06
#> 61 62 63 64 65
#> -5.934876e-06 -4.190627e-06 -3.752680e-06 -1.112931e-06 3.128673e-06
#> 66 67 68 69 70
#> 1.300419e-06 -4.016743e-07 1.990025e-06 -4.835078e-08 -2.175490e-06
#> 71 72 73 74 75
#> 2.425792e-07 2.230339e-06 8.569582e-07 5.541817e-06 -3.972454e-06
# Predict dem65
fs[,3,1] - predicted_data$dem65
#> 1 2 3 4 5
#> -4.635870e-06 -7.918362e-06 -1.325634e-06 4.955989e-06 3.869641e-06
#> 6 7 8 9 10
#> 6.379365e-06 3.955593e-06 -3.164562e-06 -3.546607e-06 -6.035940e-08
#> 11 12 13 14 15
#> -8.706849e-07 1.737689e-07 2.202865e-06 5.396952e-06 -4.915891e-06
#> 16 17 18 19 20
#> 3.922772e-06 -1.064065e-06 -3.944372e-06 1.288428e-06 4.721335e-06
#> 21 22 23 24 25
#> 9.353120e-07 1.891592e-06 -1.148821e-07 -1.196189e-07 1.540951e-06
#> 26 27 28 29 30
#> 1.592389e-06 -4.789979e-06 8.009985e-07 1.218288e-06 7.118435e-06
#> 31 32 33 34 35
#> -3.843439e-06 -1.985394e-06 4.170357e-08 8.052055e-06 -4.784676e-06
#> 36 37 38 39 40
#> 2.162195e-06 3.910798e-06 3.421305e-06 -5.754240e-06 1.013822e-06
#> 41 42 43 44 45
#> 1.790519e-06 -5.579245e-06 -4.670489e-07 -9.618734e-06 -4.200464e-07
#> 46 47 48 49 50
#> -2.696317e-06 1.723765e-06 -1.264133e-06 4.536601e-06 2.535424e-06
#> 51 52 53 54 55
#> -3.811127e-06 -4.283666e-06 -4.094281e-06 -4.683330e-06 2.029820e-06
#> 56 57 58 59 60
#> -3.825246e-06 -1.993729e-06 8.060819e-07 -2.216438e-06 -1.121092e-06
#> 61 62 63 64 65
#> 2.252345e-07 -2.921718e-06 -8.743934e-06 4.920787e-07 -5.074529e-06
#> 66 67 68 69 70
#> -7.747441e-06 -2.620433e-06 -1.682052e-06 5.583354e-06 -5.050839e-06
#> 71 72 73 74 75
#> -9.685783e-07 -1.714532e-06 2.497857e-06 -1.570414e-06 2.243636e-06