R/irt_report.R
In Pflegermeister/wizirt: A United API for IRT
Defines functions
irt_html_report
clean_string
irt_report
Documented in
irt_report
#' Create a general IRT report for a test
#'
#' @description irt_report
#' @param mode Must be 'regression' currently.
#' @param item_type Character. Must be one of 'Rasch', '1PL', '2PL' or '3PL'.
#' @param rownames Optional unique row IDs for the data (i.e. examinee IDs). If omitted, uses 1:nrow(data).
#' @param tol Numeric. Convergence criterion. Currently only implemented when engine is mirt.
#' @param ifa_stats A character or character string identifying item-level fit measures. Must be at least one of c('Zh', 'X2', 'G2', 'infit'). More are coming very soon. Default is 'X2'.
#' @param pfa_bins Numeric. How many bins to break items into for pfa multilevel modeling. Sorted by difficulty then broken into bins. If items cannot fit equally into bins, the bins of easier items will take extras.
#' @param pfa_predictors Either a matrix or dataframe with a row per person and a column per predictor.
#' @param pfa_stats A character or character string identifying person-level fit measures. Default is "Ht". All of the stats in PerFit should be available. Let me know if any don't work. for more information.
#' @export
irt_report <- function(data,
report_type = "html",
title = "My Report",
author = "",
note = "",
engine = "mirt",
item_type = "Rasch",
rownames = NULL,
tol = 1e-5,
ifa_stats = c("X2"),
pfa_predictors = NULL,
pfa_bins = 5,
pfa_stats = c("Ht")) {
message("Please wait while the wizirt's apprentice prepares your report.")
file <- paste0(tempfile(), ".rds")
readr::write_rds(data, file)
parameters <- list(
data = file,
title = title,
author = author,
note = note,
engine = engine,
item_type = item_type,
rownames = rownames,
tol = tol,
ifa_stats = ifa_stats,
pfa_predictors = pfa_predictors,
pfa_bins = pfa_bins,
pfa_stats = pfa_stats
)
irt_html_report(parameters = parameters)
}
clean_string <- function(x) {
gsub("_{2,}", "_", gsub(" ", "_", tolower(trimws(gsub("[[:punct:]]", "", x)))))
}
irt_html_report <- function(parameters) {
fileConn <- file(paste0(clean_string(parameters$title), ".Rmd"))
writeLines(c(
"---",
"output:",
" rmdformats::readthedown:",
" highlight: kate",
"params:",
" title: 'My Report' ",
" author: '' ",
" note: ''",
" engine: 'mirt'",
" item_type: 'Rasch' ",
" rownames: !r NULL ",
" tol: !r 1e-5 ",
" ifa_stats: !r c('infit')",
" pfa_predictors: NULL",
" pfa_bins: 5 ",
" pfa_stats: !r c(\"Ht\", \"U3\")",
" data: !r NULL",
"---",
"",
"---",
"title: `r params$title`",
"subtitle: `r params$notes`",
"author: `r params$author`",
"data: `r params$data`",
"date: `r format(Sys.time(), '%B %d, %Y, %H:%M %p')`",
"---",
"<link rel=\"shortcut icon\" href=\"https://raw.githubusercontent.com/Pflegermeister/wizirt/main/pkgdown/favicon/apple-touch-icon-60x60.png\">",
"```{css, echo = FALSE, message = FALSE, warning = FALSE}",
"#main .nav-pills > li.active > a,",
"#main .nav-pills > li.active > a:hover,",
"#main .nav-pills > li.active > a:focus {",
" background-color: #566D81;",
"}",
"",
"#main .nav-pills > li > a:hover {",
" background-color: #566D81;",
"}",
"",
"h1, h2, h3, h4, h5, h6, legend {",
" color: #566D81;",
"}",
"",
"#nav-top span.glyphicon {",
" color: #566D81;",
"}",
"",
"#table-of-contents header {",
" color: #566D81;",
"}",
"",
"#table-of-contents h2 {",
" background-color: #566D81;",
"}",
"",
"#main a {",
" background-image: linear-gradient(180deg,#7896AE,#7896AE);",
" color: #7C7D7D;",
"}",
"",
"a:hover {",
" color: #231E1F;",
"}",
"",
"#postamble {",
" color: #F4F5F5;",
" background: #020a23;",
" border-top: solid 10px #020a23;",
" font-family: \"Lato\",\"proxima-nova\",\"Helvetica Neue\",Arial,sans-serif;",
" font-size: 90%;",
" z-index: 400;",
" padding: 12px;",
"}",
"#postamble p {",
" color: #F4F5F5;",
" font-size: 100%;",
" margin-bottom: 0;",
"}",
"",
"body {",
" background-color: #fcfcf7;",
"}",
"",
"#content {",
" background: #fcfcf7;",
" max-width:1200px;",
"}",
"",
"#sidebar h2 {",
" z-index: 200;",
" background-color: #566D81;",
" text-align: center;",
" padding: 0.809em;",
" display: block;",
" color: #F4F5F5;",
" font-size: 100%;",
" margin-top: 0;",
" margin-bottom: 0.809em;",
"}",
"",
"#sidebar a {",
" color: #F4F5F5;",
"}",
"",
"#sidebar {",
" position: fixed;",
" top: 0;",
" overflow: hidden;",
" display: flex;",
" flex-direction: column;",
" height: 100%;",
" background: #020a23;",
" z-index: 200;",
" font-size: 16px;",
"}",
" ",
"p {",
" color:#201520;",
"} ",
"",
"img {",
" border-radius: 5px;",
" box-shadow: 3px 3px 10px #ccc;",
"}",
"",
".table-wrapper, .ReactTable {",
" padding: 7px;",
" border-radius: 5px;",
" background-color: white;",
" box-shadow: 3px 3px 10px #ccc;",
"}",
"",
"",
"pre {",
" box-shadow: 3px 3px 10px #ccc; ",
"}",
"",
".logo {",
" position: absolute;",
" right:0;",
" width: 100px;",
" box-shadow: 0 0 0 #ccc;",
"}",
"```",
"",
"```{r setup, echo=FALSE, cache=FALSE, message=FALSE, warning = FALSE}",
"library(knitr)",
"library(rmdformats)",
"library(flextable)",
"library(reactable)",
"library(wizirt)",
"## Global options",
"options(max.print=\"75\")",
"opts_chunk$set(echo=FALSE,",
" prompt=FALSE,",
" tidy=TRUE,",
" comment=NA,",
" message=FALSE,",
" warning=FALSE)",
"opts_knit$set(width=75)",
"```",
"",
"```{r, message = FALSE}",
"if(is.null(params$data)){",
" cat('This report was generated using the practice data from the wizirt package')",
" data('responses') ",
" data <- responses[,-1]",
"} else {",
" data <- readr::read_rds(params$data)",
"}",
"```",
"",
"```{r}",
"my_model <- wizirt(data = data, engine = params$engine, item_type = params$item_type, tol = params$tol, rownames = params$rownames) ",
"```",
"",
"```{r, results = 'asis'}",
"cat(params$note)",
"```",
"",
"# Model Overview",
"",
"## Technical Information",
"",
"A `r my_model$fit$model$n_factors` factor `r my_model$fit$model$item_type` model was estimated using the function **`r my_model$fit$model$engine$func`** from the package **`r my_model$fit$model$engine$pkg`** (v `r my_model$fit$model$engine$ver`). Estimation has `r ifelse(my_model$fit$estimation$convergence, \"\", \"not\")` converged using the `r my_model$fit$estimation$method` method after `r my_model$fit$estimation$iterations` iterations with a convergence criteria $`r my_model$fit$estimation$criteria`$.",
"",
"",
"## Data Summary",
"",
"Model built on a data set with `r nrow(my_model$fit$data)` examinees ($\\bar{\\theta}$ = `r round(mean(my_model$fit$parameters$persons$ability, na.rm = T), 2)`, $\\sigma_{\\theta}$ = `r round(sd(my_model$fit$parameters$persons$ability, na.rm = T), 2)`) and `r ncol(my_model$fit$data)` items ($\\bar{\\delta}$ = `r round(mean(my_model$fit$parameters$coefficients$difficulty, na.rm = T), 2)`, $\\sigma_{\\delta}$ = `r round(sd(my_model$fit$parameters$coefficients$difficulty, na.rm = T), 2)`). ",
"",
"## Missing Data Summary",
"",
"```{r, results = 'asis'}",
"if(mean(is.na(my_model$fit$data)) == 0){",
" cat(\"No data were missing from this data set.\")",
"} else {",
" print(my_model, type = 'na_item') %>% dplyr::filter(count != 0) %>% flextable() %>% autofit()",
" print(my_model, type = 'na_person') %>% dplyr::filter(count != 0) %>% flextable() %>% autofit()",
"}",
"```",
"",
" ",
"```{r, results = 'asis'}",
"if(mean(is.na(my_model$fit$data)) == 0){",
" cat(\"\")",
"} else {",
" cat(\"## Description of Missing Data Handling",
" ",
"Generally, missing data are handled using full information during estimation. Additional functions for item and person fit tend to use list wise deletion or pairwise deletion.\")",
"}",
"```",
"",
"",
"## Assumptions {.tabset .tabset-fade .tabset-pills}",
"",
"```{r}",
"assumptions <- irt_assume(my_model)",
"```",
"",
"### Unidimensionality",
"```{r}",
"",
"print(assumptions, type = 'unid') %>% flextable() %>% autofit() %>% add_header_lines(c(\"Statistics Detecting Essential Unidimensionality\", \"Table 1\")) %>% add_footer_lines(glue::glue(\"Statistics generated using sirt {packageVersion('sirt')}\"))",
"",
"```",
"",
"<hr>",
"",
"### Relative Fit",
"```{r}",
"anova(my_model) %>% flextable() %>% autofit()",
"```",
"",
"<hr>",
"",
"### Local/Conditional Dependence",
"",
"",
"```{r}",
"library(reactable)",
"assumptions$ld %>% ",
" dplyr::mutate(dplyr::across(LD_std:ccov, round, 3)) %>% ",
" dplyr::rename(`Item 1` = \"item_1\", `Item 2` = \"item_2\") %>% ",
" reactable::reactable(filterable = T, ",
" paginationType = \"simple\",",
" searchable = TRUE, columns = list(",
" pvals = colDef(style = function(value) {",
" if (value < .05) {",
" color <- \"#9e0317\"",
" } else {",
" color <- \"#020a23\"",
" }",
" list(color = color)",
" })",
"))",
"```",
"",
"<br>",
"",
"```{r}",
"plot(my_model, type = 'ld_pairs')",
"```",
"",
"",
"## Summary Plots {.tabset .tabset-fade .tabset-pills}",
"",
"### Test Information",
"",
"```{r} ",
"plot(my_model, type = 'tinfo')",
"```",
"",
"### Theta Estimates and Item Difficulties",
"",
"```{r} ",
"plot(my_model, type = 'theta_diff') + ggplot2::aes(color = type) + ggplot2::scale_color_manual(values = c(\"#020a23\", \"#566D81\"))",
"```",
"",
"<hr>",
"",
"# Items",
"",
"## Item-level Statistics",
" ",
"```{r}",
"",
"ifa <- irt_item_fit(my_model, stats = params$ifa_stats)",
"",
"print(ifa) %>% dplyr::mutate(dplyr::across(-item, round, 2)) %>% ",
" reactable::reactable(paginationType = \"simple\",",
" searchable = TRUE)",
"```",
"",
"## Item-level Plots {.tabset .tabset-fade .tabset-pills}",
"",
"### Item Characteristic Curves and Residuals",
"",
"```{r}",
"plot(my_model, type = 'resid_trace') + ggplot2::coord_cartesian(xlim = c(-3,3))",
"```",
"",
"<hr>",
"",
"### Item Characteristic Curves and Observed Responses",
"",
"```{r}",
"plot(my_model, type = 'obs_trace') + ggplot2::coord_cartesian(xlim = c(-3,3))",
"```",
"",
"<hr>",
"",
"### Standardized Residuals",
"",
"```{r}",
"plot(my_model, type = 'stand') + ggplot2::coord_cartesian(xlim = c(-3,3))",
"```",
"",
"<hr>",
"",
"### Item Information",
"",
"```{r}",
"plot(my_model, type = 'info') + ggplot2::coord_cartesian(xlim = c(-3,3))",
"```",
"",
"<hr>",
"",
"# Persons",
"",
"## Person-level Plots {.tabset .tabset-fade .tabset-pills}",
"",
"### Districution of Person Abilities",
"```{r}",
"plot(my_model, type = 'theta_SE') ",
"```",
"",
"### Person Response Functions {.tabset .tabset-fade .tabset-pills}",
"",
"",
"```{r, results = 'asis'}",
"persons_per = 30",
"out <- plot_wrap(object = my_model, type = 'np_prf', persons_per = persons_per)",
"for (i in seq_len(length(out))){",
"",
" numbers <- seq_len(persons_per)+(i-1)*persons_per",
" numbers <- numbers[numbers %in% seq_len(nrow(my_model$fit$data))]",
" ",
" cat(glue::glue(\"#### Persons {min(numbers)}:{max(numbers)}\n\n\"))",
" print(out[[i]])",
" cat(\"\n\n\")",
"}",
"```",
"",
"## Person-level Statistics",
"",
"",
"### Person-level Statistics",
"",
"```{r}",
"pfa <- irt_person_fit(my_model, stats = params$pfa_stats)",
"print(pfa, patterns = T, item_order = 'by_diff') %>%",
" dplyr::relocate(ids) %>% ",
" dplyr::mutate(dplyr::across(c(-ids, -pattern), round, 2)) %>% ",
" reactable::reactable(paginationType = \"simple\",",
" searchable = TRUE, ",
" columns = list(",
" pattern = colDef(minWidth = 300)))",
"```",
" ",
"### Quantitative Explanation of Person Misfit ",
" ",
"```{r}",
"",
"pfa_mlm <- irt_model_pfa(my_model, pfa = pfa, predictors = params$pfa_predictors)",
"",
"",
" eval(parse(text = paste0(\"pfa_mlm$icc %>% as.data.frame() %>% tibble::rownames_to_column('ICC') %>% dplyr::mutate(dplyr::across(tidyselect::all_of(params$pfa_stats), function(x) round(as.numeric(x),3) )) %>% ",
" reactable::reactable(columns = list(\", paste( glue::glue('{params$pfa_stats} = colDef(maxWidth = 100)'), collapse = ',\n'), \"))\")",
" )",
" )",
" ",
"",
"mods <- lapply(1:length(pfa_mlm$models), function(x) {",
" pfa_mlm$models[[x]] %>% summary() %>% coef() %>% round(2) %>% as.data.frame() %>% tibble::rownames_to_column() %>% dplyr::mutate(Model = names(pfa_mlm$models)[x]) ",
" })",
"",
"dplyr::bind_rows(mods) %>% reactable::reactable()",
"",
"",
"```",
"",
"",
"",
"# References",
"",
"Estimation performed by the following packages:",
"",
"- Chung Y, Rabe-Hesketh S, Dorie V, Gelman A, Liu J (2013). “A nondegenerate penalized likelihood estimator for variance parameters in multilevel models.” _Psychometrika_, *78*(4), 685-709. <URL: http://gllamm.org/>.",
"",
"- Dimitris Rizopoulos (2006). ltm: An R package for Latent Variable Modelling and Item Response Theory Analyses, Journal of Statistical Software, 17 (5), 1-25. URL http://www.jstatsoft.org/v17/i05/",
"",
"- Jorge N. Tendeiro, Rob R. Meijer, A. Susan M. Niessen (2016). PerFit: An R Package for Person-Fit Analysis in IRT. Journal of Statistical Software, 74(5), 1-27. doi:10.18637/jss.v074.i05",
"",
"- Mair, P., Hatzinger, R., & Maier M. J. (2020). eRm: Extended Rasch Modeling. 1.0-1. https://cran.r-project.org/package=eRm",
"",
"- R. Philip Chalmers (2012). mirt: A Multidimensional Item Response Theory Package for the R Environment. Journal of Statistical Software, 48(6), 1-29. doi:10.18637/jss.v048.i06",
"",
"- Robitzsch, A. (2020). sirt: Supplementary Item Response Theory Models. R package version 3.9-4. https://CRAN.R-project.org/package=sirt",
"",
"<hr>",
"",
"",
"<p class = \"logo\" style = \"width:225px;\"> Powered by wizirt <img class = \"logo\" src = \"https://raw.githubusercontent.com/Pflegermeister/wizirt/main/pkgdown/favicon/apple-touch-icon-120x120.png\"> </p>"
), fileConn)
close(fileConn)
rmarkdown::render(paste0(clean_string(parameters$title), ".Rmd"), params = parameters, runtime = "static")
browseURL(paste0(getwd(), "/", clean_string(parameters$title), ".html"), browser = NULL)
}
Pflegermeister/wizirt documentation built on Nov. 22, 2020, 8:27 p.m.
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
Defines functions irt_html_report clean_string irt_report
Documented in irt_report
#' Create a general IRT report for a test
#'
#' @description irt_report
#' @param mode Must be 'regression' currently.
#' @param item_type Character. Must be one of 'Rasch', '1PL', '2PL' or '3PL'.
#' @param rownames Optional unique row IDs for the data (i.e. examinee IDs). If omitted, uses 1:nrow(data).
#' @param tol Numeric. Convergence criterion. Currently only implemented when engine is mirt.
#' @param ifa_stats A character or character string identifying item-level fit measures. Must be at least one of c('Zh', 'X2', 'G2', 'infit'). More are coming very soon. Default is 'X2'.
#' @param pfa_bins Numeric. How many bins to break items into for pfa multilevel modeling. Sorted by difficulty then broken into bins. If items cannot fit equally into bins, the bins of easier items will take extras.
#' @param pfa_predictors Either a matrix or dataframe with a row per person and a column per predictor.
#' @param pfa_stats A character or character string identifying person-level fit measures. Default is "Ht". All of the stats in PerFit should be available. Let me know if any don't work. for more information.
#' @export
irt_report <- function(data,
report_type = "html",
title = "My Report",
author = "",
note = "",
engine = "mirt",
item_type = "Rasch",
rownames = NULL,
tol = 1e-5,
ifa_stats = c("X2"),
pfa_predictors = NULL,
pfa_bins = 5,
pfa_stats = c("Ht")) {
message("Please wait while the wizirt's apprentice prepares your report.")
file <- paste0(tempfile(), ".rds")
readr::write_rds(data, file)
parameters <- list(
data = file,
title = title,
author = author,
note = note,
engine = engine,
item_type = item_type,
rownames = rownames,
tol = tol,
ifa_stats = ifa_stats,
pfa_predictors = pfa_predictors,
pfa_bins = pfa_bins,
pfa_stats = pfa_stats
)
irt_html_report(parameters = parameters)
}
clean_string <- function(x) {
gsub("_{2,}", "_", gsub(" ", "_", tolower(trimws(gsub("[[:punct:]]", "", x)))))
}
irt_html_report <- function(parameters) {
fileConn <- file(paste0(clean_string(parameters$title), ".Rmd"))
writeLines(c(
"---",
"output:",
" rmdformats::readthedown:",
" highlight: kate",
"params:",
" title: 'My Report' ",
" author: '' ",
" note: ''",
" engine: 'mirt'",
" item_type: 'Rasch' ",
" rownames: !r NULL ",
" tol: !r 1e-5 ",
" ifa_stats: !r c('infit')",
" pfa_predictors: NULL",
" pfa_bins: 5 ",
" pfa_stats: !r c(\"Ht\", \"U3\")",
" data: !r NULL",
"---",
"",
"---",
"title: `r params$title`",
"subtitle: `r params$notes`",
"author: `r params$author`",
"data: `r params$data`",
"date: `r format(Sys.time(), '%B %d, %Y, %H:%M %p')`",
"---",
"<link rel=\"shortcut icon\" href=\"https://raw.githubusercontent.com/Pflegermeister/wizirt/main/pkgdown/favicon/apple-touch-icon-60x60.png\">",
"```{css, echo = FALSE, message = FALSE, warning = FALSE}",
"#main .nav-pills > li.active > a,",
"#main .nav-pills > li.active > a:hover,",
"#main .nav-pills > li.active > a:focus {",
" background-color: #566D81;",
"}",
"",
"#main .nav-pills > li > a:hover {",
" background-color: #566D81;",
"}",
"",
"h1, h2, h3, h4, h5, h6, legend {",
" color: #566D81;",
"}",
"",
"#nav-top span.glyphicon {",
" color: #566D81;",
"}",
"",
"#table-of-contents header {",
" color: #566D81;",
"}",
"",
"#table-of-contents h2 {",
" background-color: #566D81;",
"}",
"",
"#main a {",
" background-image: linear-gradient(180deg,#7896AE,#7896AE);",
" color: #7C7D7D;",
"}",
"",
"a:hover {",
" color: #231E1F;",
"}",
"",
"#postamble {",
" color: #F4F5F5;",
" background: #020a23;",
" border-top: solid 10px #020a23;",
" font-family: \"Lato\",\"proxima-nova\",\"Helvetica Neue\",Arial,sans-serif;",
" font-size: 90%;",
" z-index: 400;",
" padding: 12px;",
"}",
"#postamble p {",
" color: #F4F5F5;",
" font-size: 100%;",
" margin-bottom: 0;",
"}",
"",
"body {",
" background-color: #fcfcf7;",
"}",
"",
"#content {",
" background: #fcfcf7;",
" max-width:1200px;",
"}",
"",
"#sidebar h2 {",
" z-index: 200;",
" background-color: #566D81;",
" text-align: center;",
" padding: 0.809em;",
" display: block;",
" color: #F4F5F5;",
" font-size: 100%;",
" margin-top: 0;",
" margin-bottom: 0.809em;",
"}",
"",
"#sidebar a {",
" color: #F4F5F5;",
"}",
"",
"#sidebar {",
" position: fixed;",
" top: 0;",
" overflow: hidden;",
" display: flex;",
" flex-direction: column;",
" height: 100%;",
" background: #020a23;",
" z-index: 200;",
" font-size: 16px;",
"}",
" ",
"p {",
" color:#201520;",
"} ",
"",
"img {",
" border-radius: 5px;",
" box-shadow: 3px 3px 10px #ccc;",
"}",
"",
".table-wrapper, .ReactTable {",
" padding: 7px;",
" border-radius: 5px;",
" background-color: white;",
" box-shadow: 3px 3px 10px #ccc;",
"}",
"",
"",
"pre {",
" box-shadow: 3px 3px 10px #ccc; ",
"}",
"",
".logo {",
" position: absolute;",
" right:0;",
" width: 100px;",
" box-shadow: 0 0 0 #ccc;",
"}",
"```",
"",
"```{r setup, echo=FALSE, cache=FALSE, message=FALSE, warning = FALSE}",
"library(knitr)",
"library(rmdformats)",
"library(flextable)",
"library(reactable)",
"library(wizirt)",
"## Global options",
"options(max.print=\"75\")",
"opts_chunk$set(echo=FALSE,",
" prompt=FALSE,",
" tidy=TRUE,",
" comment=NA,",
" message=FALSE,",
" warning=FALSE)",
"opts_knit$set(width=75)",
"```",
"",
"```{r, message = FALSE}",
"if(is.null(params$data)){",
" cat('This report was generated using the practice data from the wizirt package')",
" data('responses') ",
" data <- responses[,-1]",
"} else {",
" data <- readr::read_rds(params$data)",
"}",
"```",
"",
"```{r}",
"my_model <- wizirt(data = data, engine = params$engine, item_type = params$item_type, tol = params$tol, rownames = params$rownames) ",
"```",
"",
"```{r, results = 'asis'}",
"cat(params$note)",
"```",
"",
"# Model Overview",
"",
"## Technical Information",
"",
"A `r my_model$fit$model$n_factors` factor `r my_model$fit$model$item_type` model was estimated using the function **`r my_model$fit$model$engine$func`** from the package **`r my_model$fit$model$engine$pkg`** (v `r my_model$fit$model$engine$ver`). Estimation has `r ifelse(my_model$fit$estimation$convergence, \"\", \"not\")` converged using the `r my_model$fit$estimation$method` method after `r my_model$fit$estimation$iterations` iterations with a convergence criteria $`r my_model$fit$estimation$criteria`$.",
"",
"",
"## Data Summary",
"",
"Model built on a data set with `r nrow(my_model$fit$data)` examinees ($\\bar{\\theta}$ = `r round(mean(my_model$fit$parameters$persons$ability, na.rm = T), 2)`, $\\sigma_{\\theta}$ = `r round(sd(my_model$fit$parameters$persons$ability, na.rm = T), 2)`) and `r ncol(my_model$fit$data)` items ($\\bar{\\delta}$ = `r round(mean(my_model$fit$parameters$coefficients$difficulty, na.rm = T), 2)`, $\\sigma_{\\delta}$ = `r round(sd(my_model$fit$parameters$coefficients$difficulty, na.rm = T), 2)`). ",
"",
"## Missing Data Summary",
"",
"```{r, results = 'asis'}",
"if(mean(is.na(my_model$fit$data)) == 0){",
" cat(\"No data were missing from this data set.\")",
"} else {",
" print(my_model, type = 'na_item') %>% dplyr::filter(count != 0) %>% flextable() %>% autofit()",
" print(my_model, type = 'na_person') %>% dplyr::filter(count != 0) %>% flextable() %>% autofit()",
"}",
"```",
"",
" ",
"```{r, results = 'asis'}",
"if(mean(is.na(my_model$fit$data)) == 0){",
" cat(\"\")",
"} else {",
" cat(\"## Description of Missing Data Handling",
" ",
"Generally, missing data are handled using full information during estimation. Additional functions for item and person fit tend to use list wise deletion or pairwise deletion.\")",
"}",
"```",
"",
"",
"## Assumptions {.tabset .tabset-fade .tabset-pills}",
"",
"```{r}",
"assumptions <- irt_assume(my_model)",
"```",
"",
"### Unidimensionality",
"```{r}",
"",
"print(assumptions, type = 'unid') %>% flextable() %>% autofit() %>% add_header_lines(c(\"Statistics Detecting Essential Unidimensionality\", \"Table 1\")) %>% add_footer_lines(glue::glue(\"Statistics generated using sirt {packageVersion('sirt')}\"))",
"",
"```",
"",
"<hr>",
"",
"### Relative Fit",
"```{r}",
"anova(my_model) %>% flextable() %>% autofit()",
"```",
"",
"<hr>",
"",
"### Local/Conditional Dependence",
"",
"",
"```{r}",
"library(reactable)",
"assumptions$ld %>% ",
" dplyr::mutate(dplyr::across(LD_std:ccov, round, 3)) %>% ",
" dplyr::rename(`Item 1` = \"item_1\", `Item 2` = \"item_2\") %>% ",
" reactable::reactable(filterable = T, ",
" paginationType = \"simple\",",
" searchable = TRUE, columns = list(",
" pvals = colDef(style = function(value) {",
" if (value < .05) {",
" color <- \"#9e0317\"",
" } else {",
" color <- \"#020a23\"",
" }",
" list(color = color)",
" })",
"))",
"```",
"",
"<br>",
"",
"```{r}",
"plot(my_model, type = 'ld_pairs')",
"```",
"",
"",
"## Summary Plots {.tabset .tabset-fade .tabset-pills}",
"",
"### Test Information",
"",
"```{r} ",
"plot(my_model, type = 'tinfo')",
"```",
"",
"### Theta Estimates and Item Difficulties",
"",
"```{r} ",
"plot(my_model, type = 'theta_diff') + ggplot2::aes(color = type) + ggplot2::scale_color_manual(values = c(\"#020a23\", \"#566D81\"))",
"```",
"",
"<hr>",
"",
"# Items",
"",
"## Item-level Statistics",
" ",
"```{r}",
"",
"ifa <- irt_item_fit(my_model, stats = params$ifa_stats)",
"",
"print(ifa) %>% dplyr::mutate(dplyr::across(-item, round, 2)) %>% ",
" reactable::reactable(paginationType = \"simple\",",
" searchable = TRUE)",
"```",
"",
"## Item-level Plots {.tabset .tabset-fade .tabset-pills}",
"",
"### Item Characteristic Curves and Residuals",
"",
"```{r}",
"plot(my_model, type = 'resid_trace') + ggplot2::coord_cartesian(xlim = c(-3,3))",
"```",
"",
"<hr>",
"",
"### Item Characteristic Curves and Observed Responses",
"",
"```{r}",
"plot(my_model, type = 'obs_trace') + ggplot2::coord_cartesian(xlim = c(-3,3))",
"```",
"",
"<hr>",
"",
"### Standardized Residuals",
"",
"```{r}",
"plot(my_model, type = 'stand') + ggplot2::coord_cartesian(xlim = c(-3,3))",
"```",
"",
"<hr>",
"",
"### Item Information",
"",
"```{r}",
"plot(my_model, type = 'info') + ggplot2::coord_cartesian(xlim = c(-3,3))",
"```",
"",
"<hr>",
"",
"# Persons",
"",
"## Person-level Plots {.tabset .tabset-fade .tabset-pills}",
"",
"### Districution of Person Abilities",
"```{r}",
"plot(my_model, type = 'theta_SE') ",
"```",
"",
"### Person Response Functions {.tabset .tabset-fade .tabset-pills}",
"",
"",
"```{r, results = 'asis'}",
"persons_per = 30",
"out <- plot_wrap(object = my_model, type = 'np_prf', persons_per = persons_per)",
"for (i in seq_len(length(out))){",
"",
" numbers <- seq_len(persons_per)+(i-1)*persons_per",
" numbers <- numbers[numbers %in% seq_len(nrow(my_model$fit$data))]",
" ",
" cat(glue::glue(\"#### Persons {min(numbers)}:{max(numbers)}\n\n\"))",
" print(out[[i]])",
" cat(\"\n\n\")",
"}",
"```",
"",
"## Person-level Statistics",
"",
"",
"### Person-level Statistics",
"",
"```{r}",
"pfa <- irt_person_fit(my_model, stats = params$pfa_stats)",
"print(pfa, patterns = T, item_order = 'by_diff') %>%",
" dplyr::relocate(ids) %>% ",
" dplyr::mutate(dplyr::across(c(-ids, -pattern), round, 2)) %>% ",
" reactable::reactable(paginationType = \"simple\",",
" searchable = TRUE, ",
" columns = list(",
" pattern = colDef(minWidth = 300)))",
"```",
" ",
"### Quantitative Explanation of Person Misfit ",
" ",
"```{r}",
"",
"pfa_mlm <- irt_model_pfa(my_model, pfa = pfa, predictors = params$pfa_predictors)",
"",
"",
" eval(parse(text = paste0(\"pfa_mlm$icc %>% as.data.frame() %>% tibble::rownames_to_column('ICC') %>% dplyr::mutate(dplyr::across(tidyselect::all_of(params$pfa_stats), function(x) round(as.numeric(x),3) )) %>% ",
" reactable::reactable(columns = list(\", paste( glue::glue('{params$pfa_stats} = colDef(maxWidth = 100)'), collapse = ',\n'), \"))\")",
" )",
" )",
" ",
"",
"mods <- lapply(1:length(pfa_mlm$models), function(x) {",
" pfa_mlm$models[[x]] %>% summary() %>% coef() %>% round(2) %>% as.data.frame() %>% tibble::rownames_to_column() %>% dplyr::mutate(Model = names(pfa_mlm$models)[x]) ",
" })",
"",
"dplyr::bind_rows(mods) %>% reactable::reactable()",
"",
"",
"```",
"",
"",
"",
"# References",
"",
"Estimation performed by the following packages:",
"",
"- Chung Y, Rabe-Hesketh S, Dorie V, Gelman A, Liu J (2013). “A nondegenerate penalized likelihood estimator for variance parameters in multilevel models.” _Psychometrika_, *78*(4), 685-709. <URL: http://gllamm.org/>.",
"",
"- Dimitris Rizopoulos (2006). ltm: An R package for Latent Variable Modelling and Item Response Theory Analyses, Journal of Statistical Software, 17 (5), 1-25. URL http://www.jstatsoft.org/v17/i05/",
"",
"- Jorge N. Tendeiro, Rob R. Meijer, A. Susan M. Niessen (2016). PerFit: An R Package for Person-Fit Analysis in IRT. Journal of Statistical Software, 74(5), 1-27. doi:10.18637/jss.v074.i05",
"",
"- Mair, P., Hatzinger, R., & Maier M. J. (2020). eRm: Extended Rasch Modeling. 1.0-1. https://cran.r-project.org/package=eRm",
"",
"- R. Philip Chalmers (2012). mirt: A Multidimensional Item Response Theory Package for the R Environment. Journal of Statistical Software, 48(6), 1-29. doi:10.18637/jss.v048.i06",
"",
"- Robitzsch, A. (2020). sirt: Supplementary Item Response Theory Models. R package version 3.9-4. https://CRAN.R-project.org/package=sirt",
"",
"<hr>",
"",
"",
"<p class = \"logo\" style = \"width:225px;\"> Powered by wizirt <img class = \"logo\" src = \"https://raw.githubusercontent.com/Pflegermeister/wizirt/main/pkgdown/favicon/apple-touch-icon-120x120.png\"> </p>"
), fileConn)
close(fileConn)
rmarkdown::render(paste0(clean_string(parameters$title), ".Rmd"), params = parameters, runtime = "static")
browseURL(paste0(getwd(), "/", clean_string(parameters$title), ".html"), browser = NULL)
}
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
Embedding an R snippet on your website
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.