From 69225e3492a5699c565980c86e4b441d5b6079ac Mon Sep 17 00:00:00 2001 From: "Joshua Uhalt, Ph.D." Date: Mon, 28 Sep 2026 11:50:33 -0400 Subject: [PATCH 1/2] Add figures for papers, posters, and teaching: content_evidence() and the distribution view The maintainer asked for three displays before 1.0. Each draws what the fits and handoffs already decided, and none computes anything new. content_evidence() (new, Tier 1) brings the handoffs from several review stages together. It prints one row per item, with each stage's decision beside the statistic its rule read, and draws two figures: - the item flow diagram, modelled on the PRISMA 2020 flow diagram (Page et al., 2021): what each stage reviewed, what it held back and the number behind each decision, and what went forward. Stages may run in sequence or side by side; - the item evidence profile, the package's own design: one panel per stage with each statistic, its interval, and its criterion, and a column naming the stages that held an item back. Decisions are read from each handoff, never recomputed, as the reader contract in ?content_handoff asks. plot(, type = "distribution") and plot(, which = "distribution") draw every rating as diverging stacked bars (Heiberger & Robbins, 2014), split at the cut the decision rule counts, so two items with the same I-CVI can be told apart. Relevance fits keep their ratings in details$ratings to draw it. All three take `apa`: grey by default, as an APA figure is printed, or a colour-blind-safe scheme with teal for evidence that met its criterion and brown for evidence under review. Symbols carry the decision either way. walkthrough_relevance.csv gives the twelve walkthrough items a relevance panel, from its own script, so the three files nomologR ships are unchanged. vignette("reporting-examples") uses it to show both figures, with a sample caption; the expert-panel and Delphi vignettes show the distribution view. In passing: the handoff printout and the handoff vignette now pass the whole handoff to nomologR rather than handoff$items, and the vignette no longer calls nomologR's handoff reader future work. Heiberger & Robbins (2014) and Page et al. (2021) are checked against Crossref, the journal pages, and PubMed, and added to the README and REFERENCES.bib. Co-Authored-By: Claude Opus 5.5 --- NAMESPACE | 4 + NEWS.md | 40 ++ R/content_evidence.R | 641 ++++++++++++++++++ R/content_handoff.R | 6 +- R/contentvalidR-package.R | 5 +- R/delphi_validity.R | 64 +- R/expert_validity.R | 62 +- R/plot_distribution.R | 131 ++++ R/plot_helpers.R | 46 ++ README.Rmd | 2 + README.md | 11 + ROADMAP.md | 16 + _pkgdown.yml | 2 + data-raw/build-walkthrough-panel.R | 52 ++ inst/REFERENCES.bib | 21 + inst/WORDLIST | 17 + inst/extdata/README.md | 17 +- inst/extdata/walkthrough_relevance.csv | 9 + man/content_evidence.Rd | 125 ++++ man/contentvalidR-package.Rd | 5 +- man/plot.contentvalid_delphi.Rd | 34 +- man/plot.contentvalid_evidence.Rd | 75 ++ man/plot.contentvalid_expert.Rd | 42 +- tests/testthat/test-evidence-displays.R | 246 +++++++ tests/testthat/test-public-api-v005c.R | 4 + tests/testthat/test-walkthrough-data.R | 33 + vignettes/delphi-rounds.Rmd | 18 + vignettes/expert-panel-validity.Rmd | 24 + vignettes/handoff-to-empirical-validation.Rmd | 8 +- vignettes/reporting-examples.Rmd | 73 ++ 30 files changed, 1810 insertions(+), 23 deletions(-) create mode 100644 R/content_evidence.R create mode 100644 R/plot_distribution.R create mode 100644 data-raw/build-walkthrough-panel.R create mode 100644 inst/extdata/walkthrough_relevance.csv create mode 100644 man/content_evidence.Rd create mode 100644 man/plot.contentvalid_evidence.Rd create mode 100644 tests/testthat/test-evidence-displays.R diff --git a/NAMESPACE b/NAMESPACE index 50a707f..c641adc 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -1,9 +1,11 @@ # Generated by roxygen2: do not edit by hand S3method(as.data.frame,contentvalid_component) +S3method(as.data.frame,contentvalid_evidence) S3method(as.data.frame,contentvalid_report) S3method(as.data.frame,contentvalid_workflow) S3method(plot,contentvalid_delphi) +S3method(plot,contentvalid_evidence) S3method(plot,contentvalid_expert) S3method(plot,contentvalid_expert_power) S3method(plot,contentvalid_rating) @@ -21,6 +23,7 @@ S3method(print,contentvalid_cvi) S3method(print,contentvalid_cvr) S3method(print,contentvalid_delphi) S3method(print,contentvalid_domain) +S3method(print,contentvalid_evidence) S3method(print,contentvalid_expert) S3method(print,contentvalid_expert_power) S3method(print,contentvalid_glossary) @@ -62,6 +65,7 @@ export(colquitt_benchmarks) export(compare_rounds) export(compute_csv) export(compute_psa) +export(content_evidence) export(content_handoff) export(content_report) export(content_structure) diff --git a/NEWS.md b/NEWS.md index a410a54..a9e3801 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,5 +1,45 @@ # contentvalidR 0.9.0.9000 (development version) +## Figures for papers, posters, and teaching (in development) + +No computed value changes. Each new figure draws what the fits and handoffs +already decided, and says whether it follows a published form or is this +package's own design. + +* **`content_evidence()` (new)** brings the handoffs from several review + stages together, such as a relevance panel and then an item sort. It prints + one row per item with each stage's decision beside the statistic its rule + read, and draws two figures: + * `plot(x, type = "flow")`, the item flow diagram, modeled on the PRISMA + 2020 flow diagram (Page et al., 2021): what each stage reviewed, what it + held back and the number behind each decision, and what went forward; + * `plot(x)`, the item evidence profile, this package's own design: one + panel per stage with each statistic, its interval, and its criterion, so + agreement and disagreement between methods can be seen item by item. +* **The distribution view** draws every rating behind an index as diverging + stacked bars (Heiberger & Robbins, 2014), split at the cut the decision rule + counts: `plot(fit, type = "distribution")` for a relevance panel and + `plot(fit, which = "distribution")` for a Delphi study, one bar per round. It + shows what the I-CVI cannot: two items at 1.00, one rated relevant with 4s + and the other with 3s. Relevance fits now keep their ratings in + `details$ratings` to draw it. +* **`apa`** switches these figures between gray (`TRUE`, the default, as an + APA figure is printed) and a colorblind-safe scheme for slides and posters + (`FALSE`): teal for evidence that met its criterion, brown for evidence under + review. Symbols carry the decision either way, so no reading depends on + color. +* **A relevance panel for the walkthrough items**, `walkthrough_relevance.csv`, + gives the twelve items a second source of content evidence. + `vignette("reporting-examples")` uses it to show both figures, with a sample + caption. The ratings are constructed, and a separate script, + `data-raw/build-walkthrough-panel.R`, says what each is built to show. The + three walkthrough files that nomologR ships are unchanged. +* The printed handoff and `vignette("handoff-to-empirical-validation")` now + pass the whole handoff to nomologR, `nomo_screen(data, items = handoff)`, + rather than `handoff$items`, so the keying and the reasons for anything held + back travel with the items. The vignette no longer calls the handoff reader + in nomologR future work. + ## Finishing touches before 1.0 (in development) No computed value changes. diff --git a/R/content_evidence.R b/R/content_evidence.R new file mode 100644 index 0000000..f1c38cf --- /dev/null +++ b/R/content_evidence.R @@ -0,0 +1,641 @@ +#' Combine content evidence across review stages +#' +#' @description +#' Brings the handoffs from several content-review stages together, so the +#' evidence for each item can be read, reported, and drawn as a whole. Give the +#' stages in the order they ran, such as an expert relevance panel and then an +#' item sort. Each stage can be a handoff from [content_handoff()] or a fitted +#' workflow, which is handed off with `keep`. +#' +#' The result prints one row per item, with each stage's decision beside the +#' statistic its rule read, and it draws two figures for a paper or poster: +#' +#' * `plot(x)`, the **item evidence profile**. One panel per stage shows the +#' statistic each decision read, its interval, and its criterion, and a last +#' column names the stages that held an item back. +#' * `plot(x, type = "flow")`, the **item flow diagram**. Each stage's box says +#' how many items it reviewed, a side box lists what it held back with the +#' number behind each decision, and the last box lists what was carried +#' forward. +#' +#' @details +#' **The statistic each stage shows** is the one its decision rule reads, taken +#' from the handoff: +#' +#' * an item sort: Psa, against the exact test's criterion; +#' * an expert relevance panel: the I-CVI, against Lynn's (1986) count; +#' * a Delphi study: the share of experts agreeing, against the consensus +#' threshold; +#' * an essentiality panel: the CVR, against the exact test's criterion; +#' * congruence ratings: the IOC margin over the strongest competing +#' objective, or the IOC when there is no target mapping; +#' * construct ratings: HTC, with no criterion, because that workflow decides +#' on its planned contrasts. +#' +#' Decisions are read from each handoff, never recomputed from the statistic. +#' +#' **Stages in sequence or side by side.** Usually a stage reviews only what +#' the stage before it carried forward, and the flow diagram reads that way. +#' When two methods reviewed the same items side by side, a stage's box says +#' how many of its items an earlier stage had already held back, and its side +#' box lists only the items it held back itself. Either way, an item is carried +#' forward when every stage that reviewed it carried it. +#' +#' @section Where the displays come from: +#' The flow diagram is modeled on the PRISMA 2020 flow diagram for systematic +#' reviews (Page et al., 2021), with items in place of studies. The evidence +#' profile is this package's own design. It sets out each stage's statistic as +#' a forest plot does, one panel per stage, so that agreement and disagreement +#' between methods can be seen item by item. Neither computes anything new: +#' both draw the statistics and decisions the stages already made. +#' +#' @param ... Handoffs from [content_handoff()], or fitted workflows that +#' [content_handoff()] accepts, in the order the stages ran. Name them to +#' label the stages, as in `content_evidence(Panel = h1, Sort = h2)`. +#' Unnamed stages are labeled by their workflow. +#' @param keep Statuses carried forward when a stage is given as a fitted +#' workflow rather than a handoff, as in [content_handoff()]. A handoff +#' already records what it carried, so `keep` does not change it. +#' +#' @return An object of class `contentvalid_evidence`, a list with: +#' \describe{ +#' \item{`stages`}{the handoffs, named by stage.} +#' \item{`items`}{every item reviewed, in the order first reviewed.} +#' \item{`evidence`}{one row per item per stage: `item`, `scale`, `stage`, +#' `statistic`, `value`, `lower`, `upper`, `level`, `criterion`, +#' `recommendation`, `status`, and `carried`. `as.data.frame()` returns +#' it.} +#' \item{`flow`}{for each stage, the items it reviewed, those an earlier +#' stage had already held back, those it held back itself, and those +#' carried so far that it did not review.} +#' \item{`carried`}{the items carried by every stage that reviewed them.} +#' } +#' +#' @references +#' Lynn, M. R. (1986). Determination and quantification of content validity. +#' *Nursing Research, 35*(6), 382–385. +#' \doi{10.1097/00006199-198611000-00017} +#' +#' Page, M. J., McKenzie, J. E., Bossuyt, P. M., Boutron, I., Hoffmann, T. C., +#' Mulrow, C. D., Shamseer, L., Tetzlaff, J. M., Akl, E. A., Brennan, S. E., +#' Chou, R., Glanville, J., Grimshaw, J. M., Hróbjartsson, A., Lalu, M. M., +#' Li, T., Loder, E. W., Mayo-Wilson, E., McDonald, S., . . . Moher, D. +#' (2021). The PRISMA 2020 statement: An updated guideline for reporting +#' systematic reviews. *BMJ, 372*, Article n71. \doi{10.1136/bmj.n71} +#' +#' @seealso [content_handoff()] for a single stage, and +#' [plot.contentvalid_evidence()] for the two figures. +#' +#' @examples +#' relevance <- matrix( +#' c(4,4,4,3, 4,4,3,4, 3,4,4,4, 2,2,1,2), +#' nrow = 4, +#' dimnames = list(NULL, paste0("Item", 1:4)) +#' ) +#' panel <- expert_validity(relevance, mode = "relevance", lo = 1, hi = 4, +#' agreement = "none") +#' # The sort reviews the three items the panel carried forward. +#' sorts <- data.frame( +#' item = rep(paste0("Item", 1:3), each = 12), +#' rater = rep(1:12, 3), +#' target_construct = rep(c("A", "A", "B"), each = 12), +#' assigned_construct = c(rep("A", 11), "B", rep("A", 10), "B", "B", +#' rep("B", 5), rep("A", 7)) +#' ) +#' evidence <- content_evidence(`Relevance panel` = panel, +#' `Item sort` = sort_validity(sorts)) +#' evidence +#' plot(evidence) +#' plot(evidence, type = "flow") +#' plot(evidence, apa = FALSE) +#' @export +content_evidence <- function(..., keep = "Supported") { + stages <- list(...) + if (!length(stages)) { + stop("Give at least one handoff or fitted workflow, in the order the ", + "stages ran.", call. = FALSE) + } + given <- names(stages) + if (is.null(given)) given <- rep("", length(stages)) + given[is.na(given)] <- "" + stages <- lapply(seq_along(stages), function(i) { + .evidence_as_handoff(stages[[i]], keep, i) + }) + labels <- ifelse(nzchar(given), given, + vapply(stages, .evidence_stage_label, character(1))) + dup <- duplicated(labels) | duplicated(labels, fromLast = TRUE) + labels[dup] <- sprintf("%s (stage %d)", labels[dup], which(dup)) + names(stages) <- labels + + evidence <- do.call(rbind, lapply(seq_along(stages), function(k) { + .evidence_rows(stages[[k]], labels[k]) + })) + rownames(evidence) <- NULL + items <- unique(evidence$item) + # One construct per item: the first stage that mapped it says which. + mapped <- evidence[!is.na(evidence$scale), , drop = FALSE] + scale <- mapped$scale[match(items, mapped$item)] + evidence$scale <- scale[match(evidence$item, items)] + + flow <- .evidence_flow(stages) + structure( + list(stages = stages, items = items, evidence = evidence, + flow = flow$stages, carried = items[items %in% flow$carried]), + class = "contentvalid_evidence" + ) +} + +.evidence_as_handoff <- function(x, keep, i) { + if (inherits(x, "cv_handoff")) { + v <- x$provenance$schema_version + if (!identical(as.integer(v), 1L)) { + stop(sprintf(paste("Stage %d is a handoff with schema version %s;", + "content_evidence() reads version 1."), i, format(v)), + call. = FALSE) + } + return(x) + } + if (inherits(x, "contentvalid_workflow")) return(content_handoff(x, keep = keep)) + stop(sprintf(paste("Stage %d is not a handoff or a fitted workflow. Give the", + "result of content_handoff(), or a fit such as", + "sort_validity() returns."), i), call. = FALSE) +} + +.evidence_stage_label <- function(h) { + mode <- as.character(h$provenance$mode) + switch(h$provenance$workflow, + "item-sort" = "Item sort", + "construct-rating" = "Construct rating", + "delphi" = "Delphi", + "expert-panel" = switch(mode, + relevance = "Relevance panel", + essentiality = "Essentiality panel", + congruence = "Congruence panel", + "Expert panel"), + h$provenance$workflow) +} + +# The statistic each workflow's decision rule reads, as the handoff names it. +.evidence_headline_stat <- function(h) { + wf <- h$provenance$workflow + mode <- as.character(h$provenance$mode) + have <- unique(h$item_statistics$statistic) + pick <- switch(wf, + "item-sort" = "Psa", + "construct-rating" = "HTC", + "delphi" = "I-CVI", + "expert-panel" = switch(mode, + relevance = "I-CVI", + essentiality = "CVR", + congruence = if ("IOC margin" %in% have) "IOC margin" + else "IOC", + NA_character_), + NA_character_) + if (is.na(pick) || !pick %in% have) { + stop("A ", wf, " handoff carries no statistic content_evidence() can ", + "show.", call. = FALSE) + } + pick +} + +# The name a reader sees. A Delphi handoff stores the share agreeing under +# "I-CVI", which is what it is, but the Delphi literature calls it agreement. +.evidence_display_stat <- function(stat, workflow) { + if (identical(workflow, "delphi")) "Share agreeing" else stat +} + +.evidence_rows <- function(h, label) { + stat <- .evidence_headline_stat(h) + s <- h$item_statistics[h$item_statistics$statistic == stat, , drop = FALSE] + ev <- h$item_evidence + idx <- match(ev$item, s$item) + col <- function(name) if (name %in% names(s)) s[[name]][idx] else rep(NA, nrow(ev)) + data.frame( + item = as.character(ev$item), + scale = as.character(ev$scale), + stage = label, + statistic = .evidence_display_stat(stat, h$provenance$workflow), + value = as.numeric(s$value[idx]), + lower = as.numeric(col("lower")), + upper = as.numeric(col("upper")), + level = as.numeric(col("interval_level")), + criterion = as.numeric(s$criterion[idx]), + recommendation = as.character(ev$recommendation), + status = as.character(ev$status), + carried = as.logical(ev$carried), + stringsAsFactors = FALSE + ) +} + +# What each stage reviewed and held back, reading the stages in order. An item +# stays in play until a stage that reviews it holds it back. +.evidence_flow <- function(stages) { + in_play <- character(0) + seen <- character(0) + out <- vector("list", length(stages)) + for (k in seq_along(stages)) { + ev <- stages[[k]]$item_evidence + reviewed <- unique(as.character(ev$item)) + already_out <- intersect(reviewed, setdiff(seen, in_play)) + added <- if (k == 1L) character(0) else setdiff(reviewed, seen) + not_reviewed <- setdiff(in_play, reviewed) + in_play <- if (k == 1L) reviewed else union(in_play, added) + held <- intersect(as.character(ev$item[!ev$carried]), in_play) + in_play <- setdiff(in_play, held) + seen <- union(seen, reviewed) + out[[k]] <- list(reviewed = reviewed, already_out = already_out, + added = added, not_reviewed = not_reviewed, held = held, + n_judges = ev$n_judges, workflow = stages[[k]]$provenance$workflow) + } + names(out) <- names(stages) + list(stages = out, carried = in_play) +} + +# "8 experts", "12 to 20 judges", or "judges not recorded". +.evidence_judges <- function(f) { + who <- if (f$workflow %in% c("expert-panel", "delphi")) "expert" else "judge" + nj <- f$n_judges[!is.na(f$n_judges)] + if (!length(nj)) return(paste0(who, "s not recorded")) + if (min(nj) == max(nj)) return(.n_noun(nj[1], who)) + sprintf("%d to %d %ss", min(nj), max(nj), who) +} + +# APA numbers: no leading zero, except for the IOC margin, which can exceed 1. +.evidence_value_text <- function(value, statistic) { + statistic <- rep_len(statistic, length(value)) + out <- .fmt(value, bounded = TRUE) + wide <- statistic %in% "IOC margin" + out[wide] <- .fmt(value[wide], bounded = FALSE) + out +} + +.evidence_verdicts <- function(x) { + ev <- x$evidence + vapply(x$items, function(it) { + rows <- ev[ev$item == it, , drop = FALSE] + if (it %in% x$carried) return("carried") + held_by <- rows$stage[!rows$carried] + if (!length(held_by)) return("carried") + paste("held back:", paste(held_by, collapse = "; ")) + }, character(1), USE.NAMES = FALSE) +} + +#' @export +print.contentvalid_evidence <- function(x, ...) { + ns <- length(x$stages) + title <- sprintf("Content evidence across %s", .n_noun(ns, "stage")) + cat(title, "\n", strrep("-", nchar(title)), "\n", sep = "") + verdict <- .evidence_verdicts(x) + held <- x$items[verdict != "carried"] + first_holder <- vapply(held, function(it) { + rows <- x$evidence[x$evidence$item == it & !x$evidence$carried, ] + rows$stage[1] + }, character(1)) + .say(sprintf("%d of %s carried by every stage that reviewed %s.", + length(x$carried), .n_noun(length(x$items), "item"), + if (length(x$items) == 1L) "it" else "them"), + if (length(held)) { + paste0("Held back: ", paste(sprintf("%s (%s)", held, first_holder), + collapse = ", "), ".") + }) + + cat("\nStages, in order\n") + for (k in seq_len(ns)) { + f <- x$flow[[k]] + stat <- x$evidence$statistic[x$evidence$stage == names(x$stages)[k]][1] + .say(sprintf("%d. %s: %s, %s. Shows %s.", k, names(x$stages)[k], + .n_noun(length(f$reviewed), "item"), .evidence_judges(f), + stat), + indent = 2L, exdent = 5L) + } + + cat("\n") + tab <- data.frame(item = x$items, stringsAsFactors = FALSE) + for (lab in names(x$stages)) { + rows <- x$evidence[x$evidence$stage == lab, , drop = FALSE] + i <- match(x$items, rows$item) + cell <- ifelse(is.na(i), "--", + paste(.evidence_value_text(rows$value[i], rows$statistic[i]), + rows$recommendation[i])) + tab[[lab]] <- cell + } + tab$result <- verdict + .print_table(tab) + + if (.show_key()) { + stats <- unique(x$evidence$statistic) + term <- c(Psa = "psa", `I-CVI` = "I_CVI", `Share agreeing` = "prop_agree", + CVR = "cvr", `IOC margin` = "ioc", IOC = "ioc", HTC = "htc") + known <- stats[stats %in% names(term)] + .print_key(unname(term[known]), headings = known) + cat(strwrap(paste("result -- carried when every stage that reviewed the", + "item carried it; otherwise the stages that held it", + "back. -- marks a stage that did not review the item."), + width = 76, initial = " ", prefix = " "), sep = "\n") + cat("\nFigures: plot(x) for the evidence profile, plot(x, type = \"flow\")", + "\nfor the flow diagram; add apa = FALSE for color.\n", sep = "") + .print_key_footer() + } + invisible(x) +} + +#' @export +as.data.frame.contentvalid_evidence <- function(x, row.names = NULL, + optional = FALSE, ...) { + out <- x$evidence + if (!is.null(row.names)) rownames(out) <- row.names + out +} + +#' Plot content evidence across review stages +#' +#' @description +#' Draws the two figures of [content_evidence()]. +#' +#' `type = "profile"` (default), the item evidence profile, gives one panel +#' per stage with the items down the side. Each panel shows the statistic that +#' stage's decision read, its interval as a bar, and its criterion as a dashed +#' line. A filled symbol met the criterion, an open one was flagged for review, +#' and a cross marks no decision. "not reviewed" marks an item a stage did not +#' see. The last column says whether each item was carried, or names the +#' stages that held it back. Faint lines separate the constructs. +#' +#' `type = "flow"`, the item flow diagram, follows the items through the +#' stages, modeled on the PRISMA 2020 flow diagram (Page et al., 2021). Each +#' stage's box gives how many items it reviewed and by how many judges; its +#' side box lists each item it held back, with the decision and the number +#' behind it; and the last box lists the items carried forward, by construct. +#' +#' @param x A `contentvalid_evidence` object. +#' @param type `"profile"` or `"flow"`. +#' @param apa `TRUE` (default) draws in black, white, and gray, as an APA +#' figure is printed. `FALSE` marks evidence that met its criterion in teal +#' and evidence under review in brown, a colorblind-safe scheme for slides +#' and posters. Symbols carry the decision either way, so neither reading +#' depends on color. +#' @param show_legend Draw the key above the profile. Default `TRUE`. +#' @param ... Additional graphical arguments passed to [graphics::plot()] for +#' each panel of the profile. The flow diagram does not use them. +#' +#' @return `x`, invisibly. Called for the plot it draws. +#' +#' @references +#' Page, M. J., McKenzie, J. E., Bossuyt, P. M., Boutron, I., Hoffmann, T. C., +#' Mulrow, C. D., Shamseer, L., Tetzlaff, J. M., Akl, E. A., Brennan, S. E., +#' Chou, R., Glanville, J., Grimshaw, J. M., Hróbjartsson, A., Lalu, M. M., +#' Li, T., Loder, E. W., Mayo-Wilson, E., McDonald, S., . . . Moher, D. +#' (2021). The PRISMA 2020 statement: An updated guideline for reporting +#' systematic reviews. *BMJ, 372*, Article n71. \doi{10.1136/bmj.n71} +#' +#' @seealso [content_evidence()]. +#' +#' @examples +#' relevance <- matrix( +#' c(4,4,4,3, 4,4,3,4, 3,4,4,4, 2,2,1,2), +#' nrow = 4, +#' dimnames = list(NULL, paste0("Item", 1:4)) +#' ) +#' panel <- expert_validity(relevance, mode = "relevance", lo = 1, hi = 4, +#' agreement = "none") +#' sorts <- data.frame( +#' item = rep(paste0("Item", 1:3), each = 12), +#' rater = rep(1:12, 3), +#' target_construct = rep(c("A", "A", "B"), each = 12), +#' assigned_construct = c(rep("A", 11), "B", rep("A", 10), "B", "B", +#' rep("B", 5), rep("A", 7)) +#' ) +#' evidence <- content_evidence(`Relevance panel` = panel, +#' `Item sort` = sort_validity(sorts)) +#' plot(evidence) +#' plot(evidence, type = "flow", apa = FALSE) +#' @export +plot.contentvalid_evidence <- function(x, type = c("profile", "flow"), + apa = TRUE, show_legend = TRUE, ...) { + type <- match.arg(type) + .validate_flag(apa, "apa") + .validate_flag(show_legend, "show_legend") + if (type == "flow") { + .plot_evidence_flow(x, apa) + } else { + .plot_evidence_profile(x, apa, show_legend, ...) + } + invisible(x) +} + +.plot_evidence_profile <- function(x, apa, show_legend, ...) { + ev <- x$evidence + items <- x$items + n <- length(items) + y <- rev(seq_len(n)) + stages <- names(x$stages) + ns <- length(stages) + pal <- .evidence_colours(apa) + + # Faint lines between constructs, drawn only when the items come grouped by + # construct; items no stage mapped are passed over. + scale <- ev$scale[match(items, ev$item)] + known <- scale + for (i in seq_along(known)[-1]) if (is.na(known[i])) known[i] <- known[i - 1] + runs <- rle(known[!is.na(known)])$values + breaks <- if (length(runs) == length(unique(runs)) && length(runs) > 1L) { + which(!is.na(known[-1]) & !is.na(known[-n]) & known[-1] != known[-n]) + } else integer(0) + + 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), + 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)) + + any_ci <- FALSE + any_crit <- FALSE + shown <- character(0) + for (k in seq_len(ns)) { + s <- ev[ev$stage == stages[k], , drop = FALSE] + stat <- s$statistic[1] + xlim <- switch(stat, CVR = c(-1, 1), 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 = "", ...) + 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 (length(breaks)) graphics::abline(h = y[breaks] - 0.5, col = "grey80") + row <- match(s$item, items) + crit <- unique(s$criterion[is.finite(s$criterion)]) + if (length(crit) == 1L) { + graphics::abline(v = crit, lty = 2) + any_crit <- TRUE + } else if (length(crit) > 1L) { + # A criterion that differs by item is marked on its own row. + ok <- is.finite(s$criterion) + graphics::segments(s$criterion[ok], y[row][ok] - 0.3, s$criterion[ok], + y[row][ok] + 0.3, lty = 2) + any_crit <- TRUE + } + col <- .status_colour(s$status, apa) + ok <- is.finite(s$lower) & is.finite(s$upper) + if (any(ok)) { + graphics::segments(s$lower[ok], y[row][ok], s$upper[ok], y[row][ok], + col = col[ok]) + any_ci <- TRUE + } + graphics::points(s$value, y[row], pch = .status_pch(s$status), col = col, + cex = 1.15) + shown <- c(shown, s$status) + missing <- setdiff(items, s$item) + if (length(missing)) { + graphics::text(mean(xlim), y[match(missing, items)], "not reviewed", + cex = 0.72, col = "grey40", font = 3) + } + graphics::mtext(stages[k], side = 3, line = 0.5, cex = 0.8, font = 2) + } + + graphics::plot(NA, xlim = c(0, 1), ylim = c(0.4, n + 0.6), axes = FALSE, + xlab = "", ylab = "") + graphics::mtext("Across stages", side = 3, line = 0.5, cex = 0.8, font = 2) + if (length(breaks)) graphics::abline(h = y[breaks] - 0.5, col = "grey80") + verdict <- .evidence_verdicts(x) + held <- verdict != "carried" + graphics::text(0.02, y, verdict, adj = 0, cex = 0.78, + font = ifelse(held, 2, 1), + col = ifelse(held, pal$review, pal$met), xpd = NA) + + if (isTRUE(show_legend)) { + level <- unique(ev$level[is.finite(ev$level)]) + parts <- c( + if (any(shown %in% "Supported")) "Filled: met the criterion.", + if (any(shown %in% "Review")) "Open: review.", + if (any(!shown %in% c("Supported", "Review"))) "Cross: no decision.", + if (any_crit) "Dashed line: criterion.", + if (any_ci) { + if (length(level) == 1L) sprintf("Bar: %s%% interval.", format(100 * level)) + else "Bar: interval." + } + ) + graphics::mtext(paste(parts, collapse = " "), side = 3, outer = TRUE, + line = 0.2, cex = 0.72) + } + invisible(NULL) +} + +.plot_evidence_flow <- function(x, apa) { + pal <- .evidence_colours(apa) + ev <- x$evidence + op <- graphics::par(mar = c(0.3, 0.3, 0.3, 0.3)) + on.exit(graphics::par(op), add = TRUE) + graphics::plot.new() + graphics::plot.window(xlim = c(0, 1), ylim = c(0, 1), xaxs = "i", yaxs = "i") + + # Every box's text first, so the diagram can be sized to the page. + rows <- lapply(seq_along(x$flow), function(k) { + f <- x$flow[[k]] + main <- c(sprintf("Stage %d: %s", k, names(x$flow)[k]), + sprintf("%s reviewed by %s", .n_noun(length(f$reviewed), "item"), + .evidence_judges(f))) + if (length(f$already_out)) { + main <- c(main, sprintf("including %s already held back", + .n_noun(length(f$already_out), "item"))) + } + if (length(f$added)) { + main <- c(main, sprintf("including %s not reviewed before", + .n_noun(length(f$added), "item"))) + } + if (length(f$not_reviewed)) { + main <- c(main, sprintf("%s carried so far not reviewed here", + .n_noun(length(f$not_reviewed), "item"))) + } + s <- ev[ev$stage == names(x$flow)[k], , drop = FALSE] + side <- sprintf("Held back: %d", length(f$held)) + if (!length(f$held)) side <- c(side, "none") + for (it in f$held) { + r <- s[s$item == it, , drop = FALSE][1, ] + number <- if (is.finite(r$value)) { + txt <- paste(r$statistic, .evidence_value_text(r$value, r$statistic)) + if (is.finite(r$criterion)) { + txt <- paste0(txt, ", criterion ", + .evidence_value_text(r$criterion, r$statistic)) + } + txt + } else "" + side <- c(side, sprintf("%s (%s)%s", it, r$recommendation, + if (nzchar(number)) paste0(": ", number) else "")) + } + list(main = main, side = side) + }) + final <- sprintf("Carried forward: %s", .n_noun(length(x$carried), "item")) + scale <- ev$scale[match(x$carried, ev$item)] + if (any(!is.na(scale))) { + groups <- unique(scale) + for (g in groups) { + its <- x$carried[if (is.na(g)) is.na(scale) else scale %in% g] + lab <- if (is.na(g)) "Unmapped" else g + final <- c(final, strwrap(sprintf("%s (%d): %s", lab, length(its), + paste(its, collapse = ", ")), + width = 52, exdent = 4)) + } + } else if (length(x$carried)) { + final <- c(final, strwrap(paste(x$carried, collapse = ", "), width = 52)) + } + + main_x <- c(0.02, 0.47) + side_x <- c(0.54, 0.98) + # Shrink the text until the widest line fits its box and the whole diagram + # fits the page. + cex <- 0.85 + widest <- function(lines, width) { + max(graphics::strwidth(lines, cex = cex, font = 2)) / width + } + need <- max(unlist(lapply(rows, function(r) { + c(widest(r$main, diff(main_x)), widest(r$side, diff(side_x))) + })), widest(final, diff(main_x))) + if (need > 0.94) cex <- cex * 0.94 / need + line_h <- function() { + graphics::par("cin")[2] * cex * 1.3 / graphics::par("pin")[2] + } + box_h <- function(nl) line_h() * (nl + 0.7) + heights <- function() { + row_h <- vapply(rows, function(r) max(box_h(length(r$main)), + box_h(length(r$side))), numeric(1)) + list(row = row_h, gap = line_h() * 2.2, + total = sum(row_h) + line_h() * 2.2 * length(rows) + + box_h(length(final))) + } + hs <- heights() + if (hs$total > 0.96) { + cex <- cex * 0.96 / hs$total + hs <- heights() + } + + draw_box <- function(x0, x1, top, lines, fill) { + lh <- line_h() + h <- lh * (length(lines) + 0.7) + graphics::rect(x0, top - h, x1, top, col = fill, border = pal$border) + for (i in seq_along(lines)) { + graphics::text((x0 + x1) / 2, top - lh * (i - 0.15), lines[i], cex = cex, + font = if (i == 1L) 2 else 1) + } + top - h + } + + top <- 0.5 + hs$total / 2 + for (k in seq_along(rows)) { + r <- rows[[k]] + mid <- top - hs$row[k] / 2 + bottom <- draw_box(main_x[1], main_x[2], mid + box_h(length(r$main)) / 2, + r$main, pal$stage) + draw_box(side_x[1], side_x[2], mid + box_h(length(r$side)) / 2, r$side, + pal$held) + graphics::arrows(main_x[2], mid, side_x[1], mid, length = 0.07) + next_top <- top - hs$row[k] - hs$gap + graphics::arrows(mean(main_x), bottom, mean(main_x), next_top, + length = 0.07) + top <- next_top + } + draw_box(main_x[1], main_x[2], top, final, pal$final) + invisible(NULL) +} diff --git a/R/content_handoff.R b/R/content_handoff.R index 798f986..58276ee 100644 --- a/R/content_handoff.R +++ b/R/content_handoff.R @@ -962,8 +962,10 @@ print.contentvalid_handoff <- function(x, ...) { cat("\n") .say("Carry these items into the empirical workflow once response data are", "collected. In nomologR that is") - cat(" nomo_screen(data, items = handoff$items)\n") - .say("which screens the same items you retained here.") + cat(" nomo_screen(data, items = handoff)\n") + .say("which screens the items carried here. Passing the whole handoff,", + "rather than handoff$items, keeps the keying and the reasons for", + "anything held back.") cat("\n") .say("Surviving content review is evidence about relevance, representation,", diff --git a/R/contentvalidR-package.R b/R/contentvalidR-package.R index 9ae3c5d..e036961 100644 --- a/R/contentvalidR-package.R +++ b/R/contentvalidR-package.R @@ -14,8 +14,9 @@ #' and `plot()` methods; 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_report()], [compare_rounds()], -#' [as.data.frame.contentvalid_workflow()], and [contentvalid_glossary()]. +#' only`); and [content_handoff()], [content_evidence()], [content_report()], +#' [compare_rounds()], [as.data.frame.contentvalid_workflow()], and +#' [contentvalid_glossary()]. #' #' Tier 1 will not change in a way that breaks working code except across a #' major version, and never without the deprecation cycle below. diff --git a/R/delphi_validity.R b/R/delphi_validity.R index f2fbf8f..addfab6 100644 --- a/R/delphi_validity.R +++ b/R/delphi_validity.R @@ -998,13 +998,33 @@ print.contentvalid_delphi <- function(x, digits = 2, ...) { #' "good" region would mislead exactly when a Delphi is succeeding. See #' [delphi_validity()]. #' +#' `which = "distribution"` draws every rating in every round as a diverging +#' stacked bar (Heiberger & Robbins, 2014), one bar per round for each item, +#' split at `agree_cut`. The right-hand length is the share agreeing, read +#' against the dashed consensus threshold, and the symbol beside it is that +#' round's consensus decision. Rounds in which an item was not rated, because +#' it had been set aside, are marked "not rated". +#' #' @param x A fitted `contentvalid_delphi` object. -#' @param which `"consensus"` (default) or `"stability"`. +#' @param which `"consensus"` (default), `"stability"`, or `"distribution"`. #' @param show_legend Draw the legend. Defaults to `TRUE`. +#' @param apa Used by `which = "distribution"`. `TRUE` (default) draws in +#' gray, with darker meaning a higher rating, as an APA figure is printed. +#' `FALSE` draws ratings below the agreement cut in brown and ratings at or +#' above it in teal, a colorblind-safe scheme for slides and posters. The +#' consensus and stability views color each item's line so the lines can be +#' told apart. +#' @param labels For `which = "distribution"`, one label per rating category, +#' lowest first. Defaults to `"Rated 1"`, `"Rated 2"`, and so on. #' @param ... Passed to [graphics::plot()]. #' #' @return `x`, invisibly. Called for the plot it draws. #' +#' @references +#' 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. \doi{10.18637/jss.v057.i05} +#' #' @seealso [delphi_validity()]. #' #' @examples @@ -1019,11 +1039,49 @@ print.contentvalid_delphi <- function(x, digits = 2, ...) { #' consensus_threshold = 0.75, B = 0) #' plot(fit) #' plot(fit, which = "stability") +#' plot(fit, which = "distribution") #' @export -plot.contentvalid_delphi <- function(x, which = c("consensus", "stability"), - show_legend = TRUE, ...) { +plot.contentvalid_delphi <- function(x, + which = c("consensus", "stability", + "distribution"), + show_legend = TRUE, apa = TRUE, + labels = NULL, ...) { which <- match.arg(which) .validate_flag(show_legend, "show_legend") + .validate_flag(apa, "apa") + if (which == "distribution") { + fits <- x$details$round_fits + ratings <- lapply(fits, function(f) f$details$ratings) + if (!length(fits) || any(vapply(ratings, is.null, logical(1)))) { + stop("This fit does not carry its ratings, because it was made by an ", + "earlier version of contentvalidR. Fit it again to draw the ", + "distribution view.", call. = FALSE) + } + rounds <- x$design$rounds + # Numbered rounds read as R1, R2; named rounds keep their names. + round_labels <- as.character(rounds) + if (all(grepl("^[0-9]+$", round_labels))) { + round_labels <- paste0("R", round_labels) + } + names(ratings) <- round_labels + cons <- x$details$consensus + # The symbol is each round's own consensus decision, as the fit made it. + status <- lapply(rounds, function(rd) { + cr <- cons[cons$round == rd, , drop = FALSE] + st <- ifelse(is.na(cr$consensus), "Descriptive only", + ifelse(cr$consensus, "Supported", "Review")) + stats::setNames(st, cr$item) + }) + threshold <- x$settings$consensus_threshold + .plot_rating_distribution( + 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)", + labels = labels, apa = apa, show_legend = show_legend, ... + ) + return(invisible(x)) + } op <- .plot_margins(list(...)) on.exit(graphics::par(op), add = TRUE) rounds <- x$design$rounds diff --git a/R/expert_validity.R b/R/expert_validity.R index 747c500..4e7ea0e 100644 --- a/R/expert_validity.R +++ b/R/expert_validity.R @@ -340,6 +340,9 @@ expert_validity <- function(data, design = design, details = list( cvi = cv, agreement = agree, + # Kept for plot(type = "distribution"), which draws every rating + # rather than the share that met the cut. + ratings = R, # The ratings' columns are the items in `item`'s order, which is how # aikens_v() returns them. earlier_methods = .relevance_earlier_methods( @@ -796,22 +799,75 @@ print.summary.contentvalid_expert <- function(x, digits = 2, ...) { #' for its intended objective against its strongest competitor, when a target #' mapping is available. #' +#' In relevance mode, `type = "distribution"` draws every expert's rating as +#' a diverging stacked bar (Heiberger & Robbins, 2014), split at the relevance +#' cut. Ratings below the cut extend left and ratings at or above it extend +#' right, so the right-hand length is the item's I-CVI, read against the dashed +#' criterion line. The number beside each bar is that I-CVI, and the symbol is +#' the decision the fit made. It shows what the index cannot: two items with +#' the same I-CVI, one rated relevant with 4s and the other with 3s. +#' #' @param x A `contentvalid_expert` object. #' @param show_legend Logical; draw the compact plot key. Default `TRUE`. +#' @param type `"item"` (default) for the evidence plot described above, or +#' `"distribution"` for the rating distributions (relevance mode only). +#' @param apa Used by `type = "distribution"`. `TRUE` (default) draws in gray, +#' with darker meaning a higher rating, as an APA figure is printed. `FALSE` +#' draws ratings below the cut in brown and ratings at or above it in teal, +#' a colorblind-safe scheme for slides and posters. The symbol beside each +#' bar carries the decision either way. The `"item"` plot is always gray. +#' @param labels For `type = "distribution"`, one label per rating category, +#' lowest first, such as `c("Not relevant", "Somewhat relevant", "Quite +#' relevant", "Highly relevant")`. Defaults to `"Rated 1"`, `"Rated 2"`, +#' and so on. #' @param ... Additional graphical arguments passed to [graphics::plot()]. #' @return The input object invisibly. +#' @references +#' 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. \doi{10.18637/jss.v057.i05} #' @examples #' relevance <- matrix( #' c(4,4,4,3, 4,4,3,4, 3,4,4,4, 4,3,4,4), #' nrow = 4, #' dimnames = list(NULL, paste0("Item", 1:4)) #' ) -#' plot(expert_validity(relevance, mode = "relevance", lo = 1, hi = 4, -#' agreement = "none")) +#' fit <- expert_validity(relevance, mode = "relevance", lo = 1, hi = 4, +#' agreement = "none") +#' plot(fit) +#' plot(fit, type = "distribution") +#' plot(fit, type = "distribution", apa = FALSE) #' plot(expert_validity(c(10, 8, 6), mode = "essentiality", N = 12)) #' @export -plot.contentvalid_expert <- function(x, show_legend = TRUE, ...) { +plot.contentvalid_expert <- function(x, show_legend = TRUE, + type = c("item", "distribution"), + apa = TRUE, labels = NULL, ...) { .validate_flag(show_legend, "show_legend") + .validate_flag(apa, "apa") + type <- match.arg(type) + if (type == "distribution") { + if (!identical(x$mode, "relevance")) { + stop("The distribution view draws relevance ratings, so it needs a ", + "relevance-mode fit.", call. = FALSE) + } + R <- x$details$ratings + if (is.null(R)) { + stop("This fit does not carry its ratings, because it was made by an ", + "earlier version of contentvalidR. Fit it again to draw the ", + "distribution view.", call. = FALSE) + } + r <- x$results + crit <- unique(r$cvi_criterion[is.finite(r$cvi_criterion)]) + .plot_rating_distribution( + rounds = list(R), items = as.character(r$item), lo = x$settings$lo, + 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)", + labels = labels, apa = apa, show_legend = show_legend, ... + ) + return(invisible(x)) + } op <- .plot_margins(list(...)) on.exit(graphics::par(op), add = TRUE) r <- x$results diff --git a/R/plot_distribution.R b/R/plot_distribution.R new file mode 100644 index 0000000..93aaa8f --- /dev/null +++ b/R/plot_distribution.R @@ -0,0 +1,131 @@ +# The full distribution of a panel's ratings, as diverging stacked bars +# (Heiberger & Robbins, 2014), shared by plot(, type = +# "distribution") and plot(, which = "distribution"). +# +# Each bar splits at the cut the decision rule uses: ratings below it extend +# left of zero and ratings at or above it extend right, so the right-hand +# length is exactly the share the rule counts (the I-CVI, or the share +# agreeing). The number printed beside the bar is that share, and the symbol +# is the decision the fit made, taken from the fit rather than recomputed. + +# `rounds`: a named list of rating matrices (raters in rows, items in +# columns), one per round, drawn as adjacent bars for each item. +# `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, + show_legend, ...) { + k <- as.integer(hi - lo + 1) + cats <- seq(lo, hi) + if (is.null(labels)) labels <- paste("Rated", cats) + if (!is.character(labels) || length(labels) != k || anyNA(labels)) { + stop(sprintf("`labels` must be %d labels, one for each rating from %s to %s.", + k, format(lo), format(hi)), call. = FALSE) + } + n_below <- sum(cats < cut) + fills <- .rating_fills(k, n_below, apa) + border <- if (isTRUE(apa)) "grey35" else "white" + pal <- .evidence_colours(apa) + + n <- length(items) + nr <- length(rounds) + step <- nr + 0.6 + ypos <- function(i, r) (n - i) * step + (nr - r) + 1 + top <- n * step + 0.2 + round_names <- names(rounds) + + 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[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", ...) + 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") + + drawn <- character(0) + for (i in seq_len(n)) { + for (r in seq_len(nr)) { + yc <- ypos(i, r) + m <- rounds[[r]] + x <- if (items[i] %in% colnames(m)) m[, items[i]] else numeric(0) + x <- x[!is.na(x)] + if (nr > 1L) { + graphics::axis(2, at = yc, labels = round_names[r], las = 1, + tick = FALSE, line = -0.6, cex.axis = 0.7, + col.axis = "grey30") + } + if (!length(x)) { + graphics::text(0.03, yc, "not rated", adj = 0, cex = 0.7, + col = "grey40", font = 3) + next + } + p <- tabulate(as.integer(round(x - lo)) + 1L, k) / length(x) + # Nearest the cut first, so the extremes sit at the outer ends. + left <- 0 + for (j in rev(which(cats < cut))) { + graphics::rect(left - p[j], yc - 0.38, left, yc + 0.38, + col = fills[j], border = border, lwd = 0.5) + left <- left - p[j] + } + right <- 0 + for (j in which(cats >= cut)) { + graphics::rect(right, yc - 0.38, right + p[j], yc + 0.38, + col = fills[j], border = border, lwd = 0.5) + right <- right + p[j] + } + st <- status[[r]][items[i]] + if (is.null(st) || length(st) == 0L) st <- NA_character_ + drawn <- c(drawn, st) + graphics::points(1.06, yc, pch = .status_pch(st), cex = 0.85, + col = .status_colour(st, apa), xpd = NA) + 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, + 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. + if (length(criterion) == 1L && is.finite(criterion)) { + graphics::segments(criterion, 0.4, criterion, top, lty = 2, lwd = 1.2) + } + graphics::text(1.06, top + 0.35, value_label, adj = 0, cex = 0.75, font = 2, + xpd = NA) + + if (isTRUE(show_legend)) { + # Two rows in the top margin: the rating categories, then what the lines + # and symbols mean. Only what the figure draws is listed. + to_user <- function(inch) { + graphics::grconvertY(inch, "inches", "user") + } + top_in <- graphics::grconvertY(graphics::par("usr")[4], "user", "inches") + row <- graphics::par("csi") * 0.95 + graphics::legend(x = 0, y = to_user(top_in + 2.05 * row), xjust = 0.5, + yjust = 0.5, legend = labels, fill = fills, + border = border, horiz = TRUE, bty = "n", cex = 0.72, + x.intersp = 0.5, xpd = NA) + has_crit <- length(criterion) == 1L && is.finite(criterion) + # Anything other than met or review draws a cross: no decision was made. + shown <- ifelse(drawn %in% c("Supported", "Review"), drawn, "None") + sts <- intersect(c("Supported", "Review", "None"), unique(shown)) + words <- c(Supported = "Met the criterion", Review = "Review", + None = "No decision") + lab2 <- c(if (has_crit) "Criterion", unname(words[sts])) + args <- list(x = 0, y = to_user(top_in + 0.95 * row), xjust = 0.5, + yjust = 0.5, legend = lab2, + pch = c(if (has_crit) NA, .status_pch(sts)), + col = c(if (has_crit) "black", .status_colour(sts, apa)), + horiz = TRUE, bty = "n", cex = 0.72, x.intersp = 0.6, + seg.len = 1.6, xpd = NA) + # legend() cannot draw a key whose line types are all missing, so the line + # type is passed only when the criterion line is drawn. + if (has_crit) args$lty <- c(2, rep(NA, length(sts))) + do.call(graphics::legend, args) + } + invisible(NULL) +} diff --git a/R/plot_helpers.R b/R/plot_helpers.R index f3a6d0c..fd6ba89 100644 --- a/R/plot_helpers.R +++ b/R/plot_helpers.R @@ -77,3 +77,49 @@ .hline <- function(y, lty = 3) { graphics::abline(h = y, lty = lty) } + +# Colors for the displays that take `apa`. With apa = TRUE everything is +# black, white, and gray, as an APA figure is printed. With apa = FALSE, teal +# marks evidence that met its criterion and brown evidence under review, from +# the colorblind-safe brown-teal diverging scheme. The plotting symbol still +# carries the decision in both, so no reading depends on color alone. +.evidence_colours <- function(apa) { + if (isTRUE(apa)) { + list(met = "black", review = "black", none = "grey40", + stage = "white", held = "grey93", final = "grey85", border = "grey20") + } else { + list(met = "#01665E", review = "#8C510A", none = "grey40", + stage = "white", held = "#F6E8C3", final = "#C7EAE5", border = "grey20") + } +} + +# The color of each decision, from its shared status. +.status_colour <- function(status, apa) { + pal <- .evidence_colours(apa) + ifelse(status %in% "Supported", pal$met, + ifelse(status %in% "Review", pal$review, pal$none)) +} + +# One plotting symbol per shared status: met (filled), review (open), no +# decision (cross), as .decision_pch() draws from the workflow's own words. +.status_pch <- function(status) { + ifelse(status %in% "Supported", 19L, ifelse(status %in% "Review", 1L, 4L)) +} + +# One fill per rating category, lowest first. In gray, darker means a higher +# rating. In color, ratings below the cut are brown and ratings at or above it +# teal, each deeper the further it lies from the cut. +.rating_fills <- function(k, n_below, apa) { + if (isTRUE(apa)) return(grDevices::grey(seq(0.93, 0.22, length.out = k))) + n_above <- k - n_below + below <- if (n_below > 0L) { + grDevices::colorRampPalette(c("#A6611A", "#DFC27D"))(max(n_below, 2L)) + } + above <- if (n_above > 0L) { + grDevices::colorRampPalette(c("#80CDC1", "#018571"))(max(n_above, 2L)) + } + # With one category on a side, use the shade nearest the cut. + if (n_below == 1L) below <- below[2L] + if (n_above == 1L) above <- above[1L] + c(below, above) +} diff --git a/README.Rmd b/README.Rmd index 59736c1..72c836d 100644 --- a/README.Rmd +++ b/README.Rmd @@ -160,6 +160,7 @@ Works cited in this README, the help pages, and the vignettes. - Glorfeld, L. W. (1995). An improvement on Horn's parallel analysis methodology for selecting the correct number of factors to retain. *Educational and Psychological Measurement, 55*(3), 377–393. https://doi.org/10.1177/0013164495055003002 - Gwet, K. L. (2008). Computing inter-rater reliability and its variance in the presence of high agreement. *British Journal of Mathematical and Statistical Psychology, 61*(1), 29–48. https://doi.org/10.1348/000711006X126600 - Hayes, A. F., & Krippendorff, K. (2007). Answering the call for a standard reliability measure for coding data. *Communication Methods and Measures, 1*(1), 77–89. https://doi.org/10.1080/19312450709336664 +- 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 @@ -173,6 +174,7 @@ Works cited in this README, the help pages, and the vignettes. - Linacre, J. M. (1989). *Many-facet Rasch measurement*. MESA Press. - Lynn, M. R. (1986). Determination and quantification of content validity. *Nursing Research, 35*(6), 382–385. https://doi.org/10.1097/00006199-198611000-00017 - Newcombe, R. G. (1998). Two-sided confidence intervals for the single proportion: Comparison of seven methods. *Statistics in Medicine, 17*(8), 857–872. https://doi.org/10/cpchjg +- Page, M. J., McKenzie, J. E., Bossuyt, P. M., Boutron, I., Hoffmann, T. C., Mulrow, C. D., Shamseer, L., Tetzlaff, J. M., Akl, E. A., Brennan, S. E., Chou, R., Glanville, J., Grimshaw, J. M., Hróbjartsson, A., Lalu, M. M., Li, T., Loder, E. W., Mayo-Wilson, E., McDonald, S., . . . Moher, D. (2021). The PRISMA 2020 statement: An updated guideline for reporting systematic reviews. *BMJ, 372*, Article n71. https://doi.org/10.1136/bmj.n71 - Penfield, R. D., & Giacobbi, P. R., Jr. (2004). Applying a score confidence interval to Aiken's item content-relevance index. *Measurement in Physical Education and Exercise Science, 8*(4), 213–225. https://doi.org/10.1207/S15327841MPEE0804_3 - Polit, D. F., & Beck, C. T. (2006). The content validity index: Are you sure you know what's being reported? Critique and recommendations. *Research in Nursing & Health, 29*(5), 489–497. https://doi.org/10.1002/nur.20147 - Polit, D. F., Beck, C. T., & Owen, S. V. (2007). Is the CVI an acceptable indicator of content validity? Appraisal and recommendations. *Research in Nursing & Health, 30*(4), 459–467. https://doi.org/10.1002/nur.20199 diff --git a/README.md b/README.md index 70789fe..d38e985 100644 --- a/README.md +++ b/README.md @@ -341,6 +341,10 @@ Works cited in this README, the help pages, and the vignettes. standard reliability measure for coding data. *Communication Methods and Measures, 1*(1), 77–89. +- 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. + - Hernández-Nieto, R. (2002). *Contributions to statistical analysis: The coefficients of proportional variance, content validity and kappa*. BookSurge. @@ -381,6 +385,13 @@ Works cited in this README, the help pages, and the vignettes. - Newcombe, R. G. (1998). Two-sided confidence intervals for the single proportion: Comparison of seven methods. *Statistics in Medicine, 17*(8), 857–872. +- Page, M. J., McKenzie, J. E., Bossuyt, P. M., Boutron, I., + Hoffmann, T. C., Mulrow, C. D., Shamseer, L., Tetzlaff, J. M., Akl, E. + A., Brennan, S. E., Chou, R., Glanville, J., Grimshaw, J. M., + Hróbjartsson, A., Lalu, M. M., Li, T., Loder, E. W., Mayo-Wilson, E., + McDonald, S., . . . Moher, D. (2021). The PRISMA 2020 statement: An + updated guideline for reporting systematic reviews. *BMJ, 372*, + Article n71. - Penfield, R. D., & Giacobbi, P. R., Jr. (2004). Applying a score confidence interval to Aiken’s item content-relevance index. *Measurement in Physical Education and Exercise Science, 8*(4), diff --git a/ROADMAP.md b/ROADMAP.md index f61575f..5dd5226 100644 --- a/ROADMAP.md +++ b/ROADMAP.md @@ -846,6 +846,22 @@ reads no handoffs and takes no part in the joint 1.0. - [x] `?content_handoff` says a reader takes each decision from `carried` and `status`, never re-deriving it from the statistics or the producer version. +- Displays for papers, posters, and teaching, asked for by the maintainer on + 2026-09-28 to go in before 1.0. Graphics are the one place the maintainer + welcomes going beyond the literature, so each display says whether it + follows a published form or is this package's own design. None computes + anything new: each draws what the fits and handoffs already decided. All + take `apa`: gray by default, as an APA figure is printed, or a + colorblind-safe scheme with teal for evidence that met its criterion and + brown for evidence under review. Symbols carry the decision either way. + - [x] `content_evidence()` combines handoffs across review stages. It draws + the item flow diagram, modeled on the PRISMA 2020 flow diagram (Page + et al., 2021), and the item evidence profile, this package's own + design. + - [x] `plot(type = "distribution")` for relevance panels and + `plot(which = "distribution")` for Delphi studies draw every rating + as diverging stacked bars (Heiberger & Robbins, 2014), split at the + cut the decision rule counts. *** diff --git a/_pkgdown.yml b/_pkgdown.yml index 9f811ec..484b7f6 100644 --- a/_pkgdown.yml +++ b/_pkgdown.yml @@ -29,6 +29,7 @@ reference: - plot.contentvalid_sort_power - plot.contentvalid_structure - plot.contentvalid_expert_power + - plot.contentvalid_evidence - title: Reading and reporting results desc: Definitions of every index and status label, plus extraction into reports and downstream workflows. @@ -37,6 +38,7 @@ reference: - as.data.frame.contentvalid_workflow - content_report - content_handoff + - content_evidence - compare_rounds - title: Item-sort components and planning diff --git a/data-raw/build-walkthrough-panel.R b/data-raw/build-walkthrough-panel.R new file mode 100644 index 0000000..ad54912 --- /dev/null +++ b/data-raw/build-walkthrough-panel.R @@ -0,0 +1,52 @@ +# Build the expert relevance panel for the walkthrough items. +# +# The ratings are CONSTRUCTED. No expert was consulted. They give the twelve +# walkthrough items a second source of content evidence, so that +# content_evidence() and the distribution plot have something to compare, and +# they are written out by hand below so every rating can be read and checked. +# +# This is a separate script from build-walkthrough-data.R on purpose: that +# script's three files are mirrored by nomologR and must not change, and adding +# random draws to it would. Nothing here is random. Run it from the package +# root. It writes one file into inst/extdata: +# +# walkthrough_relevance.csv eight experts' relevance ratings, 1 to 4 +# +# Eight experts rated how relevant each item is to Study Persistence, on the +# usual four-point scale: 1 not relevant, 2 somewhat, 3 quite, 4 highly +# relevant. A rating of 3 or 4 counts as relevant, and with eight experts +# Lynn's (1986) criterion is 7 of 8. +# +# What the panel is built to show, beside the item sort: +# +# EF5 Reads as anxiety rather than persistence, so only 4 of 8 rate it +# relevant. The panel holds it back, as the sort does. +# EF6 Meets the criterion exactly, 7 of 8, as it meets the sort's by one +# judge. +# EF1 All eight rate it relevant, mostly with a 4. +# EF3 All eight rate it relevant too, but seven of them with a 3: the same +# I-CVI as EF1 from a lukewarm panel, which only the full distribution +# shows. +# TF5 Relevant to the construct by every expert. Only the sort shows that +# judges place it in the other facet: the two sources disagree. +# EF4, TF4 Pass here as they pass the sort. Their problems appear only in +# the response data, which is the point of the second stage. + +relevance <- data.frame( + expert = 1:8, + EF1 = c(4, 4, 4, 4, 3, 4, 4, 4), + EF2 = c(4, 3, 4, 4, 4, 3, 4, 4), + EF3 = c(3, 3, 3, 4, 3, 3, 3, 3), + EF4 = c(4, 4, 3, 4, 4, 4, 4, 3), + EF5 = c(2, 3, 2, 3, 4, 2, 3, 2), + EF6 = c(4, 3, 4, 3, 4, 4, 2, 4), + TF1 = c(4, 4, 4, 4, 4, 4, 4, 4), + TF2 = c(3, 4, 4, 3, 4, 4, 3, 4), + TF3 = c(4, 4, 3, 4, 4, 4, 3, 4), + TF4 = c(3, 4, 3, 4, 3, 4, 4, 3), + TF5 = c(4, 4, 3, 4, 4, 3, 4, 4), + TF6 = c(4, 3, 4, 4, 3, 4, 4, 4) +) + +write.csv(relevance, file.path("inst", "extdata", "walkthrough_relevance.csv"), + row.names = FALSE) diff --git a/inst/REFERENCES.bib b/inst/REFERENCES.bib index 7a68da0..57f936d 100644 --- a/inst/REFERENCES.bib +++ b/inst/REFERENCES.bib @@ -236,6 +236,17 @@ @article{hayes2007 doi = {10.1080/19312450709336664} } +@article{heiberger2014, + author = {Heiberger, Richard M. and Robbins, Naomi B.}, + year = {2014}, + title = {{Design of diverging stacked bar charts for Likert scales and other applications}}, + journal = {Journal of Statistical Software}, + volume = {57}, + number = {5}, + pages = {1--32}, + doi = {10.18637/jss.v057.i05} +} + @book{hernandeznieto2002, author = {Hernández-Nieto, R.}, year = {2002}, @@ -368,6 +379,16 @@ @article{newcombe1998 doi = {10.1002/(SICI)1097-0258(19980430)17:8<857::AID-SIM777>3.0.CO;2-E} } +@article{page2021, + author = {Page, Matthew J. and McKenzie, Joanne E. and Bossuyt, Patrick M. and Boutron, Isabelle and Hoffmann, Tammy C. and Mulrow, Cynthia D. and Shamseer, Larissa and Tetzlaff, Jennifer M. and Akl, Elie A. and Brennan, Sue E. and Chou, Roger and Glanville, Julie and Grimshaw, Jeremy M. and Hróbjartsson, Asbjørn and Lalu, Manoj M. and Li, Tianjing and Loder, Elizabeth W. and Mayo-Wilson, Evan and McDonald, Steve and McGuinness, Luke A. and Stewart, Lesley A. and Thomas, James and Tricco, Andrea C. and Welch, Vivian A. and Whiting, Penny and Moher, David}, + year = {2021}, + title = {{The PRISMA 2020 statement: An updated guideline for reporting systematic reviews}}, + journal = {BMJ}, + volume = {372}, + pages = {n71}, + doi = {10.1136/bmj.n71} +} + @article{penfield2004, author = {Penfield, Randall D. and Giacobbi, Jr., Peter R.}, year = {2004}, diff --git a/inst/WORDLIST b/inst/WORDLIST index c7a265d..ad41ba8 100644 --- a/inst/WORDLIST +++ b/inst/WORDLIST @@ -189,3 +189,20 @@ Nieto BookSurge Crossref unrounded +Akl +BMJ +Bossuyt +Boutron +Glanville +Grimshaw +Heiberger +Hoffmann +Hróbjartsson +Lalu +Likert +Loder +Moher +Mulrow +PRISMA +Shamseer +Tetzlaff diff --git a/inst/extdata/README.md b/inst/extdata/README.md index cdeb987..e58e785 100644 --- a/inst/extdata/README.md +++ b/inst/extdata/README.md @@ -34,5 +34,18 @@ fail content review for opposite reasons, one passes and then carries almost no common variance, one passes and loads on two facets, and one is flagged by an empirical screen for restricted variance while being worth keeping. The generating model is stated in full in `data-raw/build-walkthrough-data.R`, which writes all -three files. `nomologR` mirrors `walkthrough_responses.csv` from that same -script so the two packages cannot drift. +three files. `nomologR` ships `walkthrough_items.csv` and +`walkthrough_responses.csv` unchanged, with that same script, so the two +packages cannot drift. + +One more file gives the same twelve items a second source of content evidence, +for `content_evidence()` and `plot(type = "distribution")`: + +- `walkthrough_relevance.csv`: eight experts' 1-4 relevance ratings, one row + per expert and one column per item, for `expert_validity()` in relevance + mode. + +These ratings are constructed by hand rather than simulated, and +`data-raw/build-walkthrough-panel.R` states what each item's ratings are built +to show. It is a separate script so that the three mirrored files above never +change. diff --git a/inst/extdata/walkthrough_relevance.csv b/inst/extdata/walkthrough_relevance.csv new file mode 100644 index 0000000..9ad21f6 --- /dev/null +++ b/inst/extdata/walkthrough_relevance.csv @@ -0,0 +1,9 @@ +"expert","EF1","EF2","EF3","EF4","EF5","EF6","TF1","TF2","TF3","TF4","TF5","TF6" +1,4,4,3,4,2,4,4,3,4,3,4,4 +2,4,3,3,4,3,3,4,4,4,4,4,3 +3,4,4,3,3,2,4,4,4,3,3,3,4 +4,4,4,4,4,3,3,4,3,4,4,4,4 +5,3,4,3,4,4,4,4,4,4,3,4,3 +6,4,3,3,4,2,4,4,4,4,4,3,4 +7,4,4,3,4,3,2,4,3,3,4,4,4 +8,4,4,3,3,2,4,4,4,4,3,4,4 diff --git a/man/content_evidence.Rd b/man/content_evidence.Rd new file mode 100644 index 0000000..3e2561c --- /dev/null +++ b/man/content_evidence.Rd @@ -0,0 +1,125 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/content_evidence.R +\name{content_evidence} +\alias{content_evidence} +\title{Combine content evidence across review stages} +\usage{ +content_evidence(..., keep = "Supported") +} +\arguments{ +\item{...}{Handoffs from \code{\link[=content_handoff]{content_handoff()}}, or fitted workflows that +\code{\link[=content_handoff]{content_handoff()}} accepts, in the order the stages ran. Name them to +label the stages, as in \code{content_evidence(Panel = h1, Sort = h2)}. +Unnamed stages are labeled by their workflow.} + +\item{keep}{Statuses carried forward when a stage is given as a fitted +workflow rather than a handoff, as in \code{\link[=content_handoff]{content_handoff()}}. A handoff +already records what it carried, so \code{keep} does not change it.} +} +\value{ +An object of class \code{contentvalid_evidence}, a list with: +\describe{ +\item{\code{stages}}{the handoffs, named by stage.} +\item{\code{items}}{every item reviewed, in the order first reviewed.} +\item{\code{evidence}}{one row per item per stage: \code{item}, \code{scale}, \code{stage}, +\code{statistic}, \code{value}, \code{lower}, \code{upper}, \code{level}, \code{criterion}, +\code{recommendation}, \code{status}, and \code{carried}. \code{as.data.frame()} returns +it.} +\item{\code{flow}}{for each stage, the items it reviewed, those an earlier +stage had already held back, those it held back itself, and those +carried so far that it did not review.} +\item{\code{carried}}{the items carried by every stage that reviewed them.} +} +} +\description{ +Brings the handoffs from several content-review stages together, so the +evidence for each item can be read, reported, and drawn as a whole. Give the +stages in the order they ran, such as an expert relevance panel and then an +item sort. Each stage can be a handoff from \code{\link[=content_handoff]{content_handoff()}} or a fitted +workflow, which is handed off with \code{keep}. + +The result prints one row per item, with each stage's decision beside the +statistic its rule read, and it draws two figures for a paper or poster: +\itemize{ +\item \code{plot(x)}, the \strong{item evidence profile}. One panel per stage shows the +statistic each decision read, its interval, and its criterion, and a last +column names the stages that held an item back. +\item \code{plot(x, type = "flow")}, the \strong{item flow diagram}. Each stage's box says +how many items it reviewed, a side box lists what it held back with the +number behind each decision, and the last box lists what was carried +forward. +} +} +\details{ +\strong{The statistic each stage shows} is the one its decision rule reads, taken +from the handoff: +\itemize{ +\item an item sort: Psa, against the exact test's criterion; +\item an expert relevance panel: the I-CVI, against Lynn's (1986) count; +\item a Delphi study: the share of experts agreeing, against the consensus +threshold; +\item an essentiality panel: the CVR, against the exact test's criterion; +\item congruence ratings: the IOC margin over the strongest competing +objective, or the IOC when there is no target mapping; +\item construct ratings: HTC, with no criterion, because that workflow decides +on its planned contrasts. +} + +Decisions are read from each handoff, never recomputed from the statistic. + +\strong{Stages in sequence or side by side.} Usually a stage reviews only what +the stage before it carried forward, and the flow diagram reads that way. +When two methods reviewed the same items side by side, a stage's box says +how many of its items an earlier stage had already held back, and its side +box lists only the items it held back itself. Either way, an item is carried +forward when every stage that reviewed it carried it. +} +\section{Where the displays come from}{ + +The flow diagram is modeled on the PRISMA 2020 flow diagram for systematic +reviews (Page et al., 2021), with items in place of studies. The evidence +profile is this package's own design. It sets out each stage's statistic as +a forest plot does, one panel per stage, so that agreement and disagreement +between methods can be seen item by item. Neither computes anything new: +both draw the statistics and decisions the stages already made. +} + +\examples{ +relevance <- matrix( + c(4,4,4,3, 4,4,3,4, 3,4,4,4, 2,2,1,2), + nrow = 4, + dimnames = list(NULL, paste0("Item", 1:4)) +) +panel <- expert_validity(relevance, mode = "relevance", lo = 1, hi = 4, + agreement = "none") +# The sort reviews the three items the panel carried forward. +sorts <- data.frame( + item = rep(paste0("Item", 1:3), each = 12), + rater = rep(1:12, 3), + target_construct = rep(c("A", "A", "B"), each = 12), + assigned_construct = c(rep("A", 11), "B", rep("A", 10), "B", "B", + rep("B", 5), rep("A", 7)) +) +evidence <- content_evidence(`Relevance panel` = panel, + `Item sort` = sort_validity(sorts)) +evidence +plot(evidence) +plot(evidence, type = "flow") +plot(evidence, apa = FALSE) +} +\references{ +Lynn, M. R. (1986). Determination and quantification of content validity. +\emph{Nursing Research, 35}(6), 382–385. +\doi{10.1097/00006199-198611000-00017} + +Page, M. J., McKenzie, J. E., Bossuyt, P. M., Boutron, I., Hoffmann, T. C., +Mulrow, C. D., Shamseer, L., Tetzlaff, J. M., Akl, E. A., Brennan, S. E., +Chou, R., Glanville, J., Grimshaw, J. M., Hróbjartsson, A., Lalu, M. M., +Li, T., Loder, E. W., Mayo-Wilson, E., McDonald, S., . . . Moher, D. +(2021). The PRISMA 2020 statement: An updated guideline for reporting +systematic reviews. \emph{BMJ, 372}, Article n71. \doi{10.1136/bmj.n71} +} +\seealso{ +\code{\link[=content_handoff]{content_handoff()}} for a single stage, and +\code{\link[=plot.contentvalid_evidence]{plot.contentvalid_evidence()}} for the two figures. +} diff --git a/man/contentvalidR-package.Rd b/man/contentvalidR-package.Rd index 6cfa36f..742e650 100644 --- a/man/contentvalidR-package.Rd +++ b/man/contentvalidR-package.Rd @@ -22,8 +22,9 @@ The public API is in three tiers. \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{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_report]{content_report()}}, \code{\link[=compare_rounds]{compare_rounds()}}, -\code{\link[=as.data.frame.contentvalid_workflow]{as.data.frame.contentvalid_workflow()}}, and \code{\link[=contentvalid_glossary]{contentvalid_glossary()}}. +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 +\code{\link[=contentvalid_glossary]{contentvalid_glossary()}}. Tier 1 will not change in a way that breaks working code except across a major version, and never without the deprecation cycle below. diff --git a/man/plot.contentvalid_delphi.Rd b/man/plot.contentvalid_delphi.Rd index 2b59d25..5f513ff 100644 --- a/man/plot.contentvalid_delphi.Rd +++ b/man/plot.contentvalid_delphi.Rd @@ -4,15 +4,32 @@ \alias{plot.contentvalid_delphi} \title{Plot a Delphi analysis} \usage{ -\method{plot}{contentvalid_delphi}(x, which = c("consensus", "stability"), show_legend = TRUE, ...) +\method{plot}{contentvalid_delphi}( + x, + which = c("consensus", "stability", "distribution"), + show_legend = TRUE, + apa = TRUE, + labels = NULL, + ... +) } \arguments{ \item{x}{A fitted \code{contentvalid_delphi} object.} -\item{which}{\code{"consensus"} (default) or \code{"stability"}.} +\item{which}{\code{"consensus"} (default), \code{"stability"}, or \code{"distribution"}.} \item{show_legend}{Draw the legend. Defaults to \code{TRUE}.} +\item{apa}{Used by \code{which = "distribution"}. \code{TRUE} (default) draws in +gray, with darker meaning a higher rating, as an APA figure is printed. +\code{FALSE} draws ratings below the agreement cut in brown and ratings at or +above it in teal, a colorblind-safe scheme for slides and posters. The +consensus and stability views color each item's line so the lines can be +told apart.} + +\item{labels}{For \code{which = "distribution"}, one label per rating category, +lowest first. Defaults to \code{"Rated 1"}, \code{"Rated 2"}, and so on.} + \item{...}{Passed to \code{\link[graphics:plot]{graphics::plot()}}.} } \value{ @@ -35,6 +52,13 @@ circles. No bands or shaded regions are drawn behind kappa: its verbal benchmarks are arbitrary, and kappa falls as a panel converges, so a shaded "good" region would mislead exactly when a Delphi is succeeding. See \code{\link[=delphi_validity]{delphi_validity()}}. + +\code{which = "distribution"} draws every rating in every round as a diverging +stacked bar (Heiberger & Robbins, 2014), one bar per round for each item, +split at \code{agree_cut}. The right-hand length is the share agreeing, read +against the dashed consensus threshold, and the symbol beside it is that +round's consensus decision. Rounds in which an item was not rated, because +it had been set aside, are marked "not rated". } \examples{ r1 <- cbind(S1 = c(4, 4, 3, 4, 2, 4), S2 = c(2, 3, 2, 1, 3, 2)) @@ -48,6 +72,12 @@ fit <- delphi_validity(rbind(long(r1, 1), long(r2, 2)), lo = 1, hi = 4, consensus_threshold = 0.75, B = 0) plot(fit) plot(fit, which = "stability") +plot(fit, which = "distribution") +} +\references{ +Heiberger, R. M., & Robbins, N. B. (2014). Design of diverging stacked bar +charts for Likert scales and other applications. \emph{Journal of Statistical +Software, 57}(5), 1–32. \doi{10.18637/jss.v057.i05} } \seealso{ \code{\link[=delphi_validity]{delphi_validity()}}. diff --git a/man/plot.contentvalid_evidence.Rd b/man/plot.contentvalid_evidence.Rd new file mode 100644 index 0000000..8fa705b --- /dev/null +++ b/man/plot.contentvalid_evidence.Rd @@ -0,0 +1,75 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/content_evidence.R +\name{plot.contentvalid_evidence} +\alias{plot.contentvalid_evidence} +\title{Plot content evidence across review stages} +\usage{ +\method{plot}{contentvalid_evidence}(x, type = c("profile", "flow"), apa = TRUE, show_legend = TRUE, ...) +} +\arguments{ +\item{x}{A \code{contentvalid_evidence} object.} + +\item{type}{\code{"profile"} or \code{"flow"}.} + +\item{apa}{\code{TRUE} (default) draws in black, white, and gray, as an APA +figure is printed. \code{FALSE} marks evidence that met its criterion in teal +and evidence under review in brown, a colorblind-safe scheme for slides +and posters. Symbols carry the decision either way, so neither reading +depends on color.} + +\item{show_legend}{Draw the key above the profile. Default \code{TRUE}.} + +\item{...}{Additional graphical arguments passed to \code{\link[graphics:plot]{graphics::plot()}} for +each panel of the profile. The flow diagram does not use them.} +} +\value{ +\code{x}, invisibly. Called for the plot it draws. +} +\description{ +Draws the two figures of \code{\link[=content_evidence]{content_evidence()}}. + +\code{type = "profile"} (default), the item evidence profile, gives one panel +per stage with the items down the side. Each panel shows the statistic that +stage's decision read, its interval as a bar, and its criterion as a dashed +line. A filled symbol met the criterion, an open one was flagged for review, +and a cross marks no decision. "not reviewed" marks an item a stage did not +see. The last column says whether each item was carried, or names the +stages that held it back. Faint lines separate the constructs. + +\code{type = "flow"}, the item flow diagram, follows the items through the +stages, modeled on the PRISMA 2020 flow diagram (Page et al., 2021). Each +stage's box gives how many items it reviewed and by how many judges; its +side box lists each item it held back, with the decision and the number +behind it; and the last box lists the items carried forward, by construct. +} +\examples{ +relevance <- matrix( + c(4,4,4,3, 4,4,3,4, 3,4,4,4, 2,2,1,2), + nrow = 4, + dimnames = list(NULL, paste0("Item", 1:4)) +) +panel <- expert_validity(relevance, mode = "relevance", lo = 1, hi = 4, + agreement = "none") +sorts <- data.frame( + item = rep(paste0("Item", 1:3), each = 12), + rater = rep(1:12, 3), + target_construct = rep(c("A", "A", "B"), each = 12), + assigned_construct = c(rep("A", 11), "B", rep("A", 10), "B", "B", + rep("B", 5), rep("A", 7)) +) +evidence <- content_evidence(`Relevance panel` = panel, + `Item sort` = sort_validity(sorts)) +plot(evidence) +plot(evidence, type = "flow", apa = FALSE) +} +\references{ +Page, M. J., McKenzie, J. E., Bossuyt, P. M., Boutron, I., Hoffmann, T. C., +Mulrow, C. D., Shamseer, L., Tetzlaff, J. M., Akl, E. A., Brennan, S. E., +Chou, R., Glanville, J., Grimshaw, J. M., Hróbjartsson, A., Lalu, M. M., +Li, T., Loder, E. W., Mayo-Wilson, E., McDonald, S., . . . Moher, D. +(2021). The PRISMA 2020 statement: An updated guideline for reporting +systematic reviews. \emph{BMJ, 372}, Article n71. \doi{10.1136/bmj.n71} +} +\seealso{ +\code{\link[=content_evidence]{content_evidence()}}. +} diff --git a/man/plot.contentvalid_expert.Rd b/man/plot.contentvalid_expert.Rd index d55c00d..787e967 100644 --- a/man/plot.contentvalid_expert.Rd +++ b/man/plot.contentvalid_expert.Rd @@ -4,13 +4,33 @@ \alias{plot.contentvalid_expert} \title{Plot expert-panel content-validity results} \usage{ -\method{plot}{contentvalid_expert}(x, show_legend = TRUE, ...) +\method{plot}{contentvalid_expert}( + x, + show_legend = TRUE, + type = c("item", "distribution"), + apa = TRUE, + labels = NULL, + ... +) } \arguments{ \item{x}{A \code{contentvalid_expert} object.} \item{show_legend}{Logical; draw the compact plot key. Default \code{TRUE}.} +\item{type}{\code{"item"} (default) for the evidence plot described above, or +\code{"distribution"} for the rating distributions (relevance mode only).} + +\item{apa}{Used by \code{type = "distribution"}. \code{TRUE} (default) draws in gray, +with darker meaning a higher rating, as an APA figure is printed. \code{FALSE} +draws ratings below the cut in brown and ratings at or above it in teal, +a colorblind-safe scheme for slides and posters. The symbol beside each +bar carries the decision either way. The \code{"item"} plot is always gray.} + +\item{labels}{For \code{type = "distribution"}, one label per rating category, +lowest first, such as \code{c("Not relevant", "Somewhat relevant", "Quite relevant", "Highly relevant")}. Defaults to \code{"Rated 1"}, \code{"Rated 2"}, +and so on.} + \item{...}{Additional graphical arguments passed to \code{\link[graphics:plot]{graphics::plot()}}.} } \value{ @@ -24,6 +44,14 @@ same number of experts. Essentiality mode shows each observed CVR against the CVR the exact test needs for that item. Congruence mode shows each item's IOC for its intended objective against its strongest competitor, when a target mapping is available. + +In relevance mode, \code{type = "distribution"} draws every expert's rating as +a diverging stacked bar (Heiberger & Robbins, 2014), split at the relevance +cut. Ratings below the cut extend left and ratings at or above it extend +right, so the right-hand length is the item's I-CVI, read against the dashed +criterion line. The number beside each bar is that I-CVI, and the symbol is +the decision the fit made. It shows what the index cannot: two items with +the same I-CVI, one rated relevant with 4s and the other with 3s. } \examples{ relevance <- matrix( @@ -31,7 +59,15 @@ relevance <- matrix( nrow = 4, dimnames = list(NULL, paste0("Item", 1:4)) ) -plot(expert_validity(relevance, mode = "relevance", lo = 1, hi = 4, - agreement = "none")) +fit <- expert_validity(relevance, mode = "relevance", lo = 1, hi = 4, + agreement = "none") +plot(fit) +plot(fit, type = "distribution") +plot(fit, type = "distribution", apa = FALSE) plot(expert_validity(c(10, 8, 6), mode = "essentiality", N = 12)) } +\references{ +Heiberger, R. M., & Robbins, N. B. (2014). Design of diverging stacked bar +charts for Likert scales and other applications. \emph{Journal of Statistical +Software, 57}(5), 1–32. \doi{10.18637/jss.v057.i05} +} diff --git a/tests/testthat/test-evidence-displays.R b/tests/testthat/test-evidence-displays.R new file mode 100644 index 0000000..f0916dd --- /dev/null +++ b/tests/testthat/test-evidence-displays.R @@ -0,0 +1,246 @@ +# content_evidence(), its evidence profile and flow diagram, and the +# rating-distribution view of expert and Delphi fits. The figures only draw +# what the fits and handoffs already decided, so most of these tests check +# what is read, not how it looks. + +extdata <- function(f) system.file("extdata", f, package = "contentvalidR") + +wt_relevance_fit <- function() { + r <- read.csv(extdata("walkthrough_relevance.csv"), stringsAsFactors = FALSE) + R <- as.matrix(r[setdiff(names(r), "expert")]) + expert_validity(R, mode = "relevance", lo = 1, hi = 4, agreement = "none") +} +wt_sorted <- function() { + read.csv(extdata("walkthrough_sort.csv"), stringsAsFactors = FALSE) +} +# The usual order: the sort reviews what the relevance panel carried. +wt_sequential <- function() { + panel <- content_handoff(wt_relevance_fit()) + sort <- content_handoff(sort_validity(wt_sorted()[wt_sorted()$item %in% + panel$items, ])) + content_evidence(`Relevance panel` = panel, `Item sort` = sort) +} + +draws <- function(expr) { + grDevices::pdf(NULL) + on.exit(grDevices::dev.off()) + force(expr) +} + +test_that("stages in sequence carry what every reviewing stage carried", { + ev <- wt_sequential() + expect_s3_class(ev, "contentvalid_evidence") + expect_named(ev$stages, c("Relevance panel", "Item sort")) + expect_identical(ev$items[1:6], paste0("EF", 1:6)) + expect_setequal(ev$carried, setdiff(ev$items, c("EF5", "TF5"))) + + expect_identical(ev$flow[[1]]$held, "EF5") + expect_identical(ev$flow[[2]]$held, "TF5") + expect_length(ev$flow[[2]]$reviewed, 11L) + expect_length(ev$flow[[2]]$already_out, 0L) + expect_length(ev$flow[[2]]$not_reviewed, 0L) + + d <- as.data.frame(ev) + expect_identical(nrow(d), 12L + 11L) + expect_named(d, c("item", "scale", "stage", "statistic", "value", "lower", + "upper", "level", "criterion", "recommendation", "status", + "carried")) + expect_setequal(unique(d$statistic), c("I-CVI", "Psa")) + # The relevance panel maps no constructs; the sort's mapping fills them in, + # except for EF5, which never reached the sort. + expect_identical(d$scale[d$item == "EF1" & d$stage == "Relevance panel"], "EF") + expect_true(is.na(d$scale[d$item == "EF5"][1])) +}) + +test_that("stages side by side count only what each stage held back itself", { + panel <- content_handoff(wt_relevance_fit()) + sort <- content_handoff(sort_validity(wt_sorted())) + ev <- content_evidence(panel, sort) + + expect_named(ev$stages, c("Relevance panel", "Item sort")) + expect_setequal(ev$carried, setdiff(ev$items, c("EF5", "TF5"))) + # EF5 was already held back when the sort, which also holds it back, saw it. + expect_identical(ev$flow[[2]]$already_out, "EF5") + expect_identical(ev$flow[[2]]$held, "TF5") + verdict <- contentvalidR:::.evidence_verdicts(ev) + expect_identical(verdict[ev$items == "EF5"], + "held back: Relevance panel; Item sort") + expect_identical(verdict[ev$items == "TF5"], "held back: Item sort") +}) + +test_that("fits and handoffs give the same evidence", { + fit <- wt_relevance_fit() + a <- content_evidence(Panel = fit) + b <- content_evidence(Panel = content_handoff(fit)) + expect_identical(a$evidence, b$evidence) + expect_identical(a$carried, b$carried) + # `keep` applies to fits only. + wide <- content_evidence(Panel = fit, keep = c("Supported", "Review")) + expect_true("EF5" %in% wide$carried) +}) + +test_that("decisions are read from each handoff, never recomputed", { + # A handoff that says an item was held back is believed, whatever its number + # says, which is the reader contract in ?content_handoff. + h <- content_handoff(wt_relevance_fit()) + h$item_evidence$carried[h$item_evidence$item == "TF1"] <- FALSE + h$item_evidence$recommendation[h$item_evidence$item == "TF1"] <- "Review" + h$item_evidence$status[h$item_evidence$item == "TF1"] <- "Review" + ev <- content_evidence(Panel = h) + expect_false("TF1" %in% ev$carried) + expect_identical(ev$flow[[1]]$held, c("EF5", "TF1")) +}) + +test_that("unnamed and repeated stages are labeled so they can be told apart", { + fit <- wt_relevance_fit() + ev <- content_evidence(fit, fit) + expect_named(ev$stages, c("Relevance panel (stage 1)", + "Relevance panel (stage 2)")) + ev <- content_evidence(First = fit, fit) + expect_named(ev$stages, c("First", "Relevance panel")) +}) + +test_that("each workflow shows the statistic its decision rule reads", { + ess <- expert_validity(c(10, 8, 6), mode = "essentiality", N = 12) + con_d <- expand.grid(item = c("I1", "I2"), judge = 1:4, objective = c("A", "B"), + KEEP.OUT.ATTRS = FALSE, stringsAsFactors = FALSE) + con_d$score <- ifelse(con_d$objective == ifelse(con_d$item == "I1", "A", "B"), + 1, -1) + con_t <- con_d + con_t$target_objective <- ifelse(con_t$item == "I1", "A", "B") + set.seed(12) + rd <- expand.grid(item = c("A1", "A2", "B1"), rater = 1:20, + construct = c("A", "B", "C"), stringsAsFactors = FALSE) + rd$target_construct <- ifelse(rd$item == "B1", "B", "A") + rd$rating <- ifelse(rd$construct == rd$target_construct, + pmin(5, pmax(1, round(stats::rnorm(nrow(rd), 4.5, .6)))), + pmin(5, pmax(1, round(stats::rnorm(nrow(rd), 2.0, .7))))) + r1 <- cbind(S1 = c(4, 4, 3, 4, 2, 4), S2 = c(2, 3, 2, 1, 3, 2)) + r2 <- cbind(S1 = c(4, 4, 4, 4, 3, 4), S2 = c(2, 2, 2, 1, 3, 2)) + long <- function(m, round) { + data.frame(expert = paste0("E", seq_len(nrow(m))), + item = rep(colnames(m), each = nrow(m)), + round = round, rating = as.vector(m)) + } + delphi <- delphi_validity(rbind(long(r1, 1), long(r2, 2)), lo = 1, hi = 4, + consensus_threshold = 0.75, B = 0) + + stat_of <- function(x, keep = "Supported") { + unique(as.data.frame(content_evidence(x, keep = keep))$statistic) + } + expect_identical(stat_of(ess), "CVR") + expect_identical(stat_of(expert_validity(con_t, mode = "congruence")), + "IOC margin") + expect_identical(stat_of(expert_validity(con_d, mode = "congruence"), + keep = "Descriptive only"), "IOC") + expect_identical(stat_of(rating_validity(rd, scale_min = 1, scale_max = 5)), + "HTC") + expect_identical(stat_of(delphi), "Share agreeing") + expect_identical(names(content_evidence(delphi)$stages), "Delphi") +}) + +test_that("content_evidence() refuses what it cannot read", { + expect_error(content_evidence(), "at least one handoff") + expect_error(content_evidence(list(a = 1)), "not a handoff or a fitted workflow") + h <- content_handoff(wt_relevance_fit()) + h$provenance$schema_version <- 2L + expect_error(content_evidence(h), "schema version 2") +}) + +test_that("the print opens with the verdict and names who held what back", { + out <- capture.output(print(wt_sequential())) + expect_match(out[3], "10 of 12 items carried by every stage that reviewed") + # Wrapped lines are joined, so a phrase split across two still matches. + txt <- gsub("\\s+", " ", paste(out, collapse = " ")) + expect_match(txt, "Held back: EF5 \\(Relevance panel\\), TF5 \\(Item sort\\)") + expect_match(txt, "1\\. Relevance panel: 12 items, 8 experts\\. Shows I-CVI\\.") + expect_match(txt, "2\\. Item sort: 11 items, 20 judges\\. Shows Psa\\.") + expect_match(txt, "held back: Item sort") + expect_match(txt, "What these columns mean") + + old <- options(contentvalidR.show_key = FALSE) + on.exit(options(old)) + hidden <- gsub("\\s+", " ", paste(capture.output(print(wt_sequential())), + collapse = " ")) + expect_no_match(hidden, "What these columns mean") + # The result stays readable with the key hidden. + expect_match(hidden, "held back: Item sort") +}) + +test_that("the profile and the flow draw in gray and in color", { + ev <- wt_sequential() + for (apa in c(TRUE, FALSE)) { + expect_identical(draws(plot(ev, apa = apa)), ev) + expect_identical(draws(plot(ev, type = "flow", apa = apa)), ev) + expect_identical(draws(plot(ev, show_legend = FALSE)), ev) + } + # Side by side, with an item a later stage has already lost. + side <- content_evidence(content_handoff(wt_relevance_fit()), + content_handoff(sort_validity(wt_sorted()))) + expect_identical(draws(plot(side, type = "flow")), side) + expect_error(plot(ev, apa = NA), "`apa` must be TRUE or FALSE") + expect_error(plot(ev, type = "bars")) +}) + +test_that("an expert fit keeps its ratings and draws their distribution", { + fit <- wt_relevance_fit() + r <- read.csv(extdata("walkthrough_relevance.csv"), stringsAsFactors = FALSE) + expect_equal(unname(fit$details$ratings), + unname(as.matrix(r[setdiff(names(r), "expert")]))) + + for (apa in c(TRUE, FALSE)) { + expect_identical(draws(plot(fit, type = "distribution", apa = apa)), fit) + } + labs <- c("Not relevant", "Somewhat", "Quite", "Highly relevant") + expect_identical(draws(plot(fit, type = "distribution", labels = labs)), fit) + expect_error(draws(plot(fit, type = "distribution", labels = labs[1:3])), + "4 labels") + # The existing evidence plot is unchanged, and still the default. + expect_identical(draws(plot(fit)), fit) + + ess <- expert_validity(c(10, 8, 6), mode = "essentiality", N = 12) + expect_error(plot(ess, type = "distribution"), "relevance-mode fit") + old_fit <- fit + old_fit$details$ratings <- NULL + expect_error(plot(old_fit, type = "distribution"), "earlier version") +}) + +test_that("a Delphi fit draws each round's distribution", { + r1 <- cbind(S1 = c(4, 4, 3, 4, 2, 4), S2 = c(2, 3, 2, 1, 3, 2), + S3 = c(4, 4, 4, 4, 4, 3)) + r2 <- cbind(S1 = c(4, 4, 4, 4, 3, 4), S2 = c(2, 2, 2, 1, 3, 2)) + long <- function(m, round) { + data.frame(expert = paste0("E", seq_len(nrow(m))), + item = rep(colnames(m), each = nrow(m)), + round = round, rating = as.vector(m)) + } + # S3 reached consensus in round 1 and was not rated again. + fit <- delphi_validity(rbind(long(r1, 1), long(r2, 2)), lo = 1, hi = 4, + consensus_threshold = 0.75, B = 0) + for (apa in c(TRUE, FALSE)) { + expect_identical(draws(plot(fit, which = "distribution", apa = apa)), fit) + } + # Without a threshold there is no criterion line and no decision. + loose <- delphi_validity(rbind(long(r1, 1), long(r2, 2)), lo = 1, hi = 4, + B = 0) + expect_identical(draws(plot(loose, which = "distribution")), loose) + # The existing views still draw. + expect_identical(draws(plot(fit)), fit) + + old_fit <- fit + old_fit$details$round_fits[[1]]$details$ratings <- NULL + expect_error(plot(old_fit, which = "distribution"), "earlier version") +}) + +test_that("the rating fills darken in gray and diverge in color", { + grey <- contentvalidR:::.rating_fills(4, 2, apa = TRUE) + lum <- colSums(grDevices::col2rgb(grey)) + expect_true(all(diff(lum) < 0)) + colour <- contentvalidR:::.rating_fills(4, 2, apa = FALSE) + expect_length(colour, 4L) + expect_length(unique(colour), 4L) + # A five-point scale cut at 4: three below, two above. + expect_length(contentvalidR:::.rating_fills(5, 3, apa = FALSE), 5L) + # One category on a side takes the shade nearest the cut. + expect_length(contentvalidR:::.rating_fills(4, 3, apa = FALSE), 4L) +}) diff --git a/tests/testthat/test-public-api-v005c.R b/tests/testthat/test-public-api-v005c.R index d990656..501f95e 100644 --- a/tests/testthat/test-public-api-v005c.R +++ b/tests/testthat/test-public-api-v005c.R @@ -7,6 +7,7 @@ test_that("the intended public API is exported from a clean namespace", { "compare_rounds", "compute_csv", "compute_psa", + "content_evidence", "content_handoff", "content_report", "content_structure", @@ -80,6 +81,9 @@ test_that("release-defining S3 methods are registered in the installed namespace c("summary", "contentvalid_delphi"), c("print", "summary.contentvalid_delphi"), c("plot", "contentvalid_delphi"), + c("print", "contentvalid_evidence"), + c("plot", "contentvalid_evidence"), + c("as.data.frame", "contentvalid_evidence"), c("as.data.frame", "contentvalid_workflow") ) diff --git a/tests/testthat/test-walkthrough-data.R b/tests/testthat/test-walkthrough-data.R index 608a8c7..92bd0d7 100644 --- a/tests/testthat/test-walkthrough-data.R +++ b/tests/testthat/test-walkthrough-data.R @@ -206,3 +206,36 @@ test_that("recoding restores exactly the data the design describes", { expect_true(all(rec >= 1L & rec <= 5L)) expect_identical(anyNA(rec), FALSE) }) + +# The relevance panel, a second source of content evidence for the same items +# (data-raw/build-walkthrough-panel.R). The reporting vignette narrates these +# claims, so they are held here. +wt_relevance <- function() { + r <- read.csv(extdata("walkthrough_relevance.csv"), stringsAsFactors = FALSE) + as.matrix(r[setdiff(names(r), "expert")]) +} + +test_that("the relevance panel rates the same twelve items, eight experts each", { + R <- wt_relevance() + expect_identical(colnames(R), wt_items()$item) + expect_identical(nrow(R), 8L) + expect_true(all(R %in% 1:4)) +}) + +test_that("the relevance panel shows what its generator says it shows", { + fit <- expert_validity(wt_relevance(), mode = "relevance", lo = 1, hi = 4, + agreement = "none") + r <- fit$results + # Only EF5 falls short, at 4 of 8, where Lynn's criterion is 7 of 8. + expect_identical(r$item[r$status == "Review"], "EF5") + expect_equal(r$A[r$item == "EF5"], 4) + # EF6 meets the criterion exactly. + expect_equal(r$A[r$item == "EF6"], 7) + expect_identical(r$status[r$item == "EF6"], "Supported") + # EF1 and EF3 have the same I-CVI, but EF3's panel is lukewarm, which only the + # full distribution (and Aiken's V) shows. + expect_identical(r$I_CVI[r$item == "EF1"], r$I_CVI[r$item == "EF3"]) + expect_lt(r$V[r$item == "EF3"], r$V[r$item == "EF1"] - 0.2) + # TF5 is relevant by every expert; only the sort holds it back. + expect_equal(r$A[r$item == "TF5"], 8) +}) diff --git a/vignettes/delphi-rounds.Rmd b/vignettes/delphi-rounds.Rmd index aae0e43..15f6dcd 100644 --- a/vignettes/delphi-rounds.Rmd +++ b/vignettes/delphi-rounds.Rmd @@ -197,6 +197,20 @@ share unchanged, which is the unanimous-round case described above. There are no shaded "good" and "poor" bands behind kappa, for the same reason there are no verbal labels. +Both plots summarize. The distribution view shows every rating, one bar per +round for each statement, split at the agreement cut (Heiberger & Robbins, +2014). The right-hand length is the share agreeing, read against the dashed +consensus threshold: + +```{r plot-distribution, fig.width = 7, fig.height = 7, fig.alt = "Rating distributions for six statements over three rounds, one bar per round, split at the agreement cut of 3, with a dashed line at the 75% consensus threshold. S1 is not rated in round 3, having reached consensus in round 2; S2 moves to unanimous 4s by round 3; nearly every expert rates S3 below the cut in every round."} +plot(fit, which = "distribution") +``` + +S2's bars show a panel converging, and S3's a panel agreeing that the +statement does not belong: agreement in the other direction, which the printout +notes in words and the bars show at a glance. Add `apa = FALSE` for a color +version for slides or a poster. + ## Why the default looks at individual experts S6 is the reason stability is measured expert by expert. Under the 15% rule @@ -321,6 +335,10 @@ intraclass correlation coefficient as measures of reliability. *Educational and Psychological Measurement, 33*(3), 613–619. https://doi.org/10.1177/001316447303300309 +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 + 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. diff --git a/vignettes/expert-panel-validity.Rmd b/vignettes/expert-panel-validity.Rmd index 09cbf37..bb4bdcf 100644 --- a/vignettes/expert-panel-validity.Rmd +++ b/vignettes/expert-panel-validity.Rmd @@ -243,6 +243,26 @@ panel-specific critical CVR. Congruence mode connects target IOC to the stronges competitor so the alignment margin is visually explicit. These displays are diagnostic summaries; they do not create new validity thresholds. +An index reduces each item's ratings to one number, and the relevance plot +shows that number. The distribution view shows the ratings behind it, as +diverging stacked bars (Heiberger & Robbins, 2014). Each bar splits at the +relevance cut: ratings below it extend left and ratings at or above it extend +right, so the right-hand length is the I-CVI, read against the dashed criterion +line. + +```{r expert-distribution, fig.width=7, fig.height=4, fig.alt="Rating distributions for four items rated by six experts, as bars split at the relevance cut of 3, with a dashed line at the I-CVI criterion of .83. Items 1 to 3 are rated relevant by all six experts, Item 1 entirely with 4s; Item 4 is rated relevant by five of six, mostly with 3s."} +plot(fit, type = "distribution", + labels = c("Not relevant", "Somewhat", "Quite", "Highly relevant")) +``` + +Item1 and Item3 have the same I-CVI, but every expert gave Item1 a 4, while +two gave Item3 a 3. The index cannot tell them apart; the bars can, and so can +Aiken's V, which uses the whole scale. The figure is gray by default, as an APA +figure is printed. For slides or a poster, `apa = FALSE` draws it in color: +brown for ratings below the cut and teal for ratings at or above it. The +symbol beside each bar still carries the decision, so no reading depends on +color. + ## Reporting A concise methods/results description should identify: @@ -284,6 +304,10 @@ Hayes, A. F., & Krippendorff, K. (2007). Answering the call for a standard reliability measure for coding data. *Communication Methods and Measures, 1*(1), 77–89. https://doi.org/10.1080/19312450709336664 +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. diff --git a/vignettes/handoff-to-empirical-validation.Rmd b/vignettes/handoff-to-empirical-validation.Rmd index 50cd637..ed023fc 100644 --- a/vignettes/handoff-to-empirical-validation.Rmd +++ b/vignettes/handoff-to-empirical-validation.Rmd @@ -146,15 +146,15 @@ and nomological networks. library(nomologR) # `responses` is your collected data: one row per respondent, one column per item. -scr <- nomo_screen(responses, items = handoff$items) +scr <- nomo_screen(responses, items = handoff) scr$item_summary ``` That chunk is not evaluated here, because this vignette builds without nomologR installed and because a content-validity pretest has no responses to screen. -It passes the carried item names. Reading the handoff object itself, so that -nomologR also receives the evidence and each item's keying, is tracked on -[nomologR#46](https://github.com/JUhalt/nomologR/issues/46). +It passes the handoff itself rather than `handoff$items`, so nomologR receives +the carried items together with their evidence and each item's keying, and +can quote the reasons for anything held back. The object shape is agreed between the two packages as schema version 1, and every field is a base type: character, logical, numeric, integer, data frame, diff --git a/vignettes/reporting-examples.Rmd b/vignettes/reporting-examples.Rmd index 641eba6..caf30c8 100644 --- a/vignettes/reporting-examples.Rmd +++ b/vignettes/reporting-examples.Rmd @@ -171,6 +171,68 @@ For IOC, report the intended objective, target IOC, strongest competing objective, and target-minus-competitor margin. The margin is diagnostic evidence about alignment; it is not a newly invented significance test. +## Figures across review stages + +Most studies gather more than one kind of content evidence. `content_evidence()` +brings the stages together, in the order they ran, and draws two figures for a +paper or poster. Here the twelve items of `vignette("one-item-set-both-stages")` +are first rated for relevance by eight experts, and the items the panel carries +go on to the item sort. The relevance ratings are constructed for this example; +`data-raw/build-walkthrough-panel.R` says what each item's ratings are built to +show. + +```{r evidence} +relevance <- read_example("walkthrough_relevance.csv") +panel <- content_handoff(expert_validity( + as.matrix(relevance[setdiff(names(relevance), "expert")]), + mode = "relevance", lo = 1, hi = 4, agreement = "none" +)) +sorted <- read_example("walkthrough_sort.csv") +sort_stage <- sort_validity(sorted[sorted$item %in% panel$items, ]) +evidence <- content_evidence(`Relevance panel` = panel, `Item sort` = sort_stage) +evidence +``` + +The flow diagram follows the items through the stages. It is modeled on the +PRISMA 2020 flow diagram for systematic reviews (Page et al., 2021), with items +in place of studies, and it is the figure a Method section needs: what each +stage reviewed, what it held back and why, and what went forward. + +```{r evidence-flow, fig.width = 7.5, fig.height = 3.2, fig.alt = "Item flow diagram. Stage 1, the relevance panel, reviewed 12 items with 8 experts and held back EF5, with an I-CVI of .50 against a criterion of .88. Stage 2, the item sort, reviewed the remaining 11 items with 20 judges and held back TF5, with a Psa of .30 against a criterion of .75. Ten items were carried forward, five in each facet."} +plot(evidence, type = "flow") +``` + +The evidence profile sets the stages side by side, item by item. Each panel +shows the statistic that stage's decision read, its 95% interval, and its +criterion as a dashed line; a filled symbol met the criterion and an open one +was flagged for review. + +```{r evidence-profile, fig.width = 7.5, fig.height = 5.5, fig.alt = "Item evidence profile with one panel per stage. Left, the I-CVI for twelve items with 95% intervals and a dashed criterion at .88; every item meets it except EF5, at .50. Right, Psa for the eleven items the panel carried, with a dashed criterion at .75; every item meets it except TF5, at .30, and EF6 sits exactly on the line. A last column marks EF5 as held back by the relevance panel and TF5 by the item sort."} +plot(evidence) +``` + +Read across a row and the sources can disagree. Every expert rated `TF5` +relevant; only the sort shows that judges place it in the other facet. Read +down a panel and the intervals speak: an I-CVI of 1.00 from eight experts has +an interval reaching down to about .68, a reminder of how small a panel is. + +Both figures are gray by default, as an APA figure is printed. For slides or a +poster, `apa = FALSE` draws them in color, teal for evidence that met its +criterion and brown for evidence under review. The symbols carry the same +decisions, so no reading depends on color. + +```{r evidence-color, fig.width = 7.5, fig.height = 5.5, fig.alt = "The same item evidence profile in color: items that met each criterion in teal, and EF5 in the relevance panel and TF5 in the item sort in brown, with open symbols."} +plot(evidence, apa = FALSE) +``` + +A caption for the profile might read: *Content evidence for twelve draft +items. Left: the share of eight experts rating each item relevant (I-CVI), with +95% Wilson score intervals and Lynn's (1986) criterion of 7 of 8. Right: the +share of 20 judges assigning each item to its intended facet (Psa), with 95% +Wilson score intervals and the exact test's criterion of 15 of 20 (Howard & +Melloy, 2016). Filled symbols met the criterion; open symbols were flagged for +review.* + ## Minimum reproducibility statement At minimum, a manuscript or supplement should identify the package version and @@ -204,3 +266,14 @@ 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 + +Lynn, M. R. (1986). Determination and quantification of content validity. +*Nursing Research, 35*(6), 382–385. +https://doi.org/10.1097/00006199-198611000-00017 + +Page, M. J., McKenzie, J. E., Bossuyt, P. M., Boutron, I., Hoffmann, T. C., +Mulrow, C. D., Shamseer, L., Tetzlaff, J. M., Akl, E. A., Brennan, S. E., Chou, +R., Glanville, J., Grimshaw, J. M., Hróbjartsson, A., Lalu, M. M., Li, T., +Loder, E. W., Mayo-Wilson, E., McDonald, S., . . . Moher, D. (2021). The PRISMA +2020 statement: An updated guideline for reporting systematic reviews. *BMJ, +372*, Article n71. https://doi.org/10.1136/bmj.n71 From 2e66a4a8ef29fe542eda4ff4f78af0bfbee70adb Mon Sep 17 00:00:00 2001 From: "Joshua Uhalt, Ph.D." Date: Mon, 28 Sep 2026 12:15:42 -0400 Subject: [PATCH 2/2] Tolerate CRAN's update note now that contentvalidR is on CRAN contentvalidR 0.4.0 was published on CRAN on 2026-09-28. R CMD check --as-cran now reports "Days since last update" in its incoming-feasibility note where it reported "New submission", so the gate failed a clean check on a note it had never seen. The incoming note is now tolerated only when every line of it is expected: the maintainer, "New submission", "Version contains large components" (a development version), or "Days since last update". Any other line in it, such as a misspelling or an invalid URL, still fails the stage, as does any other note. When the last update was under 60 days ago, the stage prints a reminder that CRAN asks for updates no more often than every one to two months. tools/README.md says the same. Co-Authored-By: Claude Opus 5.5 --- tools/README.md | 13 +++++++++---- tools/gate-check.R | 36 ++++++++++++++++++++++++++++++++---- 2 files changed, 41 insertions(+), 8 deletions(-) diff --git a/tools/README.md b/tools/README.md index 5c62218..1b5a77a 100644 --- a/tools/README.md +++ b/tools/README.md @@ -75,7 +75,12 @@ rather than the source tree: - the expected vignettes are installed; - the citation names the version being released. -The two notes `check` tolerates are "New submission", which stands until the -package is on CRAN, and math rendering skipped where V8 is unavailable. Any -other note fails the stage: a gate that prints findings for a human to eyeball -is not a gate. +The two notes `check` tolerates are CRAN's incoming-feasibility note and math +rendering skipped where V8 is unavailable. The incoming note is tolerated only +when every line of it is expected: the maintainer, "New submission" (before +the package was on CRAN), "Version contains large components" (a development +version), or "Days since last update" (since 0.4.0 reached CRAN on +2026-09-28). Any other line in it fails the stage, and so does any other note: +a gate that prints findings for a human to eyeball is not a gate. When the +last update was under 60 days ago, the stage also prints a reminder that CRAN +asks for updates no more often than every one to two months. diff --git a/tools/gate-check.R b/tools/gate-check.R index 686deb0..6d110f1 100644 --- a/tools/gate-check.R +++ b/tools/gate-check.R @@ -19,13 +19,41 @@ res <- rcmdcheck::rcmdcheck(tarball, args = "--as-cran", error_on = "never", quiet = TRUE, check_dir = file.path(out, "chk")) print(res) -# Two notes are expected until the package is on CRAN: the new-submission note, -# and math rendering skipped where V8 is unavailable. Anything else is a -# finding, and errors and warnings always are. -unexpected <- res$notes[!grepl("New submission|V8", res$notes)] +# Two notes are expected: CRAN's incoming-feasibility note, and math rendering +# skipped where V8 is unavailable. Anything else is a finding, and errors and +# warnings always are. +# +# The incoming note is expected only when every line of it is one of these: +# the maintainer, "New submission" (before the package was on CRAN), "Version +# contains large components" (a development version), or "Days since last +# update" (once it is on CRAN, since 0.4.0 on 2026-09-28). Any other line in +# it, such as a misspelling or a URL problem, is a finding. +incoming_expected <- function(note) { + lines <- trimws(strsplit(note, "\n", fixed = TRUE)[[1]][-1]) + lines <- lines[nzchar(lines)] + known <- c("^Maintainer: ", "^New submission$", + "^Version contains large components ", "^Days since last update: [0-9]+$") + all(vapply(lines, function(l) any(vapply(known, grepl, logical(1), l)), + logical(1))) +} +is_incoming <- grepl("CRAN incoming feasibility", res$notes, fixed = TRUE) +expected <- grepl("V8", res$notes, fixed = TRUE) | + (is_incoming & vapply(res$notes, incoming_expected, logical(1))) +unexpected <- res$notes[!expected] if (length(res$errors) || length(res$warnings) || length(unexpected)) { cat("\nFAIL: unexpected check results.\n") if (length(unexpected)) cat(paste(unexpected, collapse = "\n"), "\n") quit(status = 1) } cat("\n", length(res$notes), " note(s), all expected.\n", sep = "") + +# Not a failure, but worth seeing before a submission: CRAN asks that updates +# come no more often than every one to two months. +days <- regmatches(res$notes, regexpr("Days since last update: [0-9]+", res$notes)) +if (length(days)) { + n <- as.integer(sub("\\D+", "", days[1])) + if (n < 60L) { + cat("Reminder: CRAN last updated this package ", n, " day(s) ago. CRAN asks ", + "for updates no more often than every one to two months.\n", sep = "") + } +}