diff --git a/DESCRIPTION b/DESCRIPTION index 57e3968..084c4bf 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -20,7 +20,7 @@ Description: Provides quantitative tools for substantive and content-oriented Krippendorff's alpha as described by Hayes and Krippendorff (2007) . Also provides judge and rater heterogeneity analysis following the generalizability-theory treatment of - content-validity ratings in Crocker, Llabre and Miller (1988) + content-validity ratings in Crocker et al. (1988) , content-domain coverage and expert-perceived content structure following Sireci and Geisinger (1992) , consensus and stability across Delphi diff --git a/NAMESPACE b/NAMESPACE index c641adc..3fde67b 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -1,8 +1,19 @@ # Generated by roxygen2: do not edit by hand +S3method(as.data.frame,contentvalid_agreement) +S3method(as.data.frame,contentvalid_binom) S3method(as.data.frame,contentvalid_component) +S3method(as.data.frame,contentvalid_cvi) S3method(as.data.frame,contentvalid_evidence) +S3method(as.data.frame,contentvalid_expert_power) +S3method(as.data.frame,contentvalid_gtheory) +S3method(as.data.frame,contentvalid_handoff) S3method(as.data.frame,contentvalid_report) +S3method(as.data.frame,contentvalid_reproducibility) +S3method(as.data.frame,contentvalid_rounds) +S3method(as.data.frame,contentvalid_signal) +S3method(as.data.frame,contentvalid_sort_power) +S3method(as.data.frame,contentvalid_structure) S3method(as.data.frame,contentvalid_workflow) S3method(plot,contentvalid_delphi) S3method(plot,contentvalid_evidence) diff --git a/NEWS.md b/NEWS.md index 585820b..6b1b2f3 100644 --- a/NEWS.md +++ b/NEWS.md @@ -584,6 +584,86 @@ analysis that matches the cases below. * The reporting vignette's congruence guidance reports the index against its criterion, with the means and margin as description. +## Keys, help pages, figures and tables: values that change + +* **Report intervals are named after their estimates.** `content_report()` + returned two columns both named "95% CI" in a relevance report, so + `tab$"95% CI"` found only the first. Every interval column is now named + after its estimate (`Psa 95% CI`, `V 95% CI`, `I-CVI 95% CI`), and the + printed table and the Markdown head it "95% CI", beside that estimate. A + column the user renames prints under the new name. +* **`plot()` takes `xlab`, `ylab`, `xlim`, `ylim` and `main` everywhere.** + Most plot methods set these themselves and also passed `...` on, so giving + one stopped with "formal argument matched by multiple actual arguments". + An argument the caller gives now replaces the method's own, except those + the figure's encoding depends on: the frame type, the axes the method + draws, and the decision symbols a map's legend keys. A `NULL` leaves the + method's value, and an unnamed argument is dropped with a warning. In the + distribution views and the evidence profile a title is drawn once, above + the legend, and the item labels take the place of a y-axis label. +* **Long item names no longer stop a figure.** The distribution views and + the evidence profile sized the label margin to the longest name, and a + long one left no room to draw ("figure margins too large"). Labels are + measured on the device; one wider than 40% of the width left for labels + is shortened in the middle, keeping its start and end, so names that + share an opening stay apart. + +## Keys, help pages, figures and tables: other fixes + +* `as.data.frame()` works on every result: `cvi()`, `gtheory_content()`, + `content_structure()`, `compare_rounds()`, `content_handoff()`, + `sort_power()`, `expert_power()` and `panel_agreement()` had no method, and + `csv_binom_test()`, `signal_detection()` and `reproducibility_phi()` gave + two to four rows for one test. A result holding several tables takes + `component`; a single test is one row, with an interval as two columns and + a two-by-two table as four named counts. The agreement row names the + interval's error rate `ci_alpha`, and the binomial row marks its interval + one-sided. See `?"contentvalid-data-frames"`. +* The key said modified kappa falls below 0 "when agreement is below + chance". It does so only when no expert, or one of three, rated the item + relevant: 2 of 8 gives .16. +* The relevance key defines S-CVI/Ave and S-CVI/UA, which the header prints. +* With `agreement = "ac1"`, the key describes AC1, which is not 0 for + independent raters and stays high when ratings concentrate; it repeated + the Krippendorff caution that the coefficient "can be low when nearly + every rating is the same". The generic agreement entry now describes + Krippendorff's alpha alone. +* The glossary said judge severity is in logits when the model is + estimable. Its terms now follow the `results` columns: `severity_raw`, + printed as severity, in rating points, and `severity`, printed as logit, + from the facets model on the relevant/not-relevant decision, which can + differ even in sign. The key gives both. +* The domain decision meanings state the rules: more than `over_factor` + times the expected share, and less than the target share divided by it. +* Three-author works are cited with "et al." in the `cvi()` printout and + help, the legacy sort printout and `?sort_validity` (Yao et al., 2008), + the item-sort and reporting vignettes, and DESCRIPTION; "p value" is no + longer hyphenated; article numbers read "Article 93". +* Help pages cite every work they list, by author and date: the interval + methods in `?compute_psa`, Colquitt et al. (2019) in `?htd`, Hinkin and + Tracey (1999) in `?htc`, Aiken (1980) in `?aikens_v`, Howard and Melloy + (2016) in `?simulate_csv_power` and `?sort_power`, Feinstein and + Cicchetti (1990) and Wongpakaran et al. (2013) in `?panel_agreement`, and + Penfield and Giacobbi (2004), Polit et al. (2007), Hayes and Krippendorff + (2007) and Zapf et al. (2016) in `?expert_validity`; the expert-panel and + reading-output vignettes likewise. +* `?contentvalidR` promised `plot()` for all six workflows; judge and domain + fits have none, and it now says how to draw a domain fit's content map + when similarity data were supplied. +* The reporting vignettes build their tables with `content_report()` rather + than from raw `results` columns, and point to the strongest competitor and + the scale-level CVIs, which those tables leave out. +* `reading-output` says what `Strong` means: the 60th to 79th percentile of + the scales Colquitt et al. (2019) collected, not "typical of published + work". +* The walkthrough says seven items, not five, each set a test for one + stage; that the fifteen assignments follow from the null probability of + .50, not from "two plausible answers"; calls `csv` the substantive validity + coefficient; and no longer says the judges "never considered", or "saw + only one of", the facets of an item four of them sorted elsewhere. +* The handoff vignette's nomologR install line names CRAN as well as + R-universe, so it works in a fresh library. + ## Other changes * The reader in nomologR is now tested against handoffs from contentvalidR diff --git a/R/aikens_v.R b/R/aikens_v.R index e8a137d..7588d2e 100644 --- a/R/aikens_v.R +++ b/R/aikens_v.R @@ -1,9 +1,9 @@ #' Aiken's V for expert content-relevance ratings #' #' @description -#' Computes Aiken's V per item for bounded ordinal expert ratings. By default, -#' confidence intervals use the score method described by Penfield and -#' Giacobbi (2004). Percentile bootstrap intervals remain available for +#' Computes Aiken's (1980) V per item for bounded ordinal expert ratings. By +#' default, confidence intervals use the score method described by Penfield +#' and Giacobbi (2004). Percentile bootstrap intervals remain available for #' compatibility and sensitivity analysis. #' #' @param ratings Matrix/data.frame with judges in rows and items in columns. diff --git a/R/as_data_frame.R b/R/as_data_frame.R new file mode 100644 index 0000000..dfcd19a --- /dev/null +++ b/R/as_data_frame.R @@ -0,0 +1,194 @@ +#' Tables from contentvalidR results +#' +#' @description +#' `as.data.frame()` returns a result's table as an ordinary data frame, for +#' filtering, joining, or writing to a file. A result that holds several +#' tables returns the one named by `component`; a single test returns one row. +#' Fitted workflows have their own method, +#' [as.data.frame.contentvalid_workflow()]. +#' +#' @param x A contentvalidR result. +#' @param row.names,optional Accepted for compatibility with +#' [base::as.data.frame()] and ignored. +#' @param component The table to return, where a result holds more than one +#' (`NULL`, the default, gives the first listed): +#' * [cvi()]: `"item_level"` (default) or `"scale_level"`. +#' * [gtheory_content()]: `"variance_components"` (default), +#' `"coefficients"`, `"dstudy"`, or `"judges_needed"`. +#' * [content_structure()]: `"items"` (default; each item's cluster, +#' blueprint cell and coordinates), `"fit"`, or `"cross_tab"`. +#' * [compare_rounds()]: `"transitions"` (default), `"summary"`, or +#' `"settings_changes"`. +#' * [content_handoff()]: `"item_evidence"` (default), `"item_statistics"`, +#' or `"panel_statistics"`. +#' @param ... Not used. +#' +#' @return A data frame. [csv_binom_test()], [signal_detection()], +#' [reproducibility_phi()] and [panel_agreement()] give one row: an +#' interval becomes two columns, and a two-by-two table becomes its four +#' counts. For [panel_agreement()] the interval's error rate is `ci_alpha`, +#' since `alpha` would read as Krippendorff's; for [csv_binom_test()] the +#' one-sided interval is marked by `ci_sides` and `ci_level`. +#' +#' @examples +#' R <- matrix(c(4, 3, 4, 4, 3, 4, 2, 3, 4, 4, 3, 2), 6, +#' dimnames = list(NULL, c("I1", "I2"))) +#' as.data.frame(cvi(R >= 3)) +#' as.data.frame(cvi(R >= 3), component = "scale_level") +#' as.data.frame(csv_binom_test(16, 20)) +#' @name contentvalid-data-frames +NULL + +# One table out of a result holding several. +.as_df_part <- function(x, component, choices) { + component <- match.arg(component, choices) + out <- x[[component]] + if (is.null(out)) { + stop("This result has no `", component, "` table.", call. = FALSE) + } + out <- as.data.frame(out, stringsAsFactors = FALSE) + rownames(out) <- NULL + out +} + +# One row from a single test: scalars as they are, an interval as two +# columns, and a two-by-two table as its four counts. +.as_df_row <- function(x) { + x <- unclass(x) + cols <- list() + for (nm in names(x)) { + v <- x[[nm]] + if (is.table(v) || is.matrix(v)) { + if (length(dim(v)) == 2L && all(dim(v) == 2L)) { + # Each count is named by its row and column: "n_predicted_retain_ + # actual_not_retained" for a confusion table. + dn <- dimnames(v) + tidy <- function(z) gsub("[^a-z0-9]+", "_", tolower(z)) + cells <- if (length(dn) == 2L && !is.null(names(dn)) && + all(nzchar(names(dn)))) { + as.vector(outer(paste(names(dn)[1], dn[[1]]), + paste(names(dn)[2], dn[[2]]), paste)) + } else { + paste(nm, c("11", "21", "12", "22")) + } + cols[paste0("n_", tidy(cells))] <- as.list(as.vector(v)) + } + } else if (is.atomic(v) && length(v) == 1L) { + cols[[nm]] <- v + } else if (is.atomic(v) && length(v) == 2L) { + stem <- if (identical(nm, "conf.int")) "ci" else nm + cols[paste0(stem, c("_low", "_high"))] <- as.list(as.vector(v)) + } + } + as.data.frame(cols, stringsAsFactors = FALSE, check.names = FALSE) +} + +#' @rdname contentvalid-data-frames +#' @export +as.data.frame.contentvalid_cvi <- function(x, row.names = NULL, optional = FALSE, + component = NULL, ...) { + if (is.null(component)) component <- "item_level" + .as_df_part(x, component, c("item_level", "scale_level")) +} + +#' @rdname contentvalid-data-frames +#' @export +as.data.frame.contentvalid_gtheory <- function(x, row.names = NULL, optional = FALSE, + component = NULL, ...) { + if (is.null(component)) component <- "variance_components" + .as_df_part(x, component, c("variance_components", "coefficients", + "dstudy", "judges_needed")) +} + +#' @rdname contentvalid-data-frames +#' @export +as.data.frame.contentvalid_structure <- function(x, row.names = NULL, + optional = FALSE, + component = NULL, ...) { + if (is.null(component)) component <- "items" + component <- match.arg(component, c("items", "fit", "cross_tab")) + if (component == "items") { + # The clusters table already carries each item's coordinates. + out <- x$clusters + rownames(out) <- NULL + return(out) + } + if (component == "cross_tab") { + if (is.null(x$cross_tab)) { + stop("This result has no `cross_tab` table: no blueprint was given.", + call. = FALSE) + } + out <- as.data.frame(x$cross_tab, stringsAsFactors = FALSE) + names(out)[ncol(out)] <- "n_items" + return(out) + } + .as_df_part(x, component, "fit") +} + +#' @rdname contentvalid-data-frames +#' @export +as.data.frame.contentvalid_rounds <- function(x, row.names = NULL, optional = FALSE, + component = NULL, ...) { + if (is.null(component)) component <- "transitions" + .as_df_part(x, component, c("transitions", "summary", "settings_changes")) +} + +#' @rdname contentvalid-data-frames +#' @export +as.data.frame.contentvalid_handoff <- function(x, row.names = NULL, optional = FALSE, + component = NULL, ...) { + if (is.null(component)) component <- "item_evidence" + .as_df_part(x, component, c("item_evidence", "item_statistics", + "panel_statistics")) +} + +#' @rdname contentvalid-data-frames +#' @export +as.data.frame.contentvalid_sort_power <- function(x, row.names = NULL, + optional = FALSE, ...) { + .as_df_part(x, "table", "table") +} + +#' @rdname contentvalid-data-frames +#' @export +as.data.frame.contentvalid_expert_power <- function(x, row.names = NULL, + optional = FALSE, ...) { + .as_df_part(x, "results", "results") +} + +#' @rdname contentvalid-data-frames +#' @export +as.data.frame.contentvalid_agreement <- function(x, row.names = NULL, + optional = FALSE, ...) { + out <- .as_df_row(x) + # `alpha` here is the interval's error rate, not Krippendorff's alpha. + names(out)[names(out) == "alpha"] <- "ci_alpha" + out +} + +#' @rdname contentvalid-data-frames +#' @export +as.data.frame.contentvalid_binom <- function(x, row.names = NULL, optional = FALSE, + ...) { + out <- .as_df_row(x) + # The interval is one-sided, as the printout says. + if ("ci_low" %in% names(out)) { + out$ci_sides <- "one-sided" + out$ci_level <- attr(x$conf.int, "conf.level") + } + out +} + +#' @rdname contentvalid-data-frames +#' @export +as.data.frame.contentvalid_signal <- function(x, row.names = NULL, optional = FALSE, + ...) { + .as_df_row(x) +} + +#' @rdname contentvalid-data-frames +#' @export +as.data.frame.contentvalid_reproducibility <- function(x, row.names = NULL, + optional = FALSE, ...) { + .as_df_row(x) +} diff --git a/R/compute_psa.R b/R/compute_psa.R index ce42217..48bbe6a 100644 --- a/R/compute_psa.R +++ b/R/compute_psa.R @@ -12,8 +12,11 @@ #' @param assignments A data.frame containing item-sort responses. #' @param item_col,rater_col,assigned_col,target_col Column names for the item, #' rater, assigned construct, and intended target construct. -#' @param ci Interval method for Psa: `"wilson"` (default), `"agresti_coull"`, -#' `"exact"`, or `"none"`. The methods and the evidence for each are described +#' @param ci Interval method for Psa: `"wilson"` (default), the score interval +#' of Wilson (1927); `"agresti_coull"`, the adjusted Wald interval of Agresti +#' and Coull (1998); `"exact"`, the Clopper and Pearson (1934) interval; or +#' `"none"`. Newcombe (1998) compared seven methods and recommends score +#' intervals over the Wald interval; the evidence for each is described #' under `ci` in [cvi()]. #' @param alpha Two-sided alpha level for the interval; `0.05` gives a 95% #' interval. diff --git a/R/content_evidence.R b/R/content_evidence.R index 5a3558a..bee8dbb 100644 --- a/R/content_evidence.R +++ b/R/content_evidence.R @@ -449,8 +449,13 @@ plot.contentvalid_evidence <- function(x, type = c("profile", "flow"), op <- graphics::par(no.readonly = TRUE) on.exit(graphics::par(op), add = TRUE) - graphics::par(oma = c(0, 1.2 + 0.62 * max(nchar(items)), - if (show_legend) 1.6 else 0.3, 0.5), + lab <- .item_labels(items, width_in = graphics::par("din")[1]) + # A title is drawn once, above every panel, not on each one. + dots <- list(...) + main <- dots$main + graphics::par(oma = c(0, lab$lines, + (if (show_legend) 1.6 else 0.3) + + if (length(main)) 1.6 else 0, 0.5), mar = c(4.1, 0.6, 1.9, 0.6)) graphics::layout(matrix(seq_len(ns + 1L), 1), widths = c(rep(1, ns), 0.75)) @@ -462,14 +467,15 @@ plot.contentvalid_evidence <- function(x, type = c("profile", "flow"), stat <- s$statistic[1] xlim <- switch(stat, CVR = c(-1, 1), IOC = c(-1, 1), `target IOC` = c(-1, 1), `highest IOC` = c(-1, 1), `IOC margin` = c(-2, 2), c(0, 1)) - graphics::plot(NA, xlim = xlim, ylim = c(0.4, n + 0.6), xaxt = "n", - yaxt = "n", xlab = stat, ylab = "", ...) + .plot_with(list(x = NA, xlim = xlim, ylim = c(0.4, n + 0.6), xaxt = "n", + yaxt = "n", xlab = stat, ylab = ""), dots, + protect = c("type", "xaxt", "yaxt", "axes", "main", "ylab")) if (stat == "IOC margin") { graphics::axis(1, at = seq(-2, 2)) } else { .axis_bounded(1, at = seq(xlim[1], xlim[2], length.out = 5)) } - if (k == 1L) graphics::axis(2, at = y, labels = items, las = 1) + if (k == 1L) graphics::axis(2, at = y, labels = lab$labels, las = 1) if (length(breaks)) graphics::abline(h = y[breaks] - 0.5, col = "grey80") row <- match(s$item, items) crit <- unique(s$criterion[is.finite(s$criterion)]) @@ -526,6 +532,10 @@ plot.contentvalid_evidence <- function(x, type = c("profile", "flow"), graphics::mtext(paste(parts, collapse = " "), side = 3, outer = TRUE, line = 0.2, cex = 0.72) } + if (length(main)) { + graphics::title(main = main, outer = TRUE, + line = (if (show_legend) 1.6 else 0.3) + 0.2) + } invisible(NULL) } diff --git a/R/content_handoff.R b/R/content_handoff.R index 82ef65b..3e9be08 100644 --- a/R/content_handoff.R +++ b/R/content_handoff.R @@ -861,7 +861,7 @@ #' #' The four columns are `NA` together when a statistic has no interval. That #' happens when the method defines none (Csv, HTC, HTD, CVR, the essential -#' count, modified kappa, IOC, and p-values), when intervals were switched off +#' count, modified kappa, IOC, and p values), when intervals were switched off #' with `proportion_ci = "none"`, or when the statistic itself could not be #' computed. `NA` there never stands for missing data. #' diff --git a/R/contentvalidR-package.R b/R/contentvalidR-package.R index e036961..843637a 100644 --- a/R/contentvalidR-package.R +++ b/R/contentvalidR-package.R @@ -10,8 +10,11 @@ #' #' \strong{Tier 1, the recommended workflows.} [sort_validity()], #' [rating_validity()], [expert_validity()], [delphi_validity()], -#' [judge_validity()], and [domain_validity()]; their `print()`, `summary()`, -#' and `plot()` methods; the object contract they share (`results`, +#' [judge_validity()], and [domain_validity()]; their `print()` and +#' `summary()` methods, and the `plot()` methods of the first four (when +#' similarity data were supplied, a domain fit's content map is drawn with +#' `plot(fit$details$structure)`); the object +#' contract they share (`results`, #' `scale_summary`, `settings`, `design`, `details`); the shared status #' vocabulary (`Supported`, `Review`, `Insufficient data`, `Descriptive #' only`); and [content_handoff()], [content_evidence()], [content_report()], diff --git a/R/cvi.R b/R/cvi.R index 143e113..6c77619 100644 --- a/R/cvi.R +++ b/R/cvi.R @@ -3,7 +3,7 @@ #' @description #' Computes item-level Content Validity Index (I-CVI), scale-level average CVI #' (S-CVI/Ave), universal-agreement CVI (S-CVI/UA), and the modified kappa -#' described by Polit, Beck, and Owen (2007). +#' described by Polit et al. (2007). #' #' The I-CVI is the proportion of experts rating an item 3 or 4 on a 4-point #' relevance scale (Lynn, 1986). Polit and Beck (2006) named the two @@ -189,7 +189,7 @@ print.contentvalid_cvi <- function(x, digits = 2, ...) { cat("\n") .say("agree: judges rating the item relevant, out of those who rated it.", "Pc: the probability that this many judges would agree by chance.", - "kappa: the modified kappa of Polit, Beck and Owen (2007), the I-CVI", + "kappa: the modified kappa of Polit et al. (2007), the I-CVI", "chance-corrected by Pc.") if (has_ci) { cat("\n") diff --git a/R/delphi_validity.R b/R/delphi_validity.R index 807f6f7..686c743 100644 --- a/R/delphi_validity.R +++ b/R/delphi_validity.R @@ -1304,7 +1304,7 @@ plot.contentvalid_delphi <- function(x, rounds = ratings, items = unique(as.character(x$results$item)), lo = x$settings$lo, hi = x$settings$hi, cut = x$settings$agree_cut, criterion = threshold, status = status, value_label = "Agree", - xlab = "Share of experts (left: below the agreement cut; right: agreeing)", + axis_label = "Share of experts (left: below the agreement cut; right: agreeing)", labels = labels, apa = apa, show_legend = show_legend, ... ) return(invisible(x)) @@ -1324,9 +1324,9 @@ plot.contentvalid_delphi <- function(x, # Headroom at the top keeps the legend clear of the lines. ylim <- c(0, 1.16) - graphics::plot(NA, xlim = c(1, length(rounds) + right_pad * 0.12), - ylim = ylim, yaxt = "n", xaxt = "n", - xlab = "Round", ylab = "Share of experts agreeing", ...) + .plot_with(list(x = NA, xlim = c(1, length(rounds) + right_pad * 0.12), + ylim = ylim, yaxt = "n", xaxt = "n", + xlab = "Round", ylab = "Share of experts agreeing"), list(...)) .axis_bounded(2, at = seq(0, 1, by = 0.25)) graphics::axis(1, at = seq_along(rounds), labels = rounds) threshold <- x$settings$consensus_threshold @@ -1360,9 +1360,9 @@ plot.contentvalid_delphi <- function(x, ys <- lapply(items, function(it) stab$value[stab$item == it]) unchanged <- lapply(items, function(it) stab$prop_unchanged[stab$item == it]) - graphics::plot(NA, xlim = c(1, max(pair_at) + right_pad * 0.12), ylim = ylim, - xaxt = "n", yaxt = "n", xlab = "Pair of rounds", - ylab = .delphi_axis_label(x$settings), ...) + .plot_with(list(x = NA, xlim = c(1, max(pair_at) + right_pad * 0.12), ylim = ylim, + xaxt = "n", yaxt = "n", xlab = "Pair of rounds", + ylab = .delphi_axis_label(x$settings)), list(...)) graphics::axis(1, at = ax$x_at, labels = ax$x_labels) # Ticks stop below the headroom kept for the legend. A chi-square keeps the # leading zero APA drops only for statistics that cannot exceed 1. diff --git a/R/earlier_methods.R b/R/earlier_methods.R index c24cc34..4d07943 100644 --- a/R/earlier_methods.R +++ b/R/earlier_methods.R @@ -28,7 +28,7 @@ .lawshe_count <- function(N) unname(.lawshe_minimum_count[as.character(N)]) -# Wilson, Pan and Schumsky (2012, Table 2): the normal approximation to the +# Wilson et al. (2012, Table 2): the normal approximation to the # binomial, z(1 - alpha) / sqrt(N) for a one-tailed test, with a value of 1 or # more listed as .99. .wilson_critical_cvr <- function(N, alpha) { @@ -50,7 +50,7 @@ }, integer(1)) } -# Yao, Wu and Yang (2008, p. 486): Psa and Csv both at least .30, chosen for a +# Yao et al. (2008, p. 486): Psa and Csv both at least .30, chosen for a # four-domain sort, where an item assigned at random reaches its domain with # probability .25. .yao_cut <- .30 @@ -296,7 +296,7 @@ } k <- em$n_constructs counted <- !isTRUE(em$constructs_given) - .say("Yao, Wu and Yang (2008): Psa and Csv both at least .30, set for a", + .say("Yao et al. (2008): Psa and Csv both at least .30, set for a", "four-domain sort where chance assignment is .25.") if (show_ext) { .say(paste0( diff --git a/R/expert_power.R b/R/expert_power.R index 95b57b9..c205806 100644 --- a/R/expert_power.R +++ b/R/expert_power.R @@ -261,9 +261,9 @@ plot.contentvalid_expert_power <- function(x, show_legend = TRUE, ...) { r <- x$results probs <- sort(unique(r$prob)) - graphics::plot(range(r$n_experts), c(0, 1), type = "n", yaxt = "n", - xlab = "Experts on the panel", - ylab = "Probability of clearing the criterion", ...) + .plot_with(list(x = range(r$n_experts), y = c(0, 1), type = "n", yaxt = "n", + xlab = "Experts on the panel", + ylab = "Probability of clearing the criterion"), list(...)) .axis_bounded(2, at = seq(0, 1, 0.25)) for (i in seq_along(probs)) { sub <- r[r$prob == probs[i], , drop = FALSE] diff --git a/R/expert_validity.R b/R/expert_validity.R index 148eb59..52f26a7 100644 --- a/R/expert_validity.R +++ b/R/expert_validity.R @@ -42,7 +42,8 @@ #' Provides a user-facing workflow for three common expert-panel tasks: #' #' * `mode = "relevance"`: bounded ordinal relevance ratings, combining Aiken's -#' V (with Penfield-Giacobbi score intervals), CVI/modified kappa, and a +#' V (with the score intervals of Penfield and Giacobbi, 2004), the CVI with +#' the modified kappa of Polit et al. (2007), and a #' panel-level agreement coefficient. #' * `mode = "essentiality"`: Lawshe CVR with exact binomial critical values. #' * `mode = "congruence"`: the index of item-objective congruence of @@ -92,8 +93,10 @@ #' interval uses the same `alpha` as Aiken's V. See `ci` in [cvi()] for the #' methods and the evidence for each. #' @param agreement Panel-level agreement coefficient for relevance mode: -#' `"krippendorff"` (default), `"ac1"`, or `"none"`. Krippendorff's alpha uses -#' the relevance ratings at `agreement_level`; Gwet's AC1 uses the +#' `"krippendorff"` (default), `"ac1"`, or `"none"`. Krippendorff's alpha +#' (Hayes & Krippendorff, 2007), which Zapf et al. (2016) recommend for +#' ordinal or incomplete ratings, uses the relevance ratings at +#' `agreement_level`; Gwet's AC1 uses the #' relevant/not-relevant decision. See [panel_agreement()] for the evidence #' behind each, including why AC1 is never the default. Panels with fewer #' than two experts or two items report no agreement coefficient. @@ -224,7 +227,7 @@ #' #' Zapf, A., Castell, S., Morawietz, L., & Karch, A. (2016). Measuring #' inter-rater reliability for nominal data: Which coefficients and confidence -#' intervals are appropriate? *BMC Medical Research Methodology, 16*, 93. +#' intervals are appropriate? *BMC Medical Research Methodology, 16*, Article 93. #' \doi{10.1186/s12874-016-0200-9} #' #' @examples @@ -291,7 +294,7 @@ expert_validity <- function(data, item$kappa_quality <- .kappa_quality(item$kappa_mod) item$ci_width <- item$ci_high - item$ci_low # Every count that meets the criterion gives modified kappa above .74, the - # band Polit, Beck, and Owen (2007) read as excellent: the lowest is .76, + # band Polit et al. (2007) read as excellent: the lowest is .76, # for 7 of 9. So an item that meets the criterion has strong support, and # no weaker tier can occur. item$recommendation <- ifelse( @@ -975,9 +978,13 @@ print.contentvalid_expert <- function(x, digits = 2, legacy = NULL, ...) { switch( x$mode, relevance = .print_key( - c("V", "I_CVI", "I_CVI_low/I_CVI_high", "kappa_mod", - if (show_agreement) "agreement"), - headings = c("V", "I-CVI", paste(ci, "after I-CVI"), "kappa", + c("S_CVI_Ave", "S_CVI_UA", "V", "I_CVI", "I_CVI_low/I_CVI_high", + "kappa_mod", + if (show_agreement) { + if (identical(x$settings$agreement, "ac1")) "agreement_ac1" else "agreement" + }), + headings = c("S-CVI/Ave", "S-CVI/UA", "V", "I-CVI", + paste(ci, "after I-CVI"), "kappa", if (show_agreement) "Panel agreement")), essentiality = .print_key("cvr", headings = "CVR"), .print_key("ioc", headings = "IOC") @@ -1128,7 +1135,7 @@ plot.contentvalid_expert <- function(x, show_legend = TRUE, hi = x$settings$hi, cut = x$settings$relevance_cut, criterion = if (length(crit) == 1L) crit else NULL, status = list(stats::setNames(r$status, r$item)), value_label = "I-CVI", - xlab = "Share of experts (left: below the relevance cut; right: relevant)", + axis_label = "Share of experts (left: below the relevance cut; right: relevant)", labels = labels, apa = apa, show_legend = show_legend, ... ) return(invisible(x)) @@ -1150,8 +1157,8 @@ plot.contentvalid_expert <- function(x, show_legend = TRUE, ci_label <- .ci_label(if (is.numeric(x$settings$alpha)) x$settings$alpha else 0.05) if (x$mode == "relevance") { - graphics::plot(NA, xlim = c(0, 1), ylim = c(0.5, n + 1.35), xaxt = "n", - yaxt = "n", xlab = "Relevance (0 to 1)", ylab = "", ...) + .plot_with(list(x = NA, xlim = c(0, 1), ylim = c(0.5, n + 1.35), xaxt = "n", + yaxt = "n", xlab = "Relevance (0 to 1)", ylab = ""), list(...)) .axis_bounded(1, at = seq(0, 1, 0.25)) graphics::axis(2, at = y, labels = r$item, las = 1) # The I-CVI criterion depends on the panel size, so it is drawn as a line @@ -1182,8 +1189,8 @@ plot.contentvalid_expert <- function(x, show_legend = TRUE, c(NA, NA, 1, if (one_crit) 2)) } } else if (x$mode == "essentiality") { - graphics::plot(NA, xlim = c(-1, 1), ylim = c(0.5, n + 1.35), xaxt = "n", - yaxt = "n", xlab = "CVR (-1 to 1)", ylab = "", ...) + .plot_with(list(x = NA, xlim = c(-1, 1), ylim = c(0.5, n + 1.35), xaxt = "n", + yaxt = "n", xlab = "CVR (-1 to 1)", ylab = ""), list(...)) .axis_bounded(1, at = seq(-1, 1, 0.5)) graphics::axis(2, at = y, labels = r$item, las = 1) .vline_below(0, 0.5, top) @@ -1205,9 +1212,9 @@ plot.contentvalid_expert <- function(x, show_legend = TRUE, # Each item's index against the criterion, with the experts' mean rating # on the target objective and on the closest other objective for context. cut <- x$settings$ioc_cut - graphics::plot(NA, xlim = c(-1, 1), ylim = c(0.5, n + 1.35), xaxt = "n", - yaxt = "n", xlab = "IOC and mean rating (-1 to 1)", - ylab = "", ...) + .plot_with(list(x = NA, xlim = c(-1, 1), ylim = c(0.5, n + 1.35), xaxt = "n", + yaxt = "n", xlab = "IOC and mean rating (-1 to 1)", + ylab = ""), list(...)) .axis_bounded(1, at = seq(-1, 1, 0.5)) graphics::axis(2, at = y, labels = r$item, las = 1) .vline_below(0, 0.5, top) diff --git a/R/glossary.R b/R/glossary.R index 5011daf..bc4a996 100644 --- a/R/glossary.R +++ b/R/glossary.R @@ -119,8 +119,8 @@ "rating at random. With small panels, chance agreement is substantial,", "which is why the raw I-CVI alone can overstate consensus." ), - range = paste("at most 1; below 0 when fewer experts agree than chance", - "predicts; higher is stronger"), + range = paste("at most 1; below 0 only when no expert, or one of three,", + "rated the item relevant; higher is stronger"), stringsAsFactors = FALSE ), data.frame( @@ -128,8 +128,9 @@ label = "Panel-level agreement", definition = paste( "One coefficient describing how consistently the whole panel rated the", - "item set: Krippendorff's alpha by default, or Gwet's AC1 if chosen. It", - "is separate from modified kappa, which describes one item at a time." + "item set: Krippendorff's alpha, the default (see agreement_ac1 for", + "Gwet's AC1). It is separate from modified kappa, which describes one", + "item at a time." ), range = paste( "1 is perfect agreement and 0 is agreement no better than chance; it can", @@ -137,6 +138,43 @@ ), stringsAsFactors = FALSE ), + data.frame( + term = "agreement_ac1", workflow = "expert-panel", + label = "Panel-level agreement (Gwet's AC1)", + definition = paste( + "One coefficient describing how consistently the whole panel made the", + "relevant/not-relevant decision, with chance agreement estimated so", + "that it stays small when nearly every rating falls in one category.", + "It is separate from modified kappa, which describes one item at a time." + ), + range = paste( + "1 is perfect agreement; 0 is agreement equal to AC1's own chance", + "estimate, which independent raters need not reach; it stays high when", + "nearly every rating is the same" + ), + stringsAsFactors = FALSE + ), + data.frame( + term = "S_CVI_Ave", workflow = "expert-panel", + label = "Scale-level CVI, averaging method", + definition = paste( + "The mean of the items' I-CVIs, the same quantity as the average", + "congruency percentage. Polit and Beck (2006) recommend .90 or higher." + ), + range = "0 to 1", + stringsAsFactors = FALSE + ), + data.frame( + term = "S_CVI_UA", workflow = "expert-panel", + label = "Scale-level CVI, universal agreement", + definition = paste( + "The share of items that every expert rated relevant. It falls as", + "experts are added, so Polit and Beck (2006) recommend reporting it", + "beside S-CVI/Ave." + ), + range = "0 to 1", + stringsAsFactors = FALSE + ), data.frame( term = "cvr", workflow = "expert-panel", label = "Lawshe's Content Validity Ratio", @@ -158,17 +196,30 @@ stringsAsFactors = FALSE ), data.frame( - term = "severity", workflow = "judge-heterogeneity", + term = "severity_raw", workflow = "judge-heterogeneity", label = "Judge severity", definition = paste( "How harsh or lenient a judge is compared with the panel, on the items", - "that judge rated. Positive means the judge rates lower than the panel.", - "Reported in logits from the facets model when it can be estimated,", - "otherwise in rating points." + "that judge rated, in rating points (`severity_raw` in `results`,", + "printed as severity). Positive means the judge rates lower than the", + "panel." ), range = "0 means typical of this panel", stringsAsFactors = FALSE ), + data.frame( + term = "severity", workflow = "judge-heterogeneity", + label = "Judge severity in logits", + definition = paste( + "Severity estimated by the many-facet Rasch model on the", + "relevant/not-relevant decision, against the judges the model placed", + "(`severity` in `results`, printed as logit), by default corrected for", + "the bias of joint maximum likelihood (`bias_correct`). Positive means", + "harsher. It can differ from the rating-point severity, even in sign." + ), + range = "0 means typical of the judges placed; flagged beyond the logit cut", + stringsAsFactors = FALSE + ), data.frame( term = "infit/outfit", workflow = "judge-heterogeneity", label = "Fit mean squares", @@ -300,7 +351,7 @@ "A significant result is read as stability. It needs expected counts", "of at least 5, which small panels rarely have." ), - range = "0 or more; read with its p-value", + range = "0 or more; read with its p value", stringsAsFactors = FALSE ), data.frame( @@ -312,7 +363,7 @@ "look stable because the test has little power, and experts swapping", "ratings go unseen." ), - range = "0 or more; read with its p-value", + range = "0 or more; read with its p value", stringsAsFactors = FALSE ), data.frame( @@ -344,11 +395,15 @@ I_CVI = "Share of experts rating the item relevant, against Lynn's criterion for the panel size (beyond ten, this package's).", `I_CVI_low/I_CVI_high` = "Wide because expert panels are small; the method is named above.", `psa_low/psa_high` = "Wider when fewer judges sorted the item; the method is named above.", - kappa_mod = "I-CVI corrected for chance agreement (at most 1; below 0 when agreement is below chance).", + kappa_mod = "I-CVI corrected for chance agreement (at most 1; below 0 only when no expert, or one of three, rated it relevant).", agreement = "One coefficient for the whole panel (1 is perfect, 0 is chance); it can be low when nearly every rating is the same.", + agreement_ac1 = "Panel agreement on the relevant/not-relevant decision (1 is perfect); not 0 for independent raters.", + S_CVI_Ave = "Mean of the items' I-CVIs; Polit and Beck (2006) recommend .90 or higher.", + S_CVI_UA = "Share of items every expert rated relevant; it falls as experts are added.", cvr = "Lean of the panel toward calling the item essential (-1 to 1; above 0 means more than half did).", ioc = "Whether experts matched the item to this objective and not to the others (-1 to 1; Rovinelli and Hambleton used .70).", - severity = "How much harsher (positive) or more lenient (negative) the judge is than the panel.", + severity_raw = "How much harsher (positive) or more lenient (negative) the judge is than the panel, in rating points.", + severity = "Severity on the relevant/not-relevant decision from the facets model; the flags use it when estimable.", `infit/outfit` = "How predictable the judge's decisions are: about 1 is expected, high is erratic, low is more predictable than expected.", differentiation = "Spread of the judge's ratings compared with a typical judge (1 is typical; low means few distinctions).", g_coefficient = "How well the ranking of items would reproduce with another panel of this size (0 to 1).", @@ -417,9 +472,9 @@ ), domain = c( Covered = "met the coverage criteria.", - "Thinly covered" = "fewer items than the minimum set.", - "Over-represented" = "a larger share of the items than expected.", - "Under-represented" = "a much smaller share of the items than its target calls for.", + "Thinly covered" = "fewer items than the minimum set for this analysis.", + "Over-represented" = "more than `over_factor` times its expected share of the items.", + "Under-represented" = "less than its target share divided by `over_factor`.", "Not covered" = "the blueprint includes it, but no item addresses it." ), stop("No decision meanings for workflow '", workflow, "'.", call. = FALSE) diff --git a/R/judge_validity.R b/R/judge_validity.R index 189e209..86b5e3d 100644 --- a/R/judge_validity.R +++ b/R/judge_validity.R @@ -675,8 +675,9 @@ print.contentvalid_judge <- function(x, digits = 2, ...) { .say(paste0( "mean: the judge's mean rating. severity: how far the judge rates below ", "the panel, in rating points (negative is more lenient)", - if (estimable) paste0("; logit: the same from the facets model, against ", - "the judges it placed, which the flags use") else "", + if (estimable) paste0("; logit: severity on the relevant/not-relevant ", + "decision from the facets model, against the ", + "judges it placed, which the flags use") else "", "." )) cat("\n") @@ -720,11 +721,11 @@ print.contentvalid_judge <- function(x, digits = 2, ...) { for (line in .fragile_items_notes(items)) .say(line) if (.show_key()) { - terms <- c("severity", "differentiation", "phi_coefficient") + terms <- c("severity_raw", "differentiation", "phi_coefficient") headings <- c("severity", "scale use", "Phi") if (estimable) { - terms <- append(terms, "infit/outfit", after = 1L) - headings <- append(headings, "infit, outfit", after = 1L) + terms <- append(terms, c("severity", "infit/outfit"), after = 1L) + headings <- append(headings, c("logit", "infit, outfit"), after = 1L) } .print_key(terms, headings = headings) .print_decision_legend(x$results$recommendation, "judge") diff --git a/R/panel_agreement.R b/R/panel_agreement.R index f4dc2ab..fda854b 100644 --- a/R/panel_agreement.R +++ b/R/panel_agreement.R @@ -90,7 +90,9 @@ #' Krippendorff, 2007); no publication applying it specifically to #' content-validity panels was found. #' * `"ac1"`: Gwet's (2008) AC1, designed for high-agreement data where -#' kappa-type coefficients fall. It is never the default: Vach and Gerke +#' kappa-type coefficients fall; Wongpakaran et al. (2013) found it less +#' affected than Cohen's kappa by how often each category is used. It is +#' never the default: Vach and Gerke #' (2023) show that it rises as ratings concentrate in one category even at a #' fixed level of agreement, and that it can be non-zero when raters are #' independent. Its printed output always repeats that critique. AC1 treats @@ -101,7 +103,8 @@ #' #' @section Why a close-agreeing panel can have a low alpha: #' Alpha compares observed disagreement with the disagreement expected if the -#' same ratings were assigned to items at random. When ratings cluster on a few +#' same ratings were assigned to items at random. Feinstein and Cicchetti +#' (1990) described the same paradox for kappa. When ratings cluster on a few #' values, as they do when nearly every item is rated relevant, very little #' disagreement is expected by chance, so even a few disagreements pull alpha #' down. The output reports the share of identical rating pairs alongside the @@ -152,18 +155,18 @@ #' \url{https://www.asc.upenn.edu/sites/default/files/2021-03/Computing\%20Krippendorff\%27s\%20Alpha-Reliability.pdf} #' #' Vach, W., & Gerke, O. (2023). Gwet's AC1 is not a substitute for Cohen's -#' kappa: A comparison of basic properties. *MethodsX, 10*, 102212. +#' kappa: A comparison of basic properties. *MethodsX, 10*, Article 102212. #' \doi{10.1016/j.mex.2023.102212} #' #' Wongpakaran, N., Wongpakaran, T., Wedding, D., & Gwet, K. L. (2013). A #' comparison of Cohen's kappa and Gwet's AC1 when calculating inter-rater #' reliability coefficients: A study conducted with personality disorder -#' samples. *BMC Medical Research Methodology, 13*, 61. +#' samples. *BMC Medical Research Methodology, 13*, Article 61. #' \doi{10.1186/1471-2288-13-61} #' #' Zapf, A., Castell, S., Morawietz, L., & Karch, A. (2016). Measuring #' inter-rater reliability for nominal data: Which coefficients and confidence -#' intervals are appropriate? *BMC Medical Research Methodology, 16*, 93. +#' intervals are appropriate? *BMC Medical Research Methodology, 16*, Article 93. #' \doi{10.1186/s12874-016-0200-9} #' #' @seealso [expert_validity()] for item-level expert-panel evidence. diff --git a/R/plot_distribution.R b/R/plot_distribution.R index 2564140..4f7a370 100644 --- a/R/plot_distribution.R +++ b/R/plot_distribution.R @@ -28,7 +28,7 @@ # `status`: a list parallel to `rounds` of named character vectors, item to # shared status, for the symbol beside each bar. .plot_rating_distribution <- function(rounds, items, lo, hi, cut, criterion, - status, value_label, xlab, labels, apa, + status, value_label, axis_label, labels, apa, show_legend, ...) { k <- as.integer(hi - lo + 1) cats <- seq(lo, hi) @@ -49,16 +49,26 @@ top <- n * step + 0.2 round_names <- names(rounds) + # The round labels and the right margin are reserved before the item + # labels are sized, so long names never crowd out the plot. + round_lines <- if (nr > 1L) 0.55 * max(nchar(round_names)) + 0.6 else 0 + lab <- .item_labels(items, reserve_in = (round_lines + 4.2) * + graphics::par("csi")) + dots <- list(...) + main <- dots$main mar <- graphics::par("mar") - mar[2] <- 1.2 + 0.62 * max(nchar(items)) + - if (nr > 1L) 0.55 * max(nchar(round_names)) + 0.6 else 0 - mar[3] <- if (isTRUE(show_legend)) 3.4 else 1.1 + mar[2] <- lab$lines + round_lines + mar[3] <- (if (isTRUE(show_legend)) 3.4 else 1.1) + if (length(main)) 1.6 else 0 mar[4] <- 4.2 op <- graphics::par(mar = mar) on.exit(graphics::par(op), add = TRUE) - graphics::plot(NA, xlim = c(-1, 1), ylim = c(0.4, top + 0.6), xaxt = "n", - yaxt = "n", xlab = xlab, ylab = "", bty = "n", ...) + # A title sits above the legend, and the item labels take the place of a + # y-axis label. + .plot_with(list(x = NA, xlim = c(-1, 1), ylim = c(0.4, top + 0.6), xaxt = "n", + yaxt = "n", xlab = axis_label, ylab = "", bty = "n"), dots, + protect = c("type", "xaxt", "yaxt", "axes", "main", "ylab")) + if (length(main)) graphics::title(main = main, line = mar[3] - 1.2) at <- seq(-1, 1, 0.25) graphics::axis(1, at = at, labels = .tick_labels(abs(at))) graphics::segments(0, 0.4, 0, top, col = "grey30") @@ -102,7 +112,7 @@ graphics::text(1.11, yc, .fmt(right), adj = 0, cex = 0.75, xpd = NA) } mid <- mean(c(ypos(i, 1), ypos(i, nr))) - graphics::axis(2, at = mid, labels = items[i], las = 1, tick = FALSE, + graphics::axis(2, at = mid, labels = lab$labels[i], las = 1, tick = FALSE, line = if (nr > 1L) 0.55 * max(nchar(round_names)) - 0.2 else -0.4) } # Drawn over the bars, so a bar that stops short of it can be seen to. diff --git a/R/plot_helpers.R b/R/plot_helpers.R index fd6ba89..be56bf0 100644 --- a/R/plot_helpers.R +++ b/R/plot_helpers.R @@ -17,6 +17,60 @@ graphics::par(mar = mar) } +# Draws a figure's frame from the method's own arguments, with any named +# argument the caller passed in `...` taking the place of the method's, so +# `xlab`, `xlim` or `main` never collide with it. Arguments the figure's +# encoding depends on (`protect`: the frame type, the axes the method draws +# itself, and on a map the decision symbols its legend keys) are kept as the +# method set them, and a NULL from the caller leaves the method's value. +# Unnamed arguments cannot be matched to anything and are dropped with a +# warning. +.plot_with <- function(args, dots, + protect = c("type", "xaxt", "yaxt", "axes"), + draw = graphics::plot) { + nm <- names(dots) + if (is.null(nm)) nm <- rep("", length(dots)) + if (any(!nzchar(nm))) { + warning("Unnamed arguments to plot() are ignored; name them, as in ", + "xlab = \"...\".", call. = FALSE) + } + named <- dots[nzchar(nm)] + named <- named[!names(named) %in% protect & + !vapply(named, is.null, logical(1))] + args[names(named)] <- named + do.call(draw, args) +} + +# Item labels for the left margin of a horizontal figure, and the margin they +# need, in lines. The labels are measured on the open device. A label wider +# than 40% of the width left for labels (`width_in` less `reserve_in`, in +# inches) is shortened in the middle with "...", keeping its start and end so +# that names sharing an opening stay apart; if shortened labels would still +# coincide, a number is added. +.item_labels <- function(items, width_in = graphics::par("fin")[1], + reserve_in = 0, base = 1.2) { + items <- as.character(items) + csi <- graphics::par("csi") + cap_in <- max(0.4 * (width_in - reserve_in), 4 * csi) + wide <- function(x) graphics::strwidth(x, units = "inches") + out <- items + for (i in which(wide(items) > cap_in)) { + full <- items[i] + keep <- nchar(full) + repeat { + keep <- keep - 1L + head <- ceiling(keep / 2) + label <- paste0(substr(full, 1L, head), "...", + substr(full, nchar(full) - (keep - head) + 1L, nchar(full))) + if (wide(label) <= cap_in || keep <= 4L) break + } + out[i] <- label + } + dup <- duplicated(out) | duplicated(out, fromLast = TRUE) + if (any(dup)) out[dup] <- paste0(out[dup], " (", which(dup), ")") + list(labels = out, lines = base + max(wide(out), 0) / csi) +} + # Tick labels in APA style for a bounded statistic: 0, .25, .50, .75, 1.00. .tick_labels <- function(at, digits = 2) { out <- formatC(at, format = "f", digits = digits) diff --git a/R/rating_indices.R b/R/rating_indices.R index 21d6126..763b9c1 100644 --- a/R/rating_indices.R +++ b/R/rating_indices.R @@ -1,8 +1,9 @@ #' Hinkin-Tracey correspondence (HTC) #' #' @description -#' Computes the Hinkin-Tracey correspondence index for each item. Following -#' Colquitt et al. (2019), HTC is the average definitional-correspondence rating +#' Computes the Hinkin-Tracey correspondence index for each item, named for +#' the rating task of Hinkin and Tracey (1999). Following Colquitt et al. +#' (2019), HTC is the average definitional-correspondence rating #' for the intended construct divided by `a`, the number of rating anchors. #' Ratings are internally shifted to a 1-to-`a` metric when a scale such as #' 0-to-4 is supplied, preserving the meaning of the published formula. @@ -74,8 +75,8 @@ htc <- function(ratings, #' Hinkin-Tracey distinctiveness (HTD) #' #' @description -#' Computes the Hinkin-Tracey distinctiveness index for each item in a fully -#' crossed, within-judge rating design. For every complete judge, the intended +#' Computes the Hinkin-Tracey distinctiveness index of Colquitt et al. (2019) +#' for each item in a fully crossed, within-judge rating design. For every complete judge, the intended #' construct rating is contrasted with each orbiting-construct rating. The #' average of those difference scores is divided by `a - 1`, where `a` is the #' number of rating anchors. HTD ranges from -1 to 1. diff --git a/R/rating_validity.R b/R/rating_validity.R index a223aae..4837aa8 100644 --- a/R/rating_validity.R +++ b/R/rating_validity.R @@ -651,10 +651,10 @@ plot.contentvalid_rating <- function(x, y <- r[[metric]] xs <- seq_along(y) lo <- if (metric == "htc") 0 else -1 - graphics::plot(xs, y, type = "n", xaxt = "n", yaxt = "n", xlab = "Item", - ylab = if (metric == "htc") htc_lab else htd_lab, - xlim = c(0.5, length(y) + 0.5), - ylim = c(lo, 1 + 0.2 * (1 - lo)), ...) + .plot_with(list(x = xs, y = y, type = "n", xaxt = "n", yaxt = "n", xlab = "Item", + ylab = if (metric == "htc") htc_lab else htd_lab, + xlim = c(0.5, length(y) + 0.5), + ylim = c(lo, 1 + 0.2 * (1 - lo))), list(...)) graphics::axis(1, at = xs, labels = r$item, las = 2) .axis_bounded(2, at = if (metric == "htc") seq(0, 1, 0.25) else seq(-1, 1, 0.5)) if (metric == "htd") .hline(0) @@ -670,9 +670,10 @@ plot.contentvalid_rating <- function(x, if (type == "map") { ok <- is.finite(r$htc) & is.finite(r$htd) - graphics::plot(r$htc[ok], r$htd[ok], xlim = c(0, 1), ylim = c(-1, 1.4), - xaxt = "n", yaxt = "n", xlab = htc_lab, ylab = htd_lab, - pch = pch[ok], ...) + .plot_with(list(x = r$htc[ok], y = r$htd[ok], xlim = c(0, 1), ylim = c(-1, 1.4), + xaxt = "n", yaxt = "n", xlab = htc_lab, ylab = htd_lab, + pch = pch[ok]), list(...), + protect = c("type", "xaxt", "yaxt", "axes", "pch")) .axis_bounded(1, at = seq(0, 1, 0.25)) .axis_bounded(2, at = seq(-1, 1, 0.5)) .hline(0) @@ -712,9 +713,9 @@ plot.contentvalid_rating <- function(x, xlim <- c(x$settings$scale_min, x$settings$scale_max) # A key of five entries takes two rows, and the headroom to hold them. two_rows <- length(lay$legend) > 4L - graphics::plot(NA, xlim = xlim, - ylim = c(0.5, n + if (two_rows) 1.7 else 1.25), yaxt = "n", - xlab = "Mean rating against each definition", ylab = "", ...) + .plot_with(list(x = NA, xlim = xlim, + ylim = c(0.5, n + if (two_rows) 1.7 else 1.25), yaxt = "n", + xlab = "Mean rating against each definition", ylab = ""), list(...)) graphics::axis(2, at = y, labels = r$item, las = 1) both <- lay$both if (any(both)) { diff --git a/R/reporting.R b/R/reporting.R index 0f020ae..14851a0 100644 --- a/R/reporting.R +++ b/R/reporting.R @@ -217,17 +217,42 @@ as.data.frame.contentvalid_workflow <- function(x, spec <- .report_spec(x) cols <- list() headings <- character(0) + is_ci <- logical(0) for (entry in spec) { if (!all(entry$cols %in% names(res))) next if (nrow(res) && all(is.na(res[[entry$cols[1]]]))) next cols[[length(cols) + 1L]] <- .report_cells(res, entry, digits) headings <- c(headings, entry$heading) + is_ci <- c(is_ci, identical(entry$type, "ci")) } + # An interval is named after its estimate in the object ("V 95% CI", + # "I-CVI 95% CI"), whatever else the table holds, while the printed table + # and the Markdown head it "95% CI", beside that estimate. The map from + # name to printed heading is kept, so a column the user renames prints + # under the new name. + names_out <- headings + at <- which(is_ci & seq_along(headings) > 1L) + names_out[at] <- paste(headings[at - 1L], headings[at]) tab <- as.data.frame(cols, stringsAsFactors = FALSE) - names(tab) <- headings + names(tab) <- names_out + if (length(at)) attr(tab, "display") <- stats::setNames(headings[at], names_out[at]) tab } +# The headings a reader sees: an interval named after its estimate is +# printed under its shared heading, unless the user renamed it. +.report_display <- function(tab) { + map <- attr(tab, "display") + out <- as.data.frame(tab) + if (length(map)) { + nm <- names(out) + hit <- nm %in% names(map) + nm[hit] <- map[nm[hit]] + names(out) <- nm + } + out +} + #' Build a manuscript-ready results table #' #' @description @@ -252,7 +277,9 @@ as.data.frame.contentvalid_workflow <- function(x, #' @param caption Optional caption line placed above a Markdown table. #' #' @return For `"apa"`, a data frame of character columns that prints without -#' row names; `as.data.frame()` drops its print class. For `"data.frame"`, a +#' row names; `as.data.frame()` drops its print class. An interval column is +#' named after its estimate (`V 95% CI`, `I-CVI 95% CI`) and printed under +#' the shared heading `95% CI`. For `"data.frame"`, a #' plain data frame with `recommendation` and `status` columns. For #' `"markdown"`, a character vector of Markdown lines that prints as the #' table, carrying the analysis provenance as its `"settings"` attribute. @@ -316,7 +343,7 @@ content_report <- function(x, lines <- c(lines, if (!nrow(tab)) { "_No units matched the requested selection._" } else { - .as_markdown_table(tab) + .as_markdown_table(.report_display(tab)) }) attr(lines, "settings") <- x$settings class(lines) <- "contentvalid_markdown" @@ -350,7 +377,7 @@ print.contentvalid_report <- function(x, ...) { if (!nrow(x)) { cat("No units matched the requested selection.\n") } else { - .print_table(as.data.frame(x)) + .print_table(.report_display(x)) } invisible(x) } @@ -358,6 +385,7 @@ print.contentvalid_report <- function(x, ...) { #' @export as.data.frame.contentvalid_report <- function(x, ...) { class(x) <- "data.frame" + attr(x, "display") <- NULL x } diff --git a/R/sim_helpers.R b/R/sim_helpers.R index 04c29cc..356f116 100644 --- a/R/sim_helpers.R +++ b/R/sim_helpers.R @@ -1,6 +1,9 @@ #' Legacy simulation of item-sort target-count power #' -#' @description Auxiliary compatibility helper. For supported exact planning, prefer [sort_power()], which does not require Monte Carlo simulation. +#' @description Auxiliary compatibility helper. It estimates by simulation the +#' power of the exact target-count test of Howard and Melloy (2016). For +#' supported exact planning, prefer [sort_power()], which does not require +#' Monte Carlo simulation. #' @param N Number of judges per item. #' @param true_p True assignment probability to the target construct. #' @param reps Number of simulation replications. diff --git a/R/sort_power.R b/R/sort_power.R index 8a83f1c..3b6d5fc 100644 --- a/R/sort_power.R +++ b/R/sort_power.R @@ -1,8 +1,8 @@ #' Exact power for the item-sort target-count rule #' #' @description -#' Computes the exact probability that an item will meet the Howard-Melloy -#' target-count criterion for a planned judge sample size and an assumed true +#' Computes the exact probability that an item will meet the target-count +#' criterion of Howard and Melloy (2016) for a planned judge sample size and an assumed true #' target-assignment probability. This is a binomial calculation, not a #' simulation. #' @@ -139,9 +139,9 @@ plot.contentvalid_sort_power <- function(x, p0 = x$settings$p0, alpha = x$settings$alpha ) - graphics::plot(curve$N, curve$minimum_observed_psa, type = "s", ylim = c(0, 1), - yaxt = "n", xlab = "Judges (N)", - ylab = "Minimum Psa for retention", ...) + .plot_with(list(x = curve$N, y = curve$minimum_observed_psa, type = "s", ylim = c(0, 1), + yaxt = "n", xlab = "Judges (N)", + ylab = "Minimum Psa for retention"), list(...)) .axis_bounded(2, at = seq(0, 1, 0.25)) graphics::points(requested$N, requested$minimum_observed_psa, pch = 1) return(invisible(x)) @@ -156,8 +156,8 @@ plot.contentvalid_sort_power <- function(x, } xr <- range(tab$N) if (diff(xr) == 0) xr <- xr + c(-0.5, 0.5) - graphics::plot(xr, c(0, 1), type = "n", yaxt = "n", - xlab = "Judges (N)", ylab = "Exact retention power", ...) + .plot_with(list(x = xr, y = c(0, 1), type = "n", yaxt = "n", + xlab = "Judges (N)", ylab = "Exact retention power"), list(...)) .axis_bounded(2, at = seq(0, 1, 0.25)) if (!is.null(reference_power)) graphics::abline(h = reference_power, lty = 3) for (i in seq_along(ps)) { diff --git a/R/sort_validity.R b/R/sort_validity.R index 7e0b5b6..baae545 100644 --- a/R/sort_validity.R +++ b/R/sort_validity.R @@ -193,7 +193,7 @@ #' judges spread across several constructs, the leading rival's count falls, #' so Csv can reach the critical value with fewer target assignments than #' the exact test requires. That is why it is not used for the decision. -#' * **Yao, Wu and Yang (2008)** required Psa and Csv both to reach .30, which +#' * **Yao et al. (2008)** required Psa and Csv both to reach .30, which #' they chose for a four-domain sort, where an item assigned at random lands #' in its domain with probability .25 (p. 486). They give no rule for other #' numbers of domains. @@ -638,10 +638,10 @@ plot.contentvalid_sort <- function(x, xs <- seq_along(y) lo <- if (metric == "psa") 0 else -1 # Headroom above 1 holds the legend, clear of the data. - graphics::plot(xs, y, type = "n", xaxt = "n", yaxt = "n", xlab = "Item", - ylab = if (metric == "psa") psa_lab else csv_lab, - xlim = c(0.5, length(y) + 0.5), - ylim = c(lo, 1 + 0.2 * (1 - lo)), ...) + .plot_with(list(x = xs, y = y, type = "n", xaxt = "n", yaxt = "n", xlab = "Item", + ylab = if (metric == "psa") psa_lab else csv_lab, + xlim = c(0.5, length(y) + 0.5), + ylim = c(lo, 1 + 0.2 * (1 - lo))), list(...)) graphics::axis(1, at = xs, labels = r$item, las = 2) .axis_bounded(2, at = if (metric == "psa") seq(0, 1, 0.25) else seq(-1, 1, 0.5)) leg <- .decision_legend(r$recommendation) @@ -677,9 +677,10 @@ plot.contentvalid_sort <- function(x, } ok <- is.finite(r$psa) & is.finite(r$csv) - graphics::plot(r$psa[ok], r$csv[ok], xlim = c(0, 1), ylim = c(-1, 1.4), - xaxt = "n", yaxt = "n", xlab = psa_lab, ylab = csv_lab, - pch = pch[ok], ...) + .plot_with(list(x = r$psa[ok], y = r$csv[ok], xlim = c(0, 1), ylim = c(-1, 1.4), + xaxt = "n", yaxt = "n", xlab = psa_lab, ylab = csv_lab, + pch = pch[ok]), list(...), + protect = c("type", "xaxt", "yaxt", "axes", "pch")) .axis_bounded(1, at = seq(0, 1, 0.25)) .axis_bounded(2, at = seq(-1, 1, 0.5)) .hline(0) diff --git a/README.Rmd b/README.Rmd index ba2f55a..f30951b 100644 --- a/README.Rmd +++ b/README.Rmd @@ -201,7 +201,7 @@ Works cited in this README, the help pages, and the vignettes. - Heiberger, R. M., & Robbins, N. B. (2014). Design of diverging stacked bar charts for Likert scales and other applications. *Journal of Statistical Software, 57*(5), 1–32. https://doi.org/10.18637/jss.v057.i05 - Hernández-Nieto, R. (2002). *Contributions to statistical analysis: The coefficients of proportional variance, content validity and kappa*. BookSurge. - Hinkin, T. R., & Tracey, J. B. (1999). An analysis of variance approach to content validation. *Organizational Research Methods, 2*(2), 175–186. https://doi.org/10.1177/109442819922004 -- Holey, E. A., Feeley, J. L., Dixon, J., & Whittaker, V. J. (2007). An exploration of the use of simple statistics to measure consensus and stability in Delphi studies. *BMC Medical Research Methodology, 7*, 52. https://doi.org/10.1186/1471-2288-7-52 +- Holey, E. A., Feeley, J. L., Dixon, J., & Whittaker, V. J. (2007). An exploration of the use of simple statistics to measure consensus and stability in Delphi studies. *BMC Medical Research Methodology, 7*, Article 52. https://doi.org/10.1186/1471-2288-7-52 - Horn, J. L. (1965). A rationale and test for the number of factors in factor analysis. *Psychometrika, 30*(2), 179–185. https://doi.org/10.1007/BF02289447 - Howard, M. C., & Melloy, R. C. (2016). Evaluating item-sort task methods: The presentation of a new statistical significance formula and methodological best practices. *Journal of Business and Psychology, 31*(1), 173–186. https://doi.org/10.1007/s10869-015-9404-y - Hubert, L., & Arabie, P. (1985). Comparing partitions. *Journal of Classification, 2*(1), 193–218. https://doi.org/10.1007/BF01908075 @@ -228,14 +228,14 @@ Works cited in this README, the help pages, and the vignettes. - Sireci, S. G., & Geisinger, K. F. (1992). Analyzing test content using cluster analysis and multidimensional scaling. *Applied Psychological Measurement, 16*(1), 17–31. https://doi.org/10.1177/014662169201600102 - Sireci, S. G., & Geisinger, K. F. (1995). Using subject-matter experts to assess content representation: An MDS analysis. *Applied Psychological Measurement, 19*(3), 241–255. https://doi.org/10.1177/014662169501900303 - Turner, R. C., & Carlson, L. (2003). Indexes of item-objective congruence for multidimensional items. *International Journal of Testing, 3*(2), 163–171. https://doi.org/10.1207/S15327574IJT0302_5 -- Vach, W., & Gerke, O. (2023). Gwet's AC1 is not a substitute for Cohen's kappa: A comparison of basic properties. *MethodsX, 10*, 102212. https://doi.org/10.1016/j.mex.2023.102212 +- Vach, W., & Gerke, O. (2023). Gwet's AC1 is not a substitute for Cohen's kappa: A comparison of basic properties. *MethodsX, 10*, Article 102212. https://doi.org/10.1016/j.mex.2023.102212 - Wilson, E. B. (1927). Probable inference, the law of succession, and statistical inference. *Journal of the American Statistical Association, 22*(158), 209–212. https://doi.org/10.1080/01621459.1927.10502953 - Wilson, F. R., Pan, W., & Schumsky, D. A. (2012). Recalculation of the critical values for Lawshe's content validity ratio. *Measurement and Evaluation in Counseling and Development, 45*(3), 197–210. https://doi.org/10.1177/0748175612440286 -- Wongpakaran, N., Wongpakaran, T., Wedding, D., & Gwet, K. L. (2013). A comparison of Cohen's kappa and Gwet's AC1 when calculating inter-rater reliability coefficients: A study conducted with personality disorder samples. *BMC Medical Research Methodology, 13*, 61. https://doi.org/10.1186/1471-2288-13-61 +- Wongpakaran, N., Wongpakaran, T., Wedding, D., & Gwet, K. L. (2013). A comparison of Cohen's kappa and Gwet's AC1 when calculating inter-rater reliability coefficients: A study conducted with personality disorder samples. *BMC Medical Research Methodology, 13*, Article 61. https://doi.org/10.1186/1471-2288-13-61 - Wright, B. D. (1988). The efficacy of unconditional maximum likelihood bias correction: Comment on Jansen, van den Wollenberg, and Wierda. *Applied Psychological Measurement, 12*(3), 315–318. https://doi.org/10.1177/014662168801200309 - Wright, B. D., & Douglas, G. A. (1977). Best procedures for sample-free item analysis. *Applied Psychological Measurement, 1*(2), 281–295. https://doi.org/10.1177/014662167700100216 - Yao, G., Wu, C.-H., & Yang, C.-T. (2008). Examining the content validity of the WHOQOL-BREF from respondents' perspective by quantitative methods. *Social Indicators Research, 85*(3), 483–498. https://doi.org/10.1007/s11205-007-9112-8 -- Zapf, A., Castell, S., Morawietz, L., & Karch, A. (2016). Measuring inter-rater reliability for nominal data: Which coefficients and confidence intervals are appropriate? *BMC Medical Research Methodology, 16*, 93. https://doi.org/10.1186/s12874-016-0200-9 +- Zapf, A., Castell, S., Morawietz, L., & Karch, A. (2016). Measuring inter-rater reliability for nominal data: Which coefficients and confidence intervals are appropriate? *BMC Medical Research Methodology, 16*, Article 93. https://doi.org/10.1186/s12874-016-0200-9 - Zwick, W. R., & Velicer, W. F. (1986). Comparison of five rules for determining the number of components to retain. *Psychological Bulletin, 99*(3), 432–442. https://doi.org/10.1037/0033-2909.99.3.432 ## License diff --git a/README.md b/README.md index 204d3b0..5ce7c69 100644 --- a/README.md +++ b/README.md @@ -427,8 +427,8 @@ Works cited in this README, the help pages, and the vignettes. 2*(2), 175–186. - Holey, E. A., Feeley, J. L., Dixon, J., & Whittaker, V. J. (2007). An exploration of the use of simple statistics to measure consensus and - stability in Delphi studies. *BMC Medical Research Methodology, - 7*, 52. + stability in Delphi studies. *BMC Medical Research Methodology, 7*, + Article 52. - Horn, J. L. (1965). A rationale and test for the number of factors in factor analysis. *Psychometrika, 30*(2), 179–185. @@ -525,8 +525,8 @@ Works cited in this README, the help pages, and the vignettes. congruence for multidimensional items. *International Journal of Testing, 3*(2), 163–171. - Vach, W., & Gerke, O. (2023). Gwet’s AC1 is not a substitute for - Cohen’s kappa: A comparison of basic properties. *MethodsX, - 10*, 102212. + Cohen’s kappa: A comparison of basic properties. *MethodsX, 10*, + Article 102212. - Wilson, E. B. (1927). Probable inference, the law of succession, and statistical inference. *Journal of the American Statistical Association, 22*(158), 209–212. @@ -538,8 +538,8 @@ Works cited in this README, the help pages, and the vignettes. - Wongpakaran, N., Wongpakaran, T., Wedding, D., & Gwet, K. L. (2013). A comparison of Cohen’s kappa and Gwet’s AC1 when calculating inter-rater reliability coefficients: A study conducted with - personality disorder samples. *BMC Medical Research Methodology, - 13*, 61. + personality disorder samples. *BMC Medical Research Methodology, 13*, + Article 61. - Wright, B. D. (1988). The efficacy of unconditional maximum likelihood bias correction: Comment on Jansen, van den Wollenberg, and Wierda. *Applied Psychological Measurement, 12*(3), 315–318. @@ -554,7 +554,8 @@ Works cited in this README, the help pages, and the vignettes. - Zapf, A., Castell, S., Morawietz, L., & Karch, A. (2016). Measuring inter-rater reliability for nominal data: Which coefficients and confidence intervals are appropriate? *BMC Medical Research - Methodology, 16*, 93. + Methodology, 16*, Article 93. + - Zwick, W. R., & Velicer, W. F. (1986). Comparison of five rules for determining the number of components to retain. *Psychological Bulletin, 99*(3), 432–442. diff --git a/_pkgdown.yml b/_pkgdown.yml index 484b7f6..4271899 100644 --- a/_pkgdown.yml +++ b/_pkgdown.yml @@ -36,6 +36,7 @@ reference: contents: - contentvalid_glossary - as.data.frame.contentvalid_workflow + - contentvalid-data-frames - content_report - content_handoff - content_evidence diff --git a/man/aikens_v.Rd b/man/aikens_v.Rd index 45778f0..e9ec0fd 100644 --- a/man/aikens_v.Rd +++ b/man/aikens_v.Rd @@ -45,9 +45,9 @@ It prints as a formatted table in APA style; the values themselves are unrounded, and \code{as.data.frame()} returns the plain data frame. } \description{ -Computes Aiken's V per item for bounded ordinal expert ratings. By default, -confidence intervals use the score method described by Penfield and -Giacobbi (2004). Percentile bootstrap intervals remain available for +Computes Aiken's (1980) V per item for bounded ordinal expert ratings. By +default, confidence intervals use the score method described by Penfield +and Giacobbi (2004). Percentile bootstrap intervals remain available for compatibility and sensitivity analysis. } \examples{ diff --git a/man/compute_psa.Rd b/man/compute_psa.Rd index 87910f1..ae6e561 100644 --- a/man/compute_psa.Rd +++ b/man/compute_psa.Rd @@ -20,8 +20,11 @@ compute_psa( \item{item_col, rater_col, assigned_col, target_col}{Column names for the item, rater, assigned construct, and intended target construct.} -\item{ci}{Interval method for Psa: \code{"wilson"} (default), \code{"agresti_coull"}, -\code{"exact"}, or \code{"none"}. The methods and the evidence for each are described +\item{ci}{Interval method for Psa: \code{"wilson"} (default), the score interval +of Wilson (1927); \code{"agresti_coull"}, the adjusted Wald interval of Agresti +and Coull (1998); \code{"exact"}, the Clopper and Pearson (1934) interval; or +\code{"none"}. Newcombe (1998) compared seven methods and recommends score +intervals over the Wald interval; the evidence for each is described under \code{ci} in \code{\link[=cvi]{cvi()}}.} \item{alpha}{Two-sided alpha level for the interval; \code{0.05} gives a 95\% diff --git a/man/content_handoff.Rd b/man/content_handoff.Rd index 9f91208..52d54f8 100644 --- a/man/content_handoff.Rd +++ b/man/content_handoff.Rd @@ -241,7 +241,7 @@ interval by default. The four columns are \code{NA} together when a statistic has no interval. That happens when the method defines none (Csv, HTC, HTD, CVR, the essential -count, modified kappa, IOC, and p-values), when intervals were switched off +count, modified kappa, IOC, and p values), when intervals were switched off with \code{proportion_ci = "none"}, or when the statistic itself could not be computed. \code{NA} there never stands for missing data. diff --git a/man/content_report.Rd b/man/content_report.Rd index b082e1a..839dc0c 100644 --- a/man/content_report.Rd +++ b/man/content_report.Rd @@ -30,7 +30,9 @@ status is not \code{Supported}.} } \value{ For \code{"apa"}, a data frame of character columns that prints without -row names; \code{as.data.frame()} drops its print class. For \code{"data.frame"}, a +row names; \code{as.data.frame()} drops its print class. An interval column is +named after its estimate (\verb{V 95\% CI}, \verb{I-CVI 95\% CI}) and printed under +the shared heading \verb{95\% CI}. For \code{"data.frame"}, a plain data frame with \code{recommendation} and \code{status} columns. For \code{"markdown"}, a character vector of Markdown lines that prints as the table, carrying the analysis provenance as its \code{"settings"} attribute. diff --git a/man/contentvalid-data-frames.Rd b/man/contentvalid-data-frames.Rd new file mode 100644 index 0000000..150286f --- /dev/null +++ b/man/contentvalid-data-frames.Rd @@ -0,0 +1,83 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/as_data_frame.R +\name{contentvalid-data-frames} +\alias{contentvalid-data-frames} +\alias{as.data.frame.contentvalid_cvi} +\alias{as.data.frame.contentvalid_gtheory} +\alias{as.data.frame.contentvalid_structure} +\alias{as.data.frame.contentvalid_rounds} +\alias{as.data.frame.contentvalid_handoff} +\alias{as.data.frame.contentvalid_sort_power} +\alias{as.data.frame.contentvalid_expert_power} +\alias{as.data.frame.contentvalid_agreement} +\alias{as.data.frame.contentvalid_binom} +\alias{as.data.frame.contentvalid_signal} +\alias{as.data.frame.contentvalid_reproducibility} +\title{Tables from contentvalidR results} +\usage{ +\method{as.data.frame}{contentvalid_cvi}(x, row.names = NULL, optional = FALSE, component = NULL, ...) + +\method{as.data.frame}{contentvalid_gtheory}(x, row.names = NULL, optional = FALSE, component = NULL, ...) + +\method{as.data.frame}{contentvalid_structure}(x, row.names = NULL, optional = FALSE, component = NULL, ...) + +\method{as.data.frame}{contentvalid_rounds}(x, row.names = NULL, optional = FALSE, component = NULL, ...) + +\method{as.data.frame}{contentvalid_handoff}(x, row.names = NULL, optional = FALSE, component = NULL, ...) + +\method{as.data.frame}{contentvalid_sort_power}(x, row.names = NULL, optional = FALSE, ...) + +\method{as.data.frame}{contentvalid_expert_power}(x, row.names = NULL, optional = FALSE, ...) + +\method{as.data.frame}{contentvalid_agreement}(x, row.names = NULL, optional = FALSE, ...) + +\method{as.data.frame}{contentvalid_binom}(x, row.names = NULL, optional = FALSE, ...) + +\method{as.data.frame}{contentvalid_signal}(x, row.names = NULL, optional = FALSE, ...) + +\method{as.data.frame}{contentvalid_reproducibility}(x, row.names = NULL, optional = FALSE, ...) +} +\arguments{ +\item{x}{A contentvalidR result.} + +\item{row.names, optional}{Accepted for compatibility with +\code{\link[base:as.data.frame]{base::as.data.frame()}} and ignored.} + +\item{component}{The table to return, where a result holds more than one +(\code{NULL}, the default, gives the first listed): +\itemize{ +\item \code{\link[=cvi]{cvi()}}: \code{"item_level"} (default) or \code{"scale_level"}. +\item \code{\link[=gtheory_content]{gtheory_content()}}: \code{"variance_components"} (default), +\code{"coefficients"}, \code{"dstudy"}, or \code{"judges_needed"}. +\item \code{\link[=content_structure]{content_structure()}}: \code{"items"} (default; each item's cluster, +blueprint cell and coordinates), \code{"fit"}, or \code{"cross_tab"}. +\item \code{\link[=compare_rounds]{compare_rounds()}}: \code{"transitions"} (default), \code{"summary"}, or +\code{"settings_changes"}. +\item \code{\link[=content_handoff]{content_handoff()}}: \code{"item_evidence"} (default), \code{"item_statistics"}, +or \code{"panel_statistics"}. +}} + +\item{...}{Not used.} +} +\value{ +A data frame. \code{\link[=csv_binom_test]{csv_binom_test()}}, \code{\link[=signal_detection]{signal_detection()}}, +\code{\link[=reproducibility_phi]{reproducibility_phi()}} and \code{\link[=panel_agreement]{panel_agreement()}} give one row: an +interval becomes two columns, and a two-by-two table becomes its four +counts. For \code{\link[=panel_agreement]{panel_agreement()}} the interval's error rate is \code{ci_alpha}, +since \code{alpha} would read as Krippendorff's; for \code{\link[=csv_binom_test]{csv_binom_test()}} the +one-sided interval is marked by \code{ci_sides} and \code{ci_level}. +} +\description{ +\code{as.data.frame()} returns a result's table as an ordinary data frame, for +filtering, joining, or writing to a file. A result that holds several +tables returns the one named by \code{component}; a single test returns one row. +Fitted workflows have their own method, +\code{\link[=as.data.frame.contentvalid_workflow]{as.data.frame.contentvalid_workflow()}}. +} +\examples{ +R <- matrix(c(4, 3, 4, 4, 3, 4, 2, 3, 4, 4, 3, 2), 6, + dimnames = list(NULL, c("I1", "I2"))) +as.data.frame(cvi(R >= 3)) +as.data.frame(cvi(R >= 3), component = "scale_level") +as.data.frame(csv_binom_test(16, 20)) +} diff --git a/man/contentvalidR-package.Rd b/man/contentvalidR-package.Rd index 742e650..bdd60a1 100644 --- a/man/contentvalidR-package.Rd +++ b/man/contentvalidR-package.Rd @@ -6,7 +6,7 @@ \alias{contentvalidR-package} \title{contentvalidR: Tools for Substantive and Content Validity Pretesting} \description{ -Provides quantitative tools for substantive and content-oriented scale pretesting. Implements item-sort indices from Anderson and Gerbing (1991) \doi{10.1037/0021-9010.76.5.732}, exact item-sort inference following Howard and Melloy (2016) \doi{10.1007/s10869-015-9404-y}, empirical interpretation benchmarks from Colquitt et al. (2019) \doi{10.1037/apl0000406}, and the construct-rating procedure of Hinkin and Tracey (1999) \doi{10.1177/109442819922004} with HTC/HTD indices and repeated-measures item screening. The expert-panel workflow combines Aiken's V with score confidence intervals, Lawshe content validity ratios with exact inference, content validity indices with modified kappa and score intervals, item-objective congruence, and panel-level agreement using Krippendorff's alpha as described by Hayes and Krippendorff (2007) \doi{10.1080/19312450709336664}. Also provides judge and rater heterogeneity analysis following the generalizability-theory treatment of content-validity ratings in Crocker, Llabre and Miller (1988) \doi{10.1111/j.1745-3984.1988.tb00309.x}, content-domain coverage and expert-perceived content structure following Sireci and Geisinger (1992) \doi{10.1177/014662169201600102}, consensus and stability across Delphi rounds with between-round weighted kappa following Holey et al. (2007) \doi{10.1186/1471-2288-7-52}, comparison across successive pretest rounds, and exact expert-panel planning. Where published methods compete, users choose among them through arguments with evidence-based defaults. User-facing workflows emphasize interpretable summaries and transparent review recommendations rather than isolated coefficients. +Provides quantitative tools for substantive and content-oriented scale pretesting. Implements item-sort indices from Anderson and Gerbing (1991) \doi{10.1037/0021-9010.76.5.732}, exact item-sort inference following Howard and Melloy (2016) \doi{10.1007/s10869-015-9404-y}, empirical interpretation benchmarks from Colquitt et al. (2019) \doi{10.1037/apl0000406}, and the construct-rating procedure of Hinkin and Tracey (1999) \doi{10.1177/109442819922004} with HTC/HTD indices and repeated-measures item screening. The expert-panel workflow combines Aiken's V with score confidence intervals, Lawshe content validity ratios with exact inference, content validity indices with modified kappa and score intervals, item-objective congruence, and panel-level agreement using Krippendorff's alpha as described by Hayes and Krippendorff (2007) \doi{10.1080/19312450709336664}. Also provides judge and rater heterogeneity analysis following the generalizability-theory treatment of content-validity ratings in Crocker et al. (1988) \doi{10.1111/j.1745-3984.1988.tb00309.x}, content-domain coverage and expert-perceived content structure following Sireci and Geisinger (1992) \doi{10.1177/014662169201600102}, consensus and stability across Delphi rounds with between-round weighted kappa following Holey et al. (2007) \doi{10.1186/1471-2288-7-52}, comparison across successive pretest rounds, and exact expert-panel planning. Where published methods compete, users choose among them through arguments with evidence-based defaults. User-facing workflows emphasize interpretable summaries and transparent review recommendations rather than isolated coefficients. } \section{What you can rely on}{ @@ -19,8 +19,11 @@ The public API is in three tiers. \strong{Tier 1, the recommended workflows.} \code{\link[=sort_validity]{sort_validity()}}, \code{\link[=rating_validity]{rating_validity()}}, \code{\link[=expert_validity]{expert_validity()}}, \code{\link[=delphi_validity]{delphi_validity()}}, -\code{\link[=judge_validity]{judge_validity()}}, and \code{\link[=domain_validity]{domain_validity()}}; their \code{print()}, \code{summary()}, -and \code{plot()} methods; the object contract they share (\code{results}, +\code{\link[=judge_validity]{judge_validity()}}, and \code{\link[=domain_validity]{domain_validity()}}; their \code{print()} and +\code{summary()} methods, and the \code{plot()} methods of the first four (when +similarity data were supplied, a domain fit's content map is drawn with +\code{plot(fit$details$structure)}); the object +contract they share (\code{results}, \code{scale_summary}, \code{settings}, \code{design}, \code{details}); the shared status vocabulary (\code{Supported}, \code{Review}, \verb{Insufficient data}, \verb{Descriptive only}); and \code{\link[=content_handoff]{content_handoff()}}, \code{\link[=content_evidence]{content_evidence()}}, \code{\link[=content_report]{content_report()}}, \code{\link[=compare_rounds]{compare_rounds()}}, \code{\link[=as.data.frame.contentvalid_workflow]{as.data.frame.contentvalid_workflow()}}, and diff --git a/man/cvi.Rd b/man/cvi.Rd index 1134ef5..8345a96 100644 --- a/man/cvi.Rd +++ b/man/cvi.Rd @@ -48,7 +48,7 @@ A classed list with: \description{ Computes item-level Content Validity Index (I-CVI), scale-level average CVI (S-CVI/Ave), universal-agreement CVI (S-CVI/UA), and the modified kappa -described by Polit, Beck, and Owen (2007). +described by Polit et al. (2007). The I-CVI is the proportion of experts rating an item 3 or 4 on a 4-point relevance scale (Lynn, 1986). Polit and Beck (2006) named the two diff --git a/man/expert_validity.Rd b/man/expert_validity.Rd index 12df44e..49bb7f5 100644 --- a/man/expert_validity.Rd +++ b/man/expert_validity.Rd @@ -67,8 +67,10 @@ interval uses the same \code{alpha} as Aiken's V. See \code{ci} in \code{\link[= methods and the evidence for each.} \item{agreement}{Panel-level agreement coefficient for relevance mode: -\code{"krippendorff"} (default), \code{"ac1"}, or \code{"none"}. Krippendorff's alpha uses -the relevance ratings at \code{agreement_level}; Gwet's AC1 uses the +\code{"krippendorff"} (default), \code{"ac1"}, or \code{"none"}. Krippendorff's alpha +(Hayes & Krippendorff, 2007), which Zapf et al. (2016) recommend for +ordinal or incomplete ratings, uses the relevance ratings at +\code{agreement_level}; Gwet's AC1 uses the relevant/not-relevant decision. See \code{\link[=panel_agreement]{panel_agreement()}} for the evidence behind each, including why AC1 is never the default. Panels with fewer than two experts or two items report no agreement coefficient.} @@ -102,7 +104,8 @@ while retaining mode-specific \code{recommendation} wording. In relevance mode, Provides a user-facing workflow for three common expert-panel tasks: \itemize{ \item \code{mode = "relevance"}: bounded ordinal relevance ratings, combining Aiken's -V (with Penfield-Giacobbi score intervals), CVI/modified kappa, and a +V (with the score intervals of Penfield and Giacobbi, 2004), the CVI with +the modified kappa of Polit et al. (2007), and a panel-level agreement coefficient. \item \code{mode = "essentiality"}: Lawshe CVR with exact binomial critical values. \item \code{mode = "congruence"}: the index of item-objective congruence of @@ -245,6 +248,6 @@ Evaluation in Counseling and Development, 45}(3), 197–210. Zapf, A., Castell, S., Morawietz, L., & Karch, A. (2016). Measuring inter-rater reliability for nominal data: Which coefficients and confidence -intervals are appropriate? \emph{BMC Medical Research Methodology, 16}, 93. +intervals are appropriate? \emph{BMC Medical Research Methodology, 16}, Article 93. \doi{10.1186/s12874-016-0200-9} } diff --git a/man/htc.Rd b/man/htc.Rd index 8ea7a10..4d0fee5 100644 --- a/man/htc.Rd +++ b/man/htc.Rd @@ -36,8 +36,9 @@ It prints as a formatted table in APA style; the values themselves are unrounded, and \code{as.data.frame()} returns the plain data frame. } \description{ -Computes the Hinkin-Tracey correspondence index for each item. Following -Colquitt et al. (2019), HTC is the average definitional-correspondence rating +Computes the Hinkin-Tracey correspondence index for each item, named for +the rating task of Hinkin and Tracey (1999). Following Colquitt et al. +(2019), HTC is the average definitional-correspondence rating for the intended construct divided by \code{a}, the number of rating anchors. Ratings are internally shifted to a 1-to-\code{a} metric when a scale such as 0-to-4 is supplied, preserving the meaning of the published formula. diff --git a/man/htd.Rd b/man/htd.Rd index 43d3201..23745af 100644 --- a/man/htd.Rd +++ b/man/htd.Rd @@ -36,8 +36,8 @@ It prints as a formatted table in APA style; the values themselves are unrounded, and \code{as.data.frame()} returns the plain data frame. } \description{ -Computes the Hinkin-Tracey distinctiveness index for each item in a fully -crossed, within-judge rating design. For every complete judge, the intended +Computes the Hinkin-Tracey distinctiveness index of Colquitt et al. (2019) +for each item in a fully crossed, within-judge rating design. For every complete judge, the intended construct rating is contrasted with each orbiting-construct rating. The average of those difference scores is divided by \code{a - 1}, where \code{a} is the number of rating anchors. HTD ranges from -1 to 1. diff --git a/man/panel_agreement.Rd b/man/panel_agreement.Rd index 2bab29a..bc3e187 100644 --- a/man/panel_agreement.Rd +++ b/man/panel_agreement.Rd @@ -55,7 +55,9 @@ of expert panels. It is a general reliability coefficient (Hayes & Krippendorff, 2007); no publication applying it specifically to content-validity panels was found. \item \code{"ac1"}: Gwet's (2008) AC1, designed for high-agreement data where -kappa-type coefficients fall. It is never the default: Vach and Gerke +kappa-type coefficients fall; Wongpakaran et al. (2013) found it less +affected than Cohen's kappa by how often each category is used. It is +never the default: Vach and Gerke (2023) show that it rises as ratings concentrate in one category even at a fixed level of agreement, and that it can be non-zero when raters are independent. Its printed output always repeats that critique. AC1 treats @@ -68,7 +70,8 @@ resample that happens to miss a category is scored on the same scale. \section{Why a close-agreeing panel can have a low alpha}{ Alpha compares observed disagreement with the disagreement expected if the -same ratings were assigned to items at random. When ratings cluster on a few +same ratings were assigned to items at random. Feinstein and Cicchetti +(1990) described the same paradox for kappa. When ratings cluster on a few values, as they do when nearly every item is rated relevant, very little disagreement is expected by chance, so even a few disagreements pull alpha down. The output reports the share of identical rating pairs alongside the @@ -111,18 +114,18 @@ Annenberg School for Communication, University of Pennsylvania. \url{https://www.asc.upenn.edu/sites/default/files/2021-03/Computing\%20Krippendorff\%27s\%20Alpha-Reliability.pdf} Vach, W., & Gerke, O. (2023). Gwet's AC1 is not a substitute for Cohen's -kappa: A comparison of basic properties. \emph{MethodsX, 10}, 102212. +kappa: A comparison of basic properties. \emph{MethodsX, 10}, Article 102212. \doi{10.1016/j.mex.2023.102212} Wongpakaran, N., Wongpakaran, T., Wedding, D., & Gwet, K. L. (2013). A comparison of Cohen's kappa and Gwet's AC1 when calculating inter-rater reliability coefficients: A study conducted with personality disorder -samples. \emph{BMC Medical Research Methodology, 13}, 61. +samples. \emph{BMC Medical Research Methodology, 13}, Article 61. \doi{10.1186/1471-2288-13-61} Zapf, A., Castell, S., Morawietz, L., & Karch, A. (2016). Measuring inter-rater reliability for nominal data: Which coefficients and confidence -intervals are appropriate? \emph{BMC Medical Research Methodology, 16}, 93. +intervals are appropriate? \emph{BMC Medical Research Methodology, 16}, Article 93. \doi{10.1186/s12874-016-0200-9} } \seealso{ diff --git a/man/simulate_csv_power.Rd b/man/simulate_csv_power.Rd index 6e63599..c01fb1a 100644 --- a/man/simulate_csv_power.Rd +++ b/man/simulate_csv_power.Rd @@ -19,7 +19,10 @@ simulate_csv_power(N = 20, true_p = 0.65, reps = 2000, alpha = 0.05) Estimated power (a number between 0 and 1). } \description{ -Auxiliary compatibility helper. For supported exact planning, prefer \code{\link[=sort_power]{sort_power()}}, which does not require Monte Carlo simulation. +Auxiliary compatibility helper. It estimates by simulation the +power of the exact target-count test of Howard and Melloy (2016). For +supported exact planning, prefer \code{\link[=sort_power]{sort_power()}}, which does not require +Monte Carlo simulation. } \examples{ simulate_csv_power(N = 20, true_p = 0.65, reps = 100, alpha = 0.05) diff --git a/man/sort_power.Rd b/man/sort_power.Rd index 376b515..b3ae25c 100644 --- a/man/sort_power.Rd +++ b/man/sort_power.Rd @@ -24,8 +24,8 @@ planning table. When a panel is too small for any count to reach \code{alpha} at that size. } \description{ -Computes the exact probability that an item will meet the Howard-Melloy -target-count criterion for a planned judge sample size and an assumed true +Computes the exact probability that an item will meet the target-count +criterion of Howard and Melloy (2016) for a planned judge sample size and an assumed true target-assignment probability. This is a binomial calculation, not a simulation. } diff --git a/man/sort_validity.Rd b/man/sort_validity.Rd index bde8eeb..495a467 100644 --- a/man/sort_validity.Rd +++ b/man/sort_validity.Rd @@ -103,7 +103,7 @@ assumes every judge who misses the target picks the same rival. When those judges spread across several constructs, the leading rival's count falls, so Csv can reach the critical value with fewer target assignments than the exact test requires. That is why it is not used for the decision. -\item \strong{Yao, Wu and Yang (2008)} required Psa and Csv both to reach .30, which +\item \strong{Yao et al. (2008)} required Psa and Csv both to reach .30, which they chose for a four-domain sort, where an item assigned at random lands in its domain with probability .25 (p. 486). They give no rule for other numbers of domains. diff --git a/tests/testthat/test-audit-text.R b/tests/testthat/test-audit-text.R new file mode 100644 index 0000000..23ca2d6 --- /dev/null +++ b/tests/testthat/test-audit-text.R @@ -0,0 +1,299 @@ +# Fixes from the audit before 1.0: what the keys and help pages say, APA +# text, plot arguments, long item names, and as.data.frame() for every +# result. + +flat <- function(x, ...) { + old <- options(width = 80) + on.exit(options(old), add = TRUE) + gsub("[[:space:]]+", " ", paste(utils::capture.output(print(x, ...)), + collapse = "\n")) +} + +relevance <- function() { + matrix(c(4, 3, 4, 4, 3, 4, 2, 3, 4, 4, 3, 2, 4, 4, 4, 3, 4, 4), 6, + dimnames = list(NULL, c("I1", "I2", "I3"))) +} + +sort_fit <- function() { + sort_validity(utils::read.csv( + system.file("extdata", "sort_example.csv", package = "contentvalidR"), + stringsAsFactors = FALSE)) +} + +# ---- Keys and glossary -------------------------------------------------------- + +test_that("the modified kappa key says when it can fall below 0", { + out <- flat(expert_validity(relevance(), lo = 1, hi = 4, agreement = "none")) + expect_match(out, "below 0 only when no expert, or one of three, rated it relevant", + fixed = TRUE) + expect_false(grepl("below 0 when agreement is below chance", out, fixed = TRUE)) + # It is true: 1 of 3 is negative, 1 of 4 is not. + k <- function(a, n) { + pc <- stats::dbinom(a, n, 0.5) + (a / n - pc) / (1 - pc) + } + expect_lt(k(1, 3), 0) + expect_gte(k(1, 4), 0) + expect_gt(k(2, 8), 0) +}) + +test_that("the key defines S-CVI/Ave and S-CVI/UA, which the header prints", { + out <- flat(expert_validity(relevance(), lo = 1, hi = 4, agreement = "none")) + expect_match(out, "S-CVI/Ave -- Scale-level CVI, averaging method", fixed = TRUE) + expect_match(out, "S-CVI/UA -- Scale-level CVI, universal agreement", fixed = TRUE) +}) + +test_that("the agreement key matches the coefficient chosen", { + kr <- flat(expert_validity(relevance(), lo = 1, hi = 4, agreement_B = 0)) + expect_match(kr, "it can be low when nearly every rating is the same", fixed = TRUE) + ac <- flat(expert_validity(relevance(), lo = 1, hi = 4, agreement = "ac1", + agreement_B = 0)) + expect_match(ac, "Panel-level agreement (Gwet's AC1)", fixed = TRUE) + expect_false(grepl("it can be low when nearly every rating is the same", ac, + fixed = TRUE)) +}) + +test_that("the judge key separates severity in rating points from logits", { + g <- contentvalid_glossary() + sev <- g$definition[g$term == "severity"] + expect_match(sev, "relevant/not-relevant decision", fixed = TRUE) + expect_false(grepl("Reported in logits", sev, fixed = TRUE)) + expect_true("severity_raw" %in% g$term) + r <- rbind( + c(4, 4, 3, 4, 3, 2, 3, 2, 4, 3), c(4, 3, 4, 3, 2, 3, 2, 3, 4, 2), + c(3, 4, 4, 3, 3, 2, 2, 2, 3, 3), c(4, 4, 3, 2, 3, 3, 3, 1, 4, 2), + c(4, 3, 3, 4, 2, 2, 3, 2, 3, 3), c(3, 4, 4, 3, 3, 3, 2, 3, 4, 1), + c(4, 4, 4, 4, 3, 2, 3, 2, 4, 3), c(3, 2, 3, 2, 2, 1, 2, 1, 2, 2) + ) + fit <- judge_validity(r, lo = 1, hi = 4) + expect_true(fit$scale_summary$severity_estimable) + expect_match(flat(fit), "logit -- Judge severity in logits", fixed = TRUE) +}) + +test_that("domain decision meanings state the rule applied", { + m <- contentvalidR:::.decision_meanings("domain") + expect_match(m[["Over-represented"]], "over_factor", fixed = TRUE) + expect_match(m[["Under-represented"]], "over_factor", fixed = TRUE) + expect_match(m[["Thinly covered"]], "minimum set for this analysis", fixed = TRUE) +}) + +test_that("three-author works are cited with et al. and p value is not hyphenated", { + out <- flat(expert_validity(relevance(), lo = 1, hi = 4, agreement = "none")) + expect_match(out, "(Polit et al., 2007)", fixed = TRUE) + expect_false(grepl("Polit, Beck", out, fixed = TRUE)) + expect_false(grepl("Polit, Beck", flat(cvi(relevance() >= 3)), fixed = TRUE)) + g <- contentvalid_glossary() + expect_false(any(grepl("p-value", unlist(g), fixed = TRUE))) +}) + +# ---- content_report() ------------------------------------------------------ + +test_that("the relevance report keeps its two intervals apart", { + tab <- content_report(expert_validity(relevance(), lo = 1, hi = 4, + agreement = "none")) + expect_false(anyDuplicated(names(tab)) > 0L) + expect_true(all(c("V 95% CI", "I-CVI 95% CI") %in% names(tab))) + expect_identical(names(as.data.frame(tab)), names(tab)) + expect_null(attr(as.data.frame(tab), "display")) + # A reader sees each interval under the shared heading, beside its estimate. + printed <- utils::capture.output(print(tab)) + expect_identical(lengths(regmatches(printed[1], gregexpr("95% CI", printed[1]))), 2L) + expect_false(grepl("V 95% CI", printed[1], fixed = TRUE)) + md <- content_report(expert_validity(relevance(), lo = 1, hi = 4, + agreement = "none"), format = "markdown") + expect_match(md[1], "| V | 95% CI | I-CVI | 95% CI |", fixed = TRUE) +}) + +# ---- Plot arguments and long item names -------------------------------------- + +test_that("every plot takes xlab, ylab, xlim, ylim and main from the caller", { + pdf(NULL) + on.exit(grDevices::dev.off(), add = TRUE) + user <- list(xlab = "Mine", ylab = "Yours", main = "Title") + try_plot <- function(obj, ...) { + expect_no_error(do.call(plot, c(list(obj, ...), user))) + } + s <- sort_fit() + for (type in c("item", "map")) { + expect_no_error(plot(s, type = type, xlab = "Mine", ylab = "Yours", + main = "Title")) + } + try_plot(expert_validity(relevance(), lo = 1, hi = 4, agreement = "none"), + xlim = c(0, 1)) + try_plot(expert_validity(relevance(), lo = 1, hi = 4, agreement = "none"), + type = "distribution") + try_plot(expert_validity(c(10, 8, 6), mode = "essentiality", N = 12), + xlim = c(-1, 1)) + d <- expand.grid(item = c("I1", "I2"), judge = 1:4, objective = c("A", "B")) + d$target_objective <- ifelse(d$item == "I1", "A", "B") + d$score <- ifelse(d$objective == d$target_objective, 1, -1) + try_plot(expert_validity(d, mode = "congruence"), ylim = c(0, 4)) + try_plot(sort_power(N = c(10, 20, 30), true_p = 0.8), xlim = c(5, 35)) + try_plot(expert_power(n_experts = 5:10), ylim = c(0, 1)) + try_plot(content_evidence(expert_validity(relevance(), lo = 1, hi = 4, + agreement = "none"))) +}) + +test_that("long item names are shortened rather than breaking a figure", { + pdf(NULL, width = 7, height = 4) + on.exit(grDevices::dev.off(), add = TRUE) + R <- relevance() + colnames(R) <- c(strrep("A very long item name ", 3), "Short", + strrep("Another long name ", 4)) + fit <- expert_validity(R, lo = 1, hi = 4, agreement = "none") + expect_no_error(plot(fit, type = "distribution")) + expect_no_error(plot(content_evidence(fit))) + lab <- contentvalidR:::.item_labels(colnames(R), width_in = 7) + expect_identical(lab$labels[2], "Short") + expect_true(all(grepl("...", lab$labels[-2], fixed = TRUE))) + expect_lte(lab$lines, 1.2 + 0.4 * 7 / graphics::par("csi") + 1e-9) +}) + +# ---- as.data.frame() for every result ------------------------------------------ + +test_that("every result becomes a data frame", { + R <- relevance() + sim <- matrix(1, 6, 6, dimnames = list(paste0("I", 1:6), paste0("I", 1:6))) + sim[1:3, 1:3] <- 4 + sim[4:6, 4:6] <- 4 + sim[1, 2] <- sim[2, 1] <- 5 + diag(sim) <- 5 + s <- sort_fit() + objs <- list( + sort_power(N = c(10, 20), true_p = .8), + expert_power(n_experts = c(6, 10)), + content_structure(sim, membership = rep(c("A", "B"), each = 3)), + compare_rounds(s, s), + content_handoff(s), + gtheory_content(R), + panel_agreement(R, B = 0), + cvi(R >= 3) + ) + for (o in objs) { + d <- as.data.frame(o) + expect_s3_class(d, "data.frame") + expect_gt(nrow(d), 0L) + } + expect_identical(nrow(as.data.frame(cvi(R >= 3), component = "scale_level")), 1L) + expect_identical(names(as.data.frame(content_handoff(s))), + names(content_handoff(s)$item_evidence)) + expect_error(as.data.frame(gtheory_content(R), component = "nope"), + "should be one of") +}) + +test_that("a single test is one row", { + b <- as.data.frame(csv_binom_test(16, 20)) + expect_identical(nrow(b), 1L) + expect_true(all(c("ci_low", "ci_high", "p.value") %in% names(b))) + pre <- c(TRUE, TRUE, FALSE, TRUE, FALSE, TRUE) + crit <- c(TRUE, FALSE, FALSE, TRUE, FALSE, TRUE) + sd <- as.data.frame(signal_detection(pre, crit)) + expect_identical(nrow(sd), 1L) + expect_identical(sd$n_predicted_retain_actual_retain, 3L) + expect_identical(nrow(as.data.frame(reproducibility_phi(pre, crit))), 1L) + pa <- as.data.frame(panel_agreement(relevance(), B = 0)) + expect_identical(nrow(pa), 1L) + expect_true(all(c("method", "estimate") %in% names(pa))) +}) + +# ---- Review of the text fixes ------------------------------------------------ + +test_that("a caller's plot argument reaches the frame, and protected ones do not", { + seen <- NULL + capture <- function(...) seen <<- list(...) + base <- list(x = 1, type = "n", xaxt = "n", xlab = "Method", pch = 19) + contentvalidR:::.plot_with(base, list(xlab = "Mine", xlim = c(0, 2)), + draw = capture) + expect_identical(seen$xlab, "Mine") + expect_identical(seen$xlim, c(0, 2)) + contentvalidR:::.plot_with(base, list(type = "l", xaxt = "s", xlab = NULL), + draw = capture) + expect_identical(seen$type, "n") + expect_identical(seen$xaxt, "n") + expect_identical(seen$xlab, "Method") + contentvalidR:::.plot_with(base, list(pch = 17), draw = capture, + protect = c("type", "pch")) + expect_identical(seen$pch, 19) + expect_warning(contentvalidR:::.plot_with(base, list("stray"), draw = capture), + "Unnamed arguments") + + pdf(NULL) + on.exit(grDevices::dev.off(), add = TRUE) + plot(expert_validity(relevance(), lo = 1, hi = 4, agreement = "none"), + xlim = c(0, 0.5)) + expect_equal(graphics::par("usr")[2], 0.5 + 0.04 * 0.5, tolerance = 1e-6) +}) + +test_that("shortened labels stay apart and full labels are kept when they fit", { + pdf(NULL, width = 7, height = 4) + on.exit(grDevices::dev.off(), add = TRUE) + stems <- c("I feel confident in my ability to do my job well", + "I feel confident in my ability to learn new skills", + "My supervisor gives me useful feedback") + lab <- contentvalidR:::.item_labels(stems, width_in = 4) + expect_false(anyDuplicated(lab$labels) > 0L) + expect_true(all(grepl("...", lab$labels[1:2], fixed = TRUE))) + short <- c("effort_regulation_01", "effort_regulation_02", "task_focus_01") + expect_identical(contentvalidR:::.item_labels(short)$labels, short) +}) + +test_that("both two-by-two tables give their four counts by name", { + pre <- c(TRUE, TRUE, FALSE, TRUE, FALSE, TRUE) + crit <- c(TRUE, FALSE, FALSE, TRUE, FALSE, TRUE) + sd <- as.data.frame(signal_detection(pre, crit)) + expect_identical( + unlist(sd[c("n_predicted_retain_actual_retain", + "n_predicted_not_retained_actual_retain", + "n_predicted_retain_actual_not_retained", + "n_predicted_not_retained_actual_not_retained")], use.names = FALSE), + c(3L, 0L, 1L, 2L)) + rp <- as.data.frame(reproducibility_phi(pre, crit)) + expect_identical( + unlist(rp[c("n_pretest1_retain_pretest2_retain", + "n_pretest1_not_retained_pretest2_retain", + "n_pretest1_retain_pretest2_not_retained", + "n_pretest1_not_retained_pretest2_not_retained")], use.names = FALSE), + c(3L, 0L, 1L, 2L)) +}) + +test_that("one-row frames say what their interval is", { + pa <- as.data.frame(panel_agreement(relevance(), B = 0)) + expect_true("ci_alpha" %in% names(pa)) + expect_false("alpha" %in% names(pa)) + b <- as.data.frame(csv_binom_test(16, 20)) + expect_identical(b$ci_sides, "one-sided") + expect_equal(b$ci_level, 0.95) +}) + +test_that("three-author works read et al. in printouts", { + expect_match(flat(cvi(relevance() >= 3)), "Polit et al. (2007)", fixed = TRUE) + legacy <- flat(sort_fit(), legacy = TRUE) + expect_match(legacy, "Yao et al. (2008): Psa and Csv", fixed = TRUE) + expect_false(grepl("Yao, Wu", legacy, fixed = TRUE)) +}) + +test_that("a renamed report column prints under its new name", { + tab <- content_report(sort_fit()) + expect_true("Psa 95% CI" %in% names(tab)) + names(tab)[1] <- "Item code" + out <- utils::capture.output(print(tab)) + expect_match(out[1], "Item code", fixed = TRUE) + expect_match(out[1], "95% CI", fixed = TRUE) + expect_false(grepl("Psa 95% CI", out[1], fixed = TRUE)) +}) + +test_that("the AC1 key does not read 0 as chance", { + ac <- flat(expert_validity(relevance(), lo = 1, hi = 4, agreement = "ac1", + agreement_B = 0)) + expect_match(ac, "not 0 for independent raters", fixed = TRUE) + expect_false(grepl("decision (1 is perfect, 0 is chance)", ac, fixed = TRUE)) +}) + +test_that("the glossary keys severity by its column in results", { + g <- contentvalid_glossary() + expect_match(g$definition[g$term == "severity_raw"], "rating points", fixed = TRUE) + expect_match(g$definition[g$term == "severity"], "even in sign", fixed = TRUE) + expect_false("logit" %in% g$term) + m <- contentvalidR:::.decision_meanings("domain") + expect_false(grepl("target", m[["Thinly covered"]], fixed = TRUE)) +}) diff --git a/tests/testthat/test-earlier-methods.R b/tests/testthat/test-earlier-methods.R index d57e52d..d19e595 100644 --- a/tests/testthat/test-earlier-methods.R +++ b/tests/testthat/test-earlier-methods.R @@ -262,7 +262,7 @@ test_that("the printed comparison states each rule's source and agreement", { out <- gsub("[[:space:]]+", " ", paste(utils::capture.output(print(fit)), collapse = " ")) expect_match(out, "Anderson and Gerbing (1991): Csv of at least .50", fixed = TRUE) - expect_match(out, "Yao, Wu and Yang (2008)", fixed = TRUE) + expect_match(out, "Yao et al. (2008): Psa and Csv", fixed = TRUE) it <- fit$details$earlier_methods$items keep <- it$decision == "Retain" diff --git a/tests/testthat/test-print-verdicts.R b/tests/testthat/test-print-verdicts.R index 02b1c39..5b87015 100644 --- a/tests/testthat/test-print-verdicts.R +++ b/tests/testthat/test-print-verdicts.R @@ -60,7 +60,8 @@ test_that("the key does not claim modified kappa stays between 0 and 1", { expect_lt(fit$results$kappa_mod[fit$results$item == "I4"], 0) expect_equal(round(fit$results$kappa_mod[fit$results$item == "I4"], 2), -0.07) out <- printed(fit) - expect_match(out, "below 0 when agreement is below chance", fixed = TRUE) + expect_match(out, "below 0 only when no expert, or one of three, rated it relevant", + fixed = TRUE) expect_false(grepl("overstate consensus. (0 to 1", out, fixed = TRUE)) }) diff --git a/tests/testthat/test-reporting.R b/tests/testthat/test-reporting.R index f28718e..3bf68eb 100644 --- a/tests/testthat/test-reporting.R +++ b/tests/testthat/test-reporting.R @@ -189,12 +189,12 @@ test_that("content_report rejects non-workflow input", { test_that("the default report is an APA table", { tab <- content_report(sort_fit()) expect_identical(names(tab), c("item", "target", "judges", "competitor", - "Psa", "95% CI", "Csv", "p", "decision")) + "Psa", "Psa 95% CI", "Csv", "p", "decision")) r <- sort_fit()$results i <- which(r$item == "A1") expect_identical(tab$judges[i], paste0(r$n_target[i], "/", r$n[i])) expect_false(any(grepl("^0[.]", tab$Psa))) - expect_match(tab$`95% CI`[i], "^[[][.][0-9]{2}, (1[.]00|[.][0-9]{2})[]]$") + expect_match(tab$`Psa 95% CI`[i], "^[[][.][0-9]{2}, (1[.]00|[.][0-9]{2})[]]$") expect_true(all(grepl("^(< [.]001|[.][0-9]{3}|1[.]000)$", tab$p))) # It prints without row names, and as.data.frame() gives a plain data frame. diff --git a/vignettes/design-and-reporting.Rmd b/vignettes/design-and-reporting.Rmd index 3462cd1..68df5fb 100644 --- a/vignettes/design-and-reporting.Rmd +++ b/vignettes/design-and-reporting.Rmd @@ -96,13 +96,14 @@ random-number generation. ## Table templates +`content_report()` turns a fit into a manuscript table, with the columns a +reader needs and numbers in APA form; `format = "markdown"` gives the same +table to paste. The unrounded values stay in each fit's `results`. + ### Item sort ```{r sort-table} -sort_fit$results[c( - "item", "target", "n", "n_target", "competitor", - "psa", "csv", "p_value", "status", "recommendation" -)] +content_report(sort_fit) ``` At the target-scale level, report mean Psa/Csv and the benchmark set actually @@ -111,25 +112,19 @@ used. Do not convert Colquitt's scale-level norms into individual-item cutoffs. ### Construct rating ```{r rating-table} -rating_fit$results[c( - "item", "target", "n_complete", "strongest_competitor", - "htc", "htd", "p_value", "max_contrast_p", "status", "recommendation" -)] -rating_fit$scale_summary +content_report(rating_fit) ``` Report the repeated-measures design and target-versus-orbiting contrasts. For a -review item, naming the strongest competitor is often more informative than a -standalone p value. +review item, naming the strongest competitor, which `rating_fit$results` holds +as `strongest_competitor`, is often more informative than a standalone p +value. ### Expert relevance ```{r expert-table} -expert_fit$results[c( - "item", "N", "V", "ci_low", "ci_high", "I_CVI", - "kappa_mod", "status", "recommendation" -)] -expert_fit$scale_summary +content_report(expert_fit) +expert_fit$scale_summary[c("S_CVI_Ave", "S_CVI_UA", "agreement")] ``` Essentiality and congruence require different expert tasks. Do not place CVR, diff --git a/vignettes/expert-panel-validity.Rmd b/vignettes/expert-panel-validity.Rmd index 14429ea..a6a7d29 100644 --- a/vignettes/expert-panel-validity.Rmd +++ b/vignettes/expert-panel-validity.Rmd @@ -22,8 +22,8 @@ interchangeable. The three modes are: -- **relevance**: Aiken's V plus CVI and modified kappa, with a panel-level - agreement coefficient; +- **relevance**: Aiken's (1980) V plus CVI and the modified kappa of Polit + et al. (2007), with a panel-level agreement coefficient; - **essentiality**: Lawshe's CVR with exact binomial inference; and - **congruence**: the index of item-objective congruence (IOC) of Rovinelli and Hambleton (1977). @@ -90,9 +90,10 @@ fit$scale_summary[, c("agreement", "agreement_low", "agreement_high")] fit$details$agreement ``` -The default coefficient is Krippendorff's alpha. It accepts any number of -experts and missing ratings, and Zapf et al. (2016) recommend it when ratings -are ordinal or incomplete, which describes most expert panels. It is a general +The default coefficient is Krippendorff's alpha (Krippendorff, 2011). It +accepts any number of experts and missing ratings, and Zapf et al. (2016) +recommend it when ratings are ordinal or incomplete, which describes most +expert panels. It is a general reliability coefficient (Hayes & Krippendorff, 2007) rather than one developed for content validity; no publication applying it specifically to content-validity panels was found. @@ -367,7 +368,7 @@ multidimensional items. *International Journal of Testing, 3*(2), 163–171. https://doi.org/10.1207/S15327574IJT0302_5 Vach, W., & Gerke, O. (2023). Gwet's AC1 is not a substitute for Cohen's kappa: -A comparison of basic properties. *MethodsX, 10*, 102212. +A comparison of basic properties. *MethodsX, 10*, Article 102212. https://doi.org/10.1016/j.mex.2023.102212 Wilson, F. R., Pan, W., & Schumsky, D. A. (2012). Recalculation of the critical @@ -377,5 +378,5 @@ https://doi.org/10.1177/0748175612440286 Zapf, A., Castell, S., Morawietz, L., & Karch, A. (2016). Measuring inter-rater reliability for nominal data: Which coefficients and confidence intervals are -appropriate? *BMC Medical Research Methodology, 16*, 93. +appropriate? *BMC Medical Research Methodology, 16*, Article 93. https://doi.org/10.1186/s12874-016-0200-9 diff --git a/vignettes/handoff-to-empirical-validation.Rmd b/vignettes/handoff-to-empirical-validation.Rmd index ed023fc..8ea774c 100644 --- a/vignettes/handoff-to-empirical-validation.Rmd +++ b/vignettes/handoff-to-empirical-validation.Rmd @@ -142,7 +142,9 @@ through screening, dimensionality, measurement models, reliability, invariance, and nomological networks. ```{r nomologr, eval=FALSE} -# install.packages("nomologR", repos = "https://juhalt.r-universe.dev") +# install.packages("nomologR", +# repos = c("https://juhalt.r-universe.dev", +# "https://cloud.r-project.org")) library(nomologR) # `responses` is your collected data: one row per respondent, one column per item. diff --git a/vignettes/item-sort-validity.Rmd b/vignettes/item-sort-validity.Rmd index 7c5e1a7..765c5e2 100644 --- a/vignettes/item-sort-validity.Rmd +++ b/vignettes/item-sort-validity.Rmd @@ -207,7 +207,7 @@ Look at C2. Fourteen of 20 judges chose its target, one short of the 15 the exact test needs, so the decision is Review. Anderson and Gerbing's rule passes it: their critical Csv of .50 assumes the six judges who missed the target all chose one rival, but here they split, so Csv reaches .50 anyway. -That is the miscalibration in miniature. Yao, Wu and Yang's (2008) .30 cutoffs +That is the miscalibration in miniature. Yao et al.'s (2008) .30 cutoffs pass every item, because they were set for four domains, where chance is .25; with three constructs, chance is already above .30. diff --git a/vignettes/one-item-set-both-stages.Rmd b/vignettes/one-item-set-both-stages.Rmd index d3ae75d..48b431d 100644 --- a/vignettes/one-item-set-both-stages.Rmd +++ b/vignettes/one-item-set-both-stages.Rmd @@ -52,8 +52,8 @@ items[c("item", "facet", "stem")] Each item was also given a job, and the file records what it is, so you can check the stages against the design rather than take this vignette's word for -anything. Two are simply written the other way round; five more are meant to -cause trouble: +anything. Two are simply written the other way round; seven more each set a +particular test for one stage or the other: ```{r roles} subset(items, !startsWith(role, "ordinary"))[c("item", "role")] @@ -63,8 +63,8 @@ subset(items, !startsWith(role, "ordinary"))[c("item", "role")] Twenty judges sorted each item into `EF`, `TF`, or `TA`. `sort_validity()` applies the exact target-count test of Howard and Melloy (2016): with twenty -judges and two plausible answers, an item needs fifteen assignments to its -target to meet the criterion. +judges and the default null probability of .50, an item needs fifteen +assignments to its target to meet the criterion. ```{r sort} sorted <- read.csv(path("walkthrough_sort.csv"), stringsAsFactors = FALSE) @@ -82,8 +82,9 @@ read it as test anxiety. Its target wins and the criterion is not met. `TF5` ("I work hard to stay on top of my reading") is worse: thirteen judges put it under effort regulation and only six under task focus, so a competing -facet beat the target outright. Its content validity index for sorting is -negative, which is what a negative `csv` means. +facet beat the target outright. Its substantive validity coefficient, `csv`, +is negative, which means judges chose a competing construct more often than +the intended one. ```{r flagged} panel$results[panel$results$recommendation == "Review", @@ -204,7 +205,8 @@ round(unclass(fa$loadings)["EF4", ], 2) **`TF4` passed content review and belongs to both facets.** "I keep working through a task without taking breaks" is as much effort as focus, and the -response data say so even though the judges saw only one of the two: +response data say so, though only four of the twenty judges sorted it under +effort regulation: ```{r tf4} round(unclass(fa$loadings)["TF4", ], 2) @@ -316,8 +318,8 @@ shows the same calls on a handoff, in the section Surviving content review is evidence about relevance, representation, and whether experts read an item the way it was meant. It is not evidence that the item measures anything. Of the ten items this panel carried forward, one -carries almost no common variance and one belongs to a facet the judges never -considered. Both read well. That is not a failure of the panel; it is the +carries almost no common variance and one also loads on a second facet that +only four of the twenty judges saw in it. Both read well. That is not a failure of the panel; it is the boundary of what a panel can see. The reverse holds just as firmly. A screening index is a number about a sample, diff --git a/vignettes/reading-output.Rmd b/vignettes/reading-output.Rmd index 3de12bc..13311b0 100644 --- a/vignettes/reading-output.Rmd +++ b/vignettes/reading-output.Rmd @@ -89,7 +89,8 @@ and which were flagged), then one row per item. Working across the item table: default (`p_value` in `results`). That benchmark is not the rate random sorting would give, which is 1 divided by the number of constructs. -Numbers follow the APA style rules (seventh edition, Section 6.36). A statistic +Numbers follow the APA style rules (American Psychological Association, 2020, +Section 6.36). A statistic that cannot exceed 1, such as a proportion or a *p* value, is printed without a leading zero (.90). One that can exceed 1 keeps it (0.57). A *p* value below .001 is printed as < .001. The `results` table keeps every value at full @@ -284,7 +285,8 @@ flagged item optimizes a statistic at the cost of the content domain, which is the opposite of content validity. **"Strong means good."** Benchmark labels are percentile positions against -published scales. `Strong` means typical of published work, not that the item +published scales. `Strong` places a scale's mean between the 60th and 79th +percentiles of the scales Colquitt et al. (2019) collected, not that the item is fit for your purpose. **"One index is enough."** No single coefficient establishes content validity. @@ -349,6 +351,11 @@ American Psychological Association. (2020). *Publication manual of the American Psychological Association* (7th ed.). https://doi.org/10.1037/0000165-000 +Colquitt, J. A., Sabey, T. B., Rodell, J. B., & Hill, E. T. (2019). Content +validation guidelines: Evaluation criteria for definitional correspondence and +definitional distinctiveness. *Journal of Applied Psychology, 104*(10), +1243–1265. https://doi.org/10.1037/apl0000406 + Lynn, M. R. (1986). Determination and quantification of content validity. *Nursing Research, 35*(6), 382–385. https://doi.org/10.1097/00006199-198611000-00017 diff --git a/vignettes/reporting-examples.Rmd b/vignettes/reporting-examples.Rmd index 956af2e..fc6cb08 100644 --- a/vignettes/reporting-examples.Rmd +++ b/vignettes/reporting-examples.Rmd @@ -63,13 +63,13 @@ For this bundled example, `r sort_fit$design$n_raters` judges evaluated screening criterion, `r sort_sum$n_review` were flagged for review, and `r sort_sum$n_insufficient` had insufficient usable assignments. -A manuscript table can usually be built directly from: +`content_report()` gives the manuscript table: the columns a reader needs, +with numbers in APA form. `format = "markdown"` gives the same table to paste +into a manuscript, and `format = "data.frame"` the rounded numbers. The +unrounded values stay in `sort_fit$results`. ```{r sort-table} -sort_fit$results[c( - "item", "target", "n", "n_target", "competitor", - "psa", "csv", "p_value", "status", "recommendation" -)] +content_report(sort_fit) ``` Do not report `Review` as synonymous with deletion. A review flag identifies an @@ -108,13 +108,11 @@ The example contains `r rating_fit$design$n_items` items rated by and `r rating_sum$n_review` were flagged for review. ```{r rating-table} -rating_fit$results[c( - "item", "target", "n_complete", "strongest_competitor", - "htc", "htd", "p_value", "max_contrast_p", "status", "recommendation" -)] +content_report(rating_fit) ``` -For review items, report the strongest orbiting competitor. That information +For review items, report the strongest orbiting competitor, which +`rating_fit$results` holds as `strongest_competitor`. That information turns a generic statement about weak distinctiveness into a specific diagnostic about where construct overlap may be occurring. @@ -138,7 +136,7 @@ expert_fit$scale_summary > Experts rated the relevance of each candidate item on a bounded ordinal > scale. We summarized relevance using Aiken's V with Penfield-Giacobbi score -> confidence intervals and calculated I-CVI with Polit-Beck-Owen modified kappa. +> confidence intervals and calculated I-CVI with the modified kappa of Polit et al. (2007). > S-CVI/Ave and S-CVI/UA were reported at the scale level. Panel-size CVI > guidelines were used as review aids and were considered alongside written > expert feedback and construct coverage.