Visualisierung konfirmatorische Faktorenanalyse

Shiny App

Shiny App

Generell

Diese App illustriert die Komponenten einer konfirmatorischen Faktorenanalyse (CFA). Du kannst die Parameter der CFA über die Schieberegler auf der linken Seite anpassen. Über die beiden Tabs kannst Du entscheiden, ob beobachtete Werte im Streudiagramm angezeigt werden sollen oder nicht.

Parameter

Die Parameter der CFA sind wie folgt definiert:

\(\alpha\): Der Intercept des manifesten Indikators. Der Intercept gibt den erwarteten Wert des manifesten Indikators an, wenn die latente Variable den Wert Null annimmt. Dies ist nur bei Modellen mit Mittelwertsstruktur relevant.

\(\lambda\): Die Ladung des manifesten Indikators auf die latente Variable. Die Ladung gibt an, wie stark der manifeste Indikator mit der latenten Variable zusammenhängt. Wenn die latente Variable um eine Einheit steigt, ändert sich der manifeste Indikator um den Wert der Ladung. Eine Ladung von Null bedeutet, dass der manifeste Indikator nicht mit der latenten Variable zusammenhängt.

\(\epsilon\): Die Residualvarianz des manifesten Indikators. Die Residualvarianz gibt an, wie viel Varianz im manifesten Indikator nicht durch die latente Variable erklärt wird. Eine hohe Residualvarianz bedeutet, dass der manifeste Indikator viele andere Einflüsse hat, die nicht durch die latente Variable erklärt werden.

App

Es kann etwas dauern, bis die App geladen ist (ca. 10s-30s), bitte habe kurz Geduld.

#| '!! shinylive warning !!': |
#|   shinylive does not work in self-contained HTML documents.
#|   Please set `embed-resources: false` in your metadata.
#| standalone: true
#| viewerHeight: 1000
#| viewerWidth: 3000

library(shiny)
library(bslib)
library(shinylive)
library(shinythemes)

# helper function
cfa_plot <- function(int, sl, res, p = TRUE) {
  intercept <- int
  slope <- sl
  residsd <- sqrt(res)
  
  x <- rnorm(n = 150, mean = 0, sd = 1)
  y <- intercept + slope*x + rnorm(150, mean = 0, sd = residsd)
  d <- data.frame(x, y)
  
  plot(
    d, type = "n",
    xlab = "Eta (latente Variable)",
    ylab = "manifester Indikator",
    cex.lab = 1.2,
    font.lab = 2,
    xlim = c(-2, 2),
    ylim = c(0, 7)
  )
  
  if (p) points(d, pch = 16, cex = 0.6, col = "gray70")
  abline(v = 0, col = "gray50", lty = "dashed")
  
  lines(c(-3, 3), c(intercept - 3*slope, intercept + 3*slope))
  lines(c(-1.5, -0.5), rep(intercept-1.5*slope, 2), col = "dodgerblue4")
  lines(c(-0.5, -0.5), c(intercept-1.5*slope, intercept-0.5*slope), col = "steelblue4")
  
  points(0, intercept, lwd = 4, cex = 1.2, col = "darkred")  
  text(-0.35, intercept-slope, expression(lambda), cex = 1.3, font = 2, col = "steelblue4")
  
  text(-1, intercept-1.5*slope - 0.3, "1", cex = 1, col = "steelblue4", font = 2) 
  text(0.2, intercept, expression(alpha), cex = 1.3, col = "darkred", font = 2)
}

# UI
ui <- fluidPage(

  # -> siehe Abschnitt zum Theme unten
  theme = bslib::bs_theme(bootswatch = "cerulean"),

  tags$head(
    # Seite insgesamt schmaler machen
    tags$style(HTML("
      .container-fluid {
        max-width: 1000px;
        margin: 0 auto;
      }
    ")),
    tags$style(HTML("
      .js-irs-0 .irs-single, .js-irs-0 .irs-bar-edge, .js-irs-0 .irs-bar {background: darkred}
      .js-irs-1 .irs-single, .js-irs-1 .irs-bar-edge, .js-irs-1 .irs-bar {background: steelblue4}
      .js-irs-2 .irs-single, .js-irs-2 .irs-bar-edge, .js-irs-2 .irs-bar {background: gray}
    "))
  ),

  # titlePanel("Beta Item Response Theory With Response Styles: Illustration"),

  sidebarLayout(
    sidebarPanel(
      width = 4,
      sliderInput("interceptA", 
        withMathJax(HTML(
            "\\(\\alpha\\): Intercept"
          )),
        min = 2, max = 5, value = 3.5, step = 0.1),
      sliderInput("slopeB",
        withMathJax(HTML(
            "\\(\\lambda\\): Ladung"
          )),
        min = -2, max = 2, value = 1, step = 0.1),
      sliderInput("residD",
        withMathJax(HTML(
            "\\(\\epsilon\\): Residualvarianz"
          )),
        min = 0, max = 3, value = 0.5, step = 0.1)
    ),

    mainPanel(
      width = 8,
      tabsetPanel(
        tabPanel("ohne beobachtete Werte",
          plotOutput("loading", height = "400px"),
          textOutput("instruction")
        ),
        tabPanel("mit beobachteten Werten",
          plotOutput("loadingRes", height = "400px"),
          textOutput("instruction2")
        )
      )
    )
  )
)

# Server
server <- function(input, output) {

  output$loading <- renderPlot({
    cfa_plot(
      int = input$interceptA,
      sl  = input$slopeB,
      res = input$residD,
      p   = FALSE
    )
  })

  output$loadingRes <- renderPlot({
    cfa_plot(
      int = input$interceptA,
      sl  = input$slopeB,
      res = input$residD,
      p   = TRUE
    )
  })
}

shinyApp(ui = ui, server = server)