R/plot_methods.R
In Pflegermeister/wizirt2: A United API for IRT in R
Defines functions
irf_probs
plot.irt
Documented in
plot.irt
#' Plot method for wizirt objects
#' @param type Character string. Currently, can be 'trace' for item characteristic curves or 'info' for item information.
#' 'obs', 'trace', 'info', 'resid', 'stand', 'test_info', 'theta'
#' @param item Numeric. Which item or items should be plotted? The default is all of them.
#' @method plot irt
#' @export plot.irt
#' @export
plot.irt <- function(wizirt_fit,
type = 'trace',
items = NULL,
facets = TRUE,
quads = 10,
return_data = FALSE){
UseMethod("plot")
plt_data <- list()
plt <- NULL
if (is.null(items)){
#message('all items')
items = colnames(wizirt_fit$fit$data)[1:ncol(wizirt_fit$fit$data)]
}
if(is.numeric(items)){
items = colnames(wizirt_fit$fit$data)[items]
}
if (grepl('obs', type)){
plt <- 'obs'
pfa <- irt_person_fit(wizirt_fit, stat = 'Ht')
df <- pfa$person_estimates %>%
dplyr::select(ability, tidyselect::all_of(items)) %>%
tidyr::pivot_longer(cols = -1, names_to = 'item')
plt_data[['obs']] <- df
if (facets == F) {
p <- df %>%
ggplot2::ggplot(ggplot2::aes(x = ability, y = value, color = item)) +
ggplot2::geom_jitter(alpha = .5, cex = 2, width = 0, height = .05)
} else{
p <- df %>%
ggplot2::ggplot(ggplot2::aes(x = ability, y = value)) +
ggplot2::geom_jitter(alpha = .5, cex = 2, width = 0, height = .05) +
ggplot2::facet_wrap(~item)
}
p <- p +
ggplot2::labs(title = 'Examinee Responses by Ability')
}
if (grepl('trace', type)) {
df <- irf_probs(wizirt_fit)
plt_data[['trace']] <- df
if (is.null(plt)){
plt <- 'trace'
if (facets == F) {
p <- df %>% # ifa$item_probabilities # I am not sure why they do not line up. I need to explore mirt code.
dplyr::filter(item %in% items) %>%
ggplot2::ggplot(ggplot2::aes(x = x,
y = y,
color = item)) +
ggplot2::geom_line() +
ggplot2::theme(legend.position = 'bottom')
} else{
p <- df %>%
dplyr::filter(item %in% items) %>%
ggplot2::ggplot(ggplot2::aes(x = x,
y = y)) +
ggplot2::geom_line(color = '#130d42') +
ggplot2::theme(legend.position = 'bottom') +
ggplot2::facet_wrap(~item)
}
p <- p +
ggplot2::labs(title = 'Item characteristic curves', y = 'P(X ==1)')
} else { # if plt is not null
plt <- paste(plt, 'trace', sep = '_')
p <- p + ggplot2::geom_line(ggplot2::aes(x = x,
y = y, group = item),
data = df %>%
dplyr::filter(item %in% items))
}
}
if (grepl('resid', type)) {
breaks <- quantile(wizirt_fit$fit$parameters$persons$ability,
seq(0,1,length.out = quads + 1))
breaks[1] <- -Inf
df <- cbind(Ability = wizirt_fit$fit$parameters$persons$ability,
breaks = cut(wizirt_fit$fit$parameters$persons$ability,
breaks,
labels = 1:quads),
wizirt_fit$fit$data) %>%
as.data.frame() %>%
dplyr::group_by(breaks) %>%
dplyr::summarise(dplyr::across(c(Ability,
colnames(wizirt_fit$fit$data)),
mean,
.names = "{.col}")) %>%
tidyr::pivot_longer(cols = -breaks:-Ability,
names_to = 'item',
values_to = 'Probability')
plt_data[['resid']] <- df
if (is.null(plt)){
plt <- 'resid'
if (facets == F) {
p <- df %>%
dplyr::filter(item %in% items) %>%
ggplot2::ggplot(ggplot2::aes(x = Ability, y = Probability)) +
ggplot2::geom_point()
} else {
p <- df %>%
dplyr::filter(item %in% items) %>%
ggplot2::ggplot(ggplot2::aes(x = Ability, y = Probability)) +
ggplot2::geom_point() +
ggplot2::facet_wrap(~item)
}
p <- p +
ggplot2::labs(title = 'Item Residual Plots', y = 'Residuals')
} else { # plt != NULL
plt <- paste(plt, 'resid', sep = '_')
p <- p + ggplot2::geom_point(ggplot2::aes(x = Ability,
y = Probability,
group = item),
data = df %>%
dplyr::filter(item %in% items)
)
}
}
if (grepl('stand', type)) {
breaks <- quantile(wizirt_fit$fit$parameters$persons$ability,
seq(0,1,length.out = quads + 1))
breaks[1] <- -Inf
df <- cbind(Ability = wizirt_fit$fit$parameters$persons$ability,
breaks = cut(wizirt_fit$fit$parameters$persons$ability,
breaks,
labels = 1:quads),
wizirt_fit$fit$data) %>%
as.data.frame() %>%
dplyr::group_by(breaks) %>%
dplyr::summarise(dplyr::across(c(Ability,
colnames(wizirt_fit$fit$data)),
mean,
.names = "{.col}"))
df <- df %>%
tidyr::pivot_longer(cols = -breaks:-Ability,
names_to = 'item',
values_to = 'Probability') %>%
dplyr::mutate(Ability = round(Ability, 10)) %>%
dplyr::left_join(irf_probs(wizirt_fit, theta = df$Ability) %>%
dplyr::rename(Ability = 'x') %>%
dplyr::mutate(Ability = round(Ability, 10))) %>%
dplyr::mutate(stn_res = (Ability - y)/sd(Ability - y))
plt_data[['stand']] <- df
if (is.null(plt)){
plt <- 'stand'
if (facets == F) {
p <- df %>%
dplyr::filter(item %in% items) %>%
ggplot2::ggplot(ggplot2::aes(x = Ability,
y = stn_res,
color = item)) +
ggplot2::geom_point() +
ggplot2::geom_hline(yintercept = 0)
} else {
p <- df %>%
dplyr::filter(item %in% items) %>%
ggplot2::ggplot(ggplot2::aes(x = Ability, y = stn_res)) +
ggplot2::geom_point() +
ggplot2::geom_hline(yintercept = 0) +
ggplot2::facet_wrap(~item)
}
p <- p +
ggplot2::labs(title = 'Standardized Residual Plot', y = 'Standardized Residuals')
} else { # plt != NULL
plt <- paste(plt, 'stand', sep = '_')
p <- p + ggplot2::geom_point(ggplot2::aes(x = Ability,
y = stn_res,
group = item),
data = df %>%
dplyr::filter(item %in% items)
)
}
}
if (grepl('info', type) & !grepl('test', type) ) {
ifa <- irt_item_fit(wizirt_fit)
df <- ifa$item_information
plt_data[['info']] <- df
if(is.null(plt)){
if (facets == FALSE){
p <- df %>%
dplyr::filter(item %in% items) %>%
ggplot2::ggplot(ggplot2::aes(x = theta,
y = info,
color = item)) +
ggplot2::geom_line() +
ggplot2::theme(legend.position = 'bottom') +
ggplot2::labs(title = 'Item information functions')
} else {
p <- df %>%
dplyr::filter(item %in% items) %>%
ggplot2::ggplot(ggplot2::aes(x = theta,
y = info)) +
ggplot2::geom_line() +
ggplot2::geom_line(color = '#130d42') +
ggplot2::facet_wrap(~item) +
ggplot2::labs(title = 'Item information functions')
}
} else { # plt != NULL
plt <- paste(plt, 'info', sep = '_')
p <- p + ggplot2::geom_line(ggplot2::aes(x = theta,
y = info,
group = item),
data = df %>%
dplyr::filter(item %in% items))
}
}
# Test Generally Plots
if (type == 'test_info') { # I would like to do the same thing with the test plots that I do with the item plots. But that is lux.
ifa <- irt_item_fit(wizirt_fit, stats = 'X2')
df <- ifa$item_information%>%
dplyr::filter(item %in% items) %>%
dplyr::group_by(theta) %>%
dplyr::summarize(info = sum(info))
plt_data[['test_info']] <- df
if (grepl('obs|stand|resid|trace', type)) {
rlang::abort("Type 'test_info' can only combine with type 'theta'. Problem: {type}")
} else {
plt <- 'test_info'
p <- df %>%
ggplot2::ggplot(ggplot2::aes(x = theta, ymax = info)) +
ggplot2::geom_ribbon(ymin = 0, fill = "#094bab", alpha = .3, color = '#130d42') +
ggplot2::theme_classic() +
ggplot2::labs(title = 'Test Information Function')
}
}
if (type == 'theta') {
pfa <- irt_person_fit(wizirt_fit, stats = 'Ht', items = items)
df <- pfa$person_estimates
plt_data[['theta']] <- df
if (grepl('obs|stand|resid|trace', type)) {
rlang::abort("Type 'test_info' can only combine with type 'theta'. Problem: {type}")
}
if (is.null(plt)) {
plt <- 'theta'
p <- df %>%
ggplot2::ggplot(ggplot2::aes(x = ability)) +
ggplot2::geom_density(fill = "#094bab",
alpha = .3,
color = '#130d42') +
ggplot2::labs(title = 'Distribution of Person Abilities')
} else {
plt <- paste(plt, 'theta', sep = '_')
p <- p + ggplot2::geom_density(fill = "#094bab",
alpha = .3,
color = '#130d42', data = df)
}
}
if (grepl('theta', type)&grepl('test_info', type)){
p <- ggplot2::ggplot(data = wizirt_fit$fit$parameters$persons)+
ggplot2::annotate('rect', xmin = -3, xmax = 3,
ymin = min(c(wizirt_fit$fit$parameters$coefficients$difficulty,
wizirt_fit$fit$parameters$persons$ability) ) - 2,
ymax = extremes[1], fill = 'red', alpha = .1) +
ggplot2::annotate('rect', xmin = -3, xmax = 3,
ymax = max(c(wizirt_fit$fit$parameters$coefficients$difficulty,
wizirt_fit$fit$parameters$persons$ability) ) + 2,
ymin = extremes[2], fill = 'red', alpha = .1)+
gghalves::geom_half_violin(ggplot2::aes(y = ability, fill = 'a'), side = 'l') +
gghalves::geom_half_violin(mapping = ggplot2::aes(y = difficulty, fill = 'b'),
data = wizirt_fit$fit$parameters$coefficients, side = 'r') +
gghalves::geom_half_dotplot(mapping = ggplot2::aes(y = difficulty),
dotsize = .5,
data = wizirt_fit$fit$parameters$coefficients,
fill = 'white',
drop = T,
method = 'histodot',
binwidth = .1) +
ggplot2::coord_cartesian(ylim = c(min(wizirt_fit$fit$parameters$coefficients$difficulty - .25),
max(wizirt_fit$fit$parameters$persons$ability + .25)), xlim = c(-.5, .5)) +
ggplot2::theme_classic() +
ggplot2::scale_fill_manual(name = '',
values =c('a'='#130d42','b'='#094bab'),
labels = c('c2','c1')) +
ggplot2::labs(title = 'Title', x = '', y = '')
}
# Person Plots
if(grepl('np_prf', type)){
# I will add more person plots in the future.
# I would like to add a person residual thing
# As well as observed vs expected person plots
# and parametric plots
# Actually, we could probably get all the same plots for persons as we can for items
pfa <- irt_person_fit(wizirt_fit, stats = 'Ht', items = items)
df <- pfa$prf
p <- df %>%
ggplot2::ggplot(ggplot2::aes(x = x, y = Y)) +
ggplot2::geom_line() +
ggplot2::geom_ribbon(ggplot2::aes(ymax = Yhigh, ymin = Ylow, fill = Aberrant), # working to add color to aberrant
alpha = .3) +
ggplot2::facet_wrap(~ids) +
ggplot2::ylim(c(0,1)) +
ggplot2::theme_classic() +
ggplot2::theme(strip.text.x = ggplot2::element_text(margin = ggplot2::margin(0, 0, 2, 0))) +
ggplot2::scale_fill_manual(values = c("#094bab", "#cc0c00")) +
ggplot2::labs(title = "Person Response Functions",
x = "Item Difficulty",
y = "P(x = 1)")
}
p <- p + ggplot2::theme_classic()
if (return_data){
return(list(plot = p, data = plt_data))
}
return(p)
}
irf_probs <- function(wizirt_fit, theta = seq(-6, 6, length.out = 100)){
data <- wizirt_fit$fit$parameters$coefficients
prob <- lapply(theta, function(x) data$guessing +
(1 - data$guessing)/(1 + exp(-1.7*data$discrimination*
(x-data$difficulty))))
names(prob) <- theta
cbind.data.frame(item = data$item, tibble::as_tibble(prob, .name_repair = 'unique')) %>%
tidyr::pivot_longer(cols = -1, names_to = 'x', values_to = 'y') %>%
dplyr::mutate(x = as.numeric(x))
}
Pflegermeister/wizirt2 documentation built on Oct. 23, 2020, 1:29 a.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 irf_probs plot.irt
Documented in plot.irt
#' Plot method for wizirt objects
#' @param type Character string. Currently, can be 'trace' for item characteristic curves or 'info' for item information.
#' 'obs', 'trace', 'info', 'resid', 'stand', 'test_info', 'theta'
#' @param item Numeric. Which item or items should be plotted? The default is all of them.
#' @method plot irt
#' @export plot.irt
#' @export
plot.irt <- function(wizirt_fit,
type = 'trace',
items = NULL,
facets = TRUE,
quads = 10,
return_data = FALSE){
UseMethod("plot")
plt_data <- list()
plt <- NULL
if (is.null(items)){
#message('all items')
items = colnames(wizirt_fit$fit$data)[1:ncol(wizirt_fit$fit$data)]
}
if(is.numeric(items)){
items = colnames(wizirt_fit$fit$data)[items]
}
if (grepl('obs', type)){
plt <- 'obs'
pfa <- irt_person_fit(wizirt_fit, stat = 'Ht')
df <- pfa$person_estimates %>%
dplyr::select(ability, tidyselect::all_of(items)) %>%
tidyr::pivot_longer(cols = -1, names_to = 'item')
plt_data[['obs']] <- df
if (facets == F) {
p <- df %>%
ggplot2::ggplot(ggplot2::aes(x = ability, y = value, color = item)) +
ggplot2::geom_jitter(alpha = .5, cex = 2, width = 0, height = .05)
} else{
p <- df %>%
ggplot2::ggplot(ggplot2::aes(x = ability, y = value)) +
ggplot2::geom_jitter(alpha = .5, cex = 2, width = 0, height = .05) +
ggplot2::facet_wrap(~item)
}
p <- p +
ggplot2::labs(title = 'Examinee Responses by Ability')
}
if (grepl('trace', type)) {
df <- irf_probs(wizirt_fit)
plt_data[['trace']] <- df
if (is.null(plt)){
plt <- 'trace'
if (facets == F) {
p <- df %>% # ifa$item_probabilities # I am not sure why they do not line up. I need to explore mirt code.
dplyr::filter(item %in% items) %>%
ggplot2::ggplot(ggplot2::aes(x = x,
y = y,
color = item)) +
ggplot2::geom_line() +
ggplot2::theme(legend.position = 'bottom')
} else{
p <- df %>%
dplyr::filter(item %in% items) %>%
ggplot2::ggplot(ggplot2::aes(x = x,
y = y)) +
ggplot2::geom_line(color = '#130d42') +
ggplot2::theme(legend.position = 'bottom') +
ggplot2::facet_wrap(~item)
}
p <- p +
ggplot2::labs(title = 'Item characteristic curves', y = 'P(X ==1)')
} else { # if plt is not null
plt <- paste(plt, 'trace', sep = '_')
p <- p + ggplot2::geom_line(ggplot2::aes(x = x,
y = y, group = item),
data = df %>%
dplyr::filter(item %in% items))
}
}
if (grepl('resid', type)) {
breaks <- quantile(wizirt_fit$fit$parameters$persons$ability,
seq(0,1,length.out = quads + 1))
breaks[1] <- -Inf
df <- cbind(Ability = wizirt_fit$fit$parameters$persons$ability,
breaks = cut(wizirt_fit$fit$parameters$persons$ability,
breaks,
labels = 1:quads),
wizirt_fit$fit$data) %>%
as.data.frame() %>%
dplyr::group_by(breaks) %>%
dplyr::summarise(dplyr::across(c(Ability,
colnames(wizirt_fit$fit$data)),
mean,
.names = "{.col}")) %>%
tidyr::pivot_longer(cols = -breaks:-Ability,
names_to = 'item',
values_to = 'Probability')
plt_data[['resid']] <- df
if (is.null(plt)){
plt <- 'resid'
if (facets == F) {
p <- df %>%
dplyr::filter(item %in% items) %>%
ggplot2::ggplot(ggplot2::aes(x = Ability, y = Probability)) +
ggplot2::geom_point()
} else {
p <- df %>%
dplyr::filter(item %in% items) %>%
ggplot2::ggplot(ggplot2::aes(x = Ability, y = Probability)) +
ggplot2::geom_point() +
ggplot2::facet_wrap(~item)
}
p <- p +
ggplot2::labs(title = 'Item Residual Plots', y = 'Residuals')
} else { # plt != NULL
plt <- paste(plt, 'resid', sep = '_')
p <- p + ggplot2::geom_point(ggplot2::aes(x = Ability,
y = Probability,
group = item),
data = df %>%
dplyr::filter(item %in% items)
)
}
}
if (grepl('stand', type)) {
breaks <- quantile(wizirt_fit$fit$parameters$persons$ability,
seq(0,1,length.out = quads + 1))
breaks[1] <- -Inf
df <- cbind(Ability = wizirt_fit$fit$parameters$persons$ability,
breaks = cut(wizirt_fit$fit$parameters$persons$ability,
breaks,
labels = 1:quads),
wizirt_fit$fit$data) %>%
as.data.frame() %>%
dplyr::group_by(breaks) %>%
dplyr::summarise(dplyr::across(c(Ability,
colnames(wizirt_fit$fit$data)),
mean,
.names = "{.col}"))
df <- df %>%
tidyr::pivot_longer(cols = -breaks:-Ability,
names_to = 'item',
values_to = 'Probability') %>%
dplyr::mutate(Ability = round(Ability, 10)) %>%
dplyr::left_join(irf_probs(wizirt_fit, theta = df$Ability) %>%
dplyr::rename(Ability = 'x') %>%
dplyr::mutate(Ability = round(Ability, 10))) %>%
dplyr::mutate(stn_res = (Ability - y)/sd(Ability - y))
plt_data[['stand']] <- df
if (is.null(plt)){
plt <- 'stand'
if (facets == F) {
p <- df %>%
dplyr::filter(item %in% items) %>%
ggplot2::ggplot(ggplot2::aes(x = Ability,
y = stn_res,
color = item)) +
ggplot2::geom_point() +
ggplot2::geom_hline(yintercept = 0)
} else {
p <- df %>%
dplyr::filter(item %in% items) %>%
ggplot2::ggplot(ggplot2::aes(x = Ability, y = stn_res)) +
ggplot2::geom_point() +
ggplot2::geom_hline(yintercept = 0) +
ggplot2::facet_wrap(~item)
}
p <- p +
ggplot2::labs(title = 'Standardized Residual Plot', y = 'Standardized Residuals')
} else { # plt != NULL
plt <- paste(plt, 'stand', sep = '_')
p <- p + ggplot2::geom_point(ggplot2::aes(x = Ability,
y = stn_res,
group = item),
data = df %>%
dplyr::filter(item %in% items)
)
}
}
if (grepl('info', type) & !grepl('test', type) ) {
ifa <- irt_item_fit(wizirt_fit)
df <- ifa$item_information
plt_data[['info']] <- df
if(is.null(plt)){
if (facets == FALSE){
p <- df %>%
dplyr::filter(item %in% items) %>%
ggplot2::ggplot(ggplot2::aes(x = theta,
y = info,
color = item)) +
ggplot2::geom_line() +
ggplot2::theme(legend.position = 'bottom') +
ggplot2::labs(title = 'Item information functions')
} else {
p <- df %>%
dplyr::filter(item %in% items) %>%
ggplot2::ggplot(ggplot2::aes(x = theta,
y = info)) +
ggplot2::geom_line() +
ggplot2::geom_line(color = '#130d42') +
ggplot2::facet_wrap(~item) +
ggplot2::labs(title = 'Item information functions')
}
} else { # plt != NULL
plt <- paste(plt, 'info', sep = '_')
p <- p + ggplot2::geom_line(ggplot2::aes(x = theta,
y = info,
group = item),
data = df %>%
dplyr::filter(item %in% items))
}
}
# Test Generally Plots
if (type == 'test_info') { # I would like to do the same thing with the test plots that I do with the item plots. But that is lux.
ifa <- irt_item_fit(wizirt_fit, stats = 'X2')
df <- ifa$item_information%>%
dplyr::filter(item %in% items) %>%
dplyr::group_by(theta) %>%
dplyr::summarize(info = sum(info))
plt_data[['test_info']] <- df
if (grepl('obs|stand|resid|trace', type)) {
rlang::abort("Type 'test_info' can only combine with type 'theta'. Problem: {type}")
} else {
plt <- 'test_info'
p <- df %>%
ggplot2::ggplot(ggplot2::aes(x = theta, ymax = info)) +
ggplot2::geom_ribbon(ymin = 0, fill = "#094bab", alpha = .3, color = '#130d42') +
ggplot2::theme_classic() +
ggplot2::labs(title = 'Test Information Function')
}
}
if (type == 'theta') {
pfa <- irt_person_fit(wizirt_fit, stats = 'Ht', items = items)
df <- pfa$person_estimates
plt_data[['theta']] <- df
if (grepl('obs|stand|resid|trace', type)) {
rlang::abort("Type 'test_info' can only combine with type 'theta'. Problem: {type}")
}
if (is.null(plt)) {
plt <- 'theta'
p <- df %>%
ggplot2::ggplot(ggplot2::aes(x = ability)) +
ggplot2::geom_density(fill = "#094bab",
alpha = .3,
color = '#130d42') +
ggplot2::labs(title = 'Distribution of Person Abilities')
} else {
plt <- paste(plt, 'theta', sep = '_')
p <- p + ggplot2::geom_density(fill = "#094bab",
alpha = .3,
color = '#130d42', data = df)
}
}
if (grepl('theta', type)&grepl('test_info', type)){
p <- ggplot2::ggplot(data = wizirt_fit$fit$parameters$persons)+
ggplot2::annotate('rect', xmin = -3, xmax = 3,
ymin = min(c(wizirt_fit$fit$parameters$coefficients$difficulty,
wizirt_fit$fit$parameters$persons$ability) ) - 2,
ymax = extremes[1], fill = 'red', alpha = .1) +
ggplot2::annotate('rect', xmin = -3, xmax = 3,
ymax = max(c(wizirt_fit$fit$parameters$coefficients$difficulty,
wizirt_fit$fit$parameters$persons$ability) ) + 2,
ymin = extremes[2], fill = 'red', alpha = .1)+
gghalves::geom_half_violin(ggplot2::aes(y = ability, fill = 'a'), side = 'l') +
gghalves::geom_half_violin(mapping = ggplot2::aes(y = difficulty, fill = 'b'),
data = wizirt_fit$fit$parameters$coefficients, side = 'r') +
gghalves::geom_half_dotplot(mapping = ggplot2::aes(y = difficulty),
dotsize = .5,
data = wizirt_fit$fit$parameters$coefficients,
fill = 'white',
drop = T,
method = 'histodot',
binwidth = .1) +
ggplot2::coord_cartesian(ylim = c(min(wizirt_fit$fit$parameters$coefficients$difficulty - .25),
max(wizirt_fit$fit$parameters$persons$ability + .25)), xlim = c(-.5, .5)) +
ggplot2::theme_classic() +
ggplot2::scale_fill_manual(name = '',
values =c('a'='#130d42','b'='#094bab'),
labels = c('c2','c1')) +
ggplot2::labs(title = 'Title', x = '', y = '')
}
# Person Plots
if(grepl('np_prf', type)){
# I will add more person plots in the future.
# I would like to add a person residual thing
# As well as observed vs expected person plots
# and parametric plots
# Actually, we could probably get all the same plots for persons as we can for items
pfa <- irt_person_fit(wizirt_fit, stats = 'Ht', items = items)
df <- pfa$prf
p <- df %>%
ggplot2::ggplot(ggplot2::aes(x = x, y = Y)) +
ggplot2::geom_line() +
ggplot2::geom_ribbon(ggplot2::aes(ymax = Yhigh, ymin = Ylow, fill = Aberrant), # working to add color to aberrant
alpha = .3) +
ggplot2::facet_wrap(~ids) +
ggplot2::ylim(c(0,1)) +
ggplot2::theme_classic() +
ggplot2::theme(strip.text.x = ggplot2::element_text(margin = ggplot2::margin(0, 0, 2, 0))) +
ggplot2::scale_fill_manual(values = c("#094bab", "#cc0c00")) +
ggplot2::labs(title = "Person Response Functions",
x = "Item Difficulty",
y = "P(x = 1)")
}
p <- p + ggplot2::theme_classic()
if (return_data){
return(list(plot = p, data = plt_data))
}
return(p)
}
irf_probs <- function(wizirt_fit, theta = seq(-6, 6, length.out = 100)){
data <- wizirt_fit$fit$parameters$coefficients
prob <- lapply(theta, function(x) data$guessing +
(1 - data$guessing)/(1 + exp(-1.7*data$discrimination*
(x-data$difficulty))))
names(prob) <- theta
cbind.data.frame(item = data$item, tibble::as_tibble(prob, .name_repair = 'unique')) %>%
tidyr::pivot_longer(cols = -1, names_to = 'x', values_to = 'y') %>%
dplyr::mutate(x = as.numeric(x))
}
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.