Snippets

Dénes Türei Item analysis for polytomous data

Created by Dénes Türei
#!/usr/bin/env Rscript

# Item analysis on polytomous data.
#
# Author: Denes Turei (turei.denes@gmail.com)

packages <- c(
    'haven',
    'itemanalysis',
    'dplyr',
    'magrittr',
    'tidyselect',
    'CTT',
    'withr',
    'purrr',
    'ggplot2',
    'tidyr'
)
local_lib <- '~/r_packages'
.libPaths(new = local_lib)

for(pkg in packages){

    if(!require(pkg, character.only = TRUE)){

        dir.create(local_lib, showWarnings = FALSE)
        install.packages(pkg, lib = local_lib)
        library(pkg, character.only = TRUE)

    }

}


clean_data <- haven::read_sav('Rohdatensatz_BA.sav')

# Item analysis for polytomous variables using the `itemanalysis` package:
item_plots <-
    clean_data %>%
    select(matches('^(CO|EK|AL|AS\\d{2}_\\d{2})')) %>%
    as.data.frame %>%
    itemanalysis2(options = seq(5))

# Okay, these plots are pretty much useless
# If cairo_pdf is not available on your system, change it to with_pdf
withr::with_cairo_pdf(
    'item_analysis.pdf',
    width = 7,
    height = 3,
    onefile = TRUE,
    walk(item_plots, print)
)


# Item analysis for polytomous variables using the `CTT` package:
item_report <-
    clean_data %>%
    select(matches('^(CO|EK|AL|AS\\d{2}_\\d{2})')) %>%
    as.data.frame %>%
    itemAnalysis

# Check these results:
item_report$itemReport

# Also plot the raw data, that's something always good to do:
tidy_data <-
    clean_data %>%
    select(matches('^(CO|EK|AL|AS\\d{2}_\\d{2})')) %>%
    pivot_longer(everything())


response_counts_bar <-
    ggplot(tidy_data, aes(value)) +
    facet_wrap(~name) +
    geom_bar() +
    xlab('Answer choices (1-5)') +
    ylab('Number of respondants') +
    theme_bw()

# if cairo_pdf is not available on your system, change it to with_pdf
with_cairo_pdf(
    'response_counts_bar.pdf',
    width = 9,
    height = 9,
    print(response_counts_bar)
)

# now plot it also as a heatmap:
tidy_data <-
    clean_data %>%
    select(matches('^(CO|EK|AL|AS\\d{2}_\\d{2})')) %>%
    mutate(respondant = row_number()) %>%
    pivot_longer(-respondant, names_to = 'question', values_to = 'answer') %>%
    mutate(answer = as.numeric(answer))


raw_heatmap <-
    ggplot(tidy_data, aes(x = question, y = respondant, fill = answer)) +
    geom_tile() +
    scale_fill_continuous(
        guide = guide_legend(title = 'Answers (1-5)')
    ) +
    scale_y_continuous(
        limits = c(.5, n_distinct(tidy_data$respondant) + .5),
        expand = c(0, 0)
    ) +
    xlab('Questions') +
    ylab('Respondants') +
    theme_bw() +
    theme(
        axis.text.x = element_text(angle = 90, vjust = 0.5, hjust = 1)
    )

# if cairo_pdf is not available on your system, change it to with_pdf
with_cairo_pdf(
    'raw_data_heatmap.pdf',
    width = 9,
    height = 11,
    print(raw_heatmap)
)

Comments (0)

HTTPS SSH

You can clone a snippet to your computer for local editing. Learn more.