From 12f49df4a627257f234ded2a3577ecf0336f04e4 Mon Sep 17 00:00:00 2001 From: Claude Date: Fri, 14 Nov 2025 10:54:38 +0000 Subject: [PATCH 1/2] Add named vector support for col.regions and col.text Implements issue #10 - Support for named vectors in color parameters, similar to ggplot2's scale_color_manual(). This allows users to specify colors that match factor levels by name rather than positional order. Changes: - desplot.R: Add named vector handling for col.regions (line 413) and col.text (line 565) - ggdesplot.R: Add named vector handling for col.regions (line 262) and col.text (line 407) - test_named_colors.R: Comprehensive test suite covering 7 scenarios: * Forward order named vectors * Reversed order named vectors (key test case from issue #10) * Partial names (warns and falls back to positional) * Extra names (works, extras ignored) * Unnamed vectors (backward compatibility) * Named col.text * Both col.regions and col.text with named vectors Features: - Named vectors match colors to factor levels by name - Order-independent: c("red"="A", "blue"="B") same as c("blue"="B", "red"="A") - Graceful fallback: Missing names trigger warning + positional matching - Backward compatible: Unnamed vectors work exactly as before - Works for both desplot (lattice) and ggdesplot (ggplot2) Addresses: kwstat/desplot#10 --- R/desplot.R | 35 +++++- R/ggdesplot.R | 35 +++++- test_named_colors.R | 260 ++++++++++++++++++++++++++++++++++++++++++++ 3 files changed, 326 insertions(+), 4 deletions(-) create mode 100644 test_named_colors.R diff --git a/R/desplot.R b/R/desplot.R index bb62c83..818b839 100644 --- a/R/desplot.R +++ b/R/desplot.R @@ -410,7 +410,23 @@ desplot <- function(data, "#9980FF","#E680FF","#D0D192","#59FF9C","#FFA24D", "#FBFF4D","#4D9FFF","#704DFF","#DB4DFF","#808080", "#9FFF40","#C9CC3D") - col.regions <- rep(col.regions, length=fill.n) + # Handle named vectors for col.regions + if(!is.null(names(col.regions))) { + fill.levels <- levels(fill.val) + matched_colors <- col.regions[fill.levels] + # Check if all levels were matched + if(any(is.na(matched_colors))) { + missing_levels <- fill.levels[is.na(matched_colors)] + warning("col.regions: Not all factor levels found in provided names. ", + "Missing: ", paste(missing_levels, collapse=", "), + ". Falling back to positional matching.") + col.regions <- rep(col.regions, length=fill.n) + } else { + col.regions <- as.vector(matched_colors) + } + } else { + col.regions <- rep(col.regions, length=fill.n) + } at <- c((0:fill.n)+.5) } else if(fill.type=="num") { if(missing(at) && is.null(midpoint)){ @@ -546,7 +562,22 @@ desplot <- function(data, col.n <- length(lt.col) lr <- lr + 2 + col.n lt <- c(lt, lt.col) - if(length(col.text) < col.n) col.text <- rep(col.text, length=col.n) + # Handle named vectors for col.text + if(!is.null(names(col.text))) { + matched_colors <- col.text[lt.col] + # Check if all levels were matched + if(any(is.na(matched_colors))) { + missing_levels <- lt.col[is.na(matched_colors)] + warning("col.text: Not all factor levels found in provided names. ", + "Missing: ", paste(missing_levels, collapse=", "), + ". Falling back to positional matching.") + if(length(col.text) < col.n) col.text <- rep(col.text, length=col.n) + } else { + col.text <- as.vector(matched_colors) + } + } else { + if(length(col.text) < col.n) col.text <- rep(col.text, length=col.n) + } } else { col.val <- rep(1, nrow(data)) # No color specified, use black by default } diff --git a/R/ggdesplot.R b/R/ggdesplot.R index 43187ff..f916b80 100644 --- a/R/ggdesplot.R +++ b/R/ggdesplot.R @@ -259,7 +259,23 @@ ggdesplot <- function(data, "#9980FF","#E680FF","#D0D192","#59FF9C","#FFA24D", "#FBFF4D","#4D9FFF","#704DFF","#DB4DFF","#808080", "#9FFF40","#C9CC3D") - col.regions <- rep(col.regions, length=fill.n) + # Handle named vectors for col.regions + if(!is.null(names(col.regions))) { + fill.levels <- levels(fill.val) + matched_colors <- col.regions[fill.levels] + # Check if all levels were matched + if(any(is.na(matched_colors))) { + missing_levels <- fill.levels[is.na(matched_colors)] + warning("col.regions: Not all factor levels found in provided names. ", + "Missing: ", paste(missing_levels, collapse=", "), + ". Falling back to positional matching.") + col.regions <- rep(col.regions, length=fill.n) + } else { + col.regions <- as.vector(matched_colors) + } + } else { + col.regions <- rep(col.regions, length=fill.n) + } at <- c((0:fill.n)+.5) } else if(fill.type=="num") { if(missing(at) && is.null(midpoint)){ @@ -388,7 +404,22 @@ ggdesplot <- function(data, col.n <- length(lt.col) lr <- lr + 2 + col.n lt <- c(lt, lt.col) - if(length(col.text) < col.n) col.text <- rep(col.text, length=col.n) + # Handle named vectors for col.text + if(!is.null(names(col.text))) { + matched_colors <- col.text[lt.col] + # Check if all levels were matched + if(any(is.na(matched_colors))) { + missing_levels <- lt.col[is.na(matched_colors)] + warning("col.text: Not all factor levels found in provided names. ", + "Missing: ", paste(missing_levels, collapse=", "), + ". Falling back to positional matching.") + if(length(col.text) < col.n) col.text <- rep(col.text, length=col.n) + } else { + col.text <- as.vector(matched_colors) + } + } else { + if(length(col.text) < col.n) col.text <- rep(col.text, length=col.n) + } } else { col.val <- rep(1, nrow(data)) # No color specified, use black by default } diff --git a/test_named_colors.R b/test_named_colors.R new file mode 100644 index 0000000..3508bbe --- /dev/null +++ b/test_named_colors.R @@ -0,0 +1,260 @@ +# Test Script for Named Vector Color Support in desplot/ggdesplot +# Issue #10: https://github.com/kwstat/desplot/issues/10 +# +# This script tests named vector support for col.regions and col.text parameters + +library(desplot) +library(agridat) + +cat("=================================================================\n") +cat("Testing Named Vector Color Support - Issue #10\n") +cat("=================================================================\n\n") + +# Use yates.oats dataset from agridat +data(yates.oats) + +# Define colors for testing +my_colors <- c("skyblue", "pink", "lightgreen") +gen_levels <- levels(yates.oats$gen) +cat("Factor levels in data:", paste(gen_levels, collapse=", "), "\n\n") + +# ============================================================================= +# TEST 1: Named vectors with CORRECT order (forward) +# ============================================================================= +cat("TEST 1: Named vector col.regions - FORWARD ORDER\n") +cat("-------------------------------------------------------\n") +named_colors_forward <- my_colors +names(named_colors_forward) <- gen_levels +cat("Named vector:\n") +print(named_colors_forward) + +cat("\nTesting desplot()...\n") +try({ + p1 <- desplot(yates.oats, gen ~ col+row, + col.regions=named_colors_forward, + main="desplot: Named colors (forward)") + print(p1) + cat("✓ desplot with named colors (forward) succeeded\n") +}) + +cat("\nTesting ggdesplot()...\n") +try({ + p2 <- ggdesplot(yates.oats, gen ~ col+row, + col.regions=named_colors_forward, + main="ggdesplot: Named colors (forward)") + print(p2) + cat("✓ ggdesplot with named colors (forward) succeeded\n") +}) + +cat("\n") + +# ============================================================================= +# TEST 2: Named vectors with REVERSED order +# ============================================================================= +cat("TEST 2: Named vector col.regions - REVERSED ORDER\n") +cat("-------------------------------------------------------\n") +named_colors_reversed <- my_colors +names(named_colors_reversed) <- rev(gen_levels) # REVERSED! +cat("Named vector (reversed):\n") +print(named_colors_reversed) + +cat("\nTesting desplot()...\n") +try({ + p3 <- desplot(yates.oats, gen ~ col+row, + col.regions=named_colors_reversed, + main="desplot: Named colors (reversed)") + print(p3) + cat("✓ desplot with named colors (reversed) succeeded\n") + cat(" Colors should match by NAME, not position!\n") +}) + +cat("\nTesting ggdesplot()...\n") +try({ + p4 <- ggdesplot(yates.oats, gen ~ col+row, + col.regions=named_colors_reversed, + main="ggdesplot: Named colors (reversed)") + print(p4) + cat("✓ ggdesplot with named colors (reversed) succeeded\n") + cat(" Colors should match by NAME, not position!\n") +}) + +cat("\n") + +# ============================================================================= +# TEST 3: Named vectors with PARTIAL names (should warn + fallback) +# ============================================================================= +cat("TEST 3: Named vector col.regions - PARTIAL NAMES (should warn)\n") +cat("-------------------------------------------------------\n") +partial_colors <- c("red", "blue") +names(partial_colors) <- gen_levels[1:2] # Only first 2 levels +cat("Named vector (partial - missing one level):\n") +print(partial_colors) + +cat("\nTesting desplot()...\n") +cat("EXPECTED: Warning about missing level, fallback to positional\n") +try({ + p5 <- desplot(yates.oats, gen ~ col+row, + col.regions=partial_colors, + main="desplot: Partial names (should warn)") + print(p5) + cat("✓ desplot handled partial names (check for warning above)\n") +}) + +cat("\nTesting ggdesplot()...\n") +cat("EXPECTED: Warning about missing level, fallback to positional\n") +try({ + p6 <- ggdesplot(yates.oats, gen ~ col+row, + col.regions=partial_colors, + main="ggdesplot: Partial names (should warn)") + print(p6) + cat("✓ ggdesplot handled partial names (check for warning above)\n") +}) + +cat("\n") + +# ============================================================================= +# TEST 4: Named vectors with EXTRA names (should work, extras ignored) +# ============================================================================= +cat("TEST 4: Named vector col.regions - EXTRA NAMES (should work)\n") +cat("-------------------------------------------------------\n") +extra_colors <- c("purple", "orange", "brown", "yellow") +names(extra_colors) <- c(gen_levels, "ExtraLevel") # One extra name +cat("Named vector (with extra name):\n") +print(extra_colors) + +cat("\nTesting desplot()...\n") +try({ + p7 <- desplot(yates.oats, gen ~ col+row, + col.regions=extra_colors, + main="desplot: Extra names (should work)") + print(p7) + cat("✓ desplot with extra names succeeded (extras ignored)\n") +}) + +cat("\nTesting ggdesplot()...\n") +try({ + p8 <- ggdesplot(yates.oats, gen ~ col+row, + col.regions=extra_colors, + main="ggdesplot: Extra names (should work)") + print(p8) + cat("✓ ggdesplot with extra names succeeded (extras ignored)\n") +}) + +cat("\n") + +# ============================================================================= +# TEST 5: UNNAMED vectors (backward compatibility) +# ============================================================================= +cat("TEST 5: UNNAMED vector col.regions (backward compatibility)\n") +cat("-------------------------------------------------------\n") +unnamed_colors <- c("coral", "cyan", "gold") +cat("Unnamed vector:\n") +print(unnamed_colors) + +cat("\nTesting desplot()...\n") +try({ + p9 <- desplot(yates.oats, gen ~ col+row, + col.regions=unnamed_colors, + main="desplot: Unnamed colors") + print(p9) + cat("✓ desplot with unnamed colors succeeded (positional matching)\n") +}) + +cat("\nTesting ggdesplot()...\n") +try({ + p10 <- ggdesplot(yates.oats, gen ~ col+row, + col.regions=unnamed_colors, + main="ggdesplot: Unnamed colors") + print(p10) + cat("✓ ggdesplot with unnamed colors succeeded (positional matching)\n") +}) + +cat("\n") + +# ============================================================================= +# TEST 6: Named vectors for col.text (outline colors) +# ============================================================================= +cat("TEST 6: Named vector col.text (outline colors)\n") +cat("-------------------------------------------------------\n") +text_colors <- c("red", "blue", "green") +names(text_colors) <- rev(gen_levels) # Reversed order +cat("Named vector for col.text (reversed):\n") +print(text_colors) + +cat("\nTesting desplot()...\n") +try({ + p11 <- desplot(yates.oats, gen ~ col+row, + col=gen, + col.text=text_colors, + main="desplot: Named col.text") + print(p11) + cat("✓ desplot with named col.text succeeded\n") +}) + +cat("\nTesting ggdesplot()...\n") +try({ + p12 <- ggdesplot(yates.oats, gen ~ col+row, + col=gen, + col.text=text_colors, + main="ggdesplot: Named col.text") + print(p12) + cat("✓ ggdesplot with named col.text succeeded\n") +}) + +cat("\n") + +# ============================================================================= +# TEST 7: BOTH col.regions AND col.text with named vectors +# ============================================================================= +cat("TEST 7: BOTH col.regions AND col.text with named vectors\n") +cat("-------------------------------------------------------\n") +fill_colors <- c("lightyellow", "lightblue", "lightpink") +names(fill_colors) <- gen_levels +outline_colors <- c("darkred", "darkblue", "darkgreen") +names(outline_colors) <- rev(gen_levels) # Reversed! + +cat("Named col.regions:\n") +print(fill_colors) +cat("\nNamed col.text (reversed):\n") +print(outline_colors) + +cat("\nTesting desplot()...\n") +try({ + p13 <- desplot(yates.oats, gen ~ col+row, + col.regions=fill_colors, + col=gen, + col.text=outline_colors, + main="desplot: Both named colors") + print(p13) + cat("✓ desplot with both named colors succeeded\n") +}) + +cat("\nTesting ggdesplot()...\n") +try({ + p14 <- ggdesplot(yates.oats, gen ~ col+row, + col.regions=fill_colors, + col=gen, + col.text=outline_colors, + main="ggdesplot: Both named colors") + print(p14) + cat("✓ ggdesplot with both named colors succeeded\n") +}) + +cat("\n") + +# ============================================================================= +# SUMMARY +# ============================================================================= +cat("=================================================================\n") +cat("TEST SUMMARY\n") +cat("=================================================================\n") +cat("All tests completed! Check the output above for:\n") +cat(" 1. ✓ marks indicate successful execution\n") +cat(" 2. Warnings about partial names (TEST 3)\n") +cat(" 3. Visual confirmation that colors match correctly\n") +cat("\nKey verification:\n") +cat(" - TEST 2: Reversed names should show SAME colors as TEST 1\n") +cat(" (because matching by name, not position)\n") +cat(" - TEST 3: Should show warnings and fallback behavior\n") +cat(" - TEST 5: Should work exactly as before (backward compatible)\n") +cat("=================================================================\n") From 788bca5838b84219ce404683dc4b3365209e7408 Mon Sep 17 00:00:00 2001 From: Claude Date: Fri, 14 Nov 2025 11:06:07 +0000 Subject: [PATCH 2/2] Simplify test script to minimal essential tests --- test_named_colors.R | 278 +++++--------------------------------------- 1 file changed, 31 insertions(+), 247 deletions(-) diff --git a/test_named_colors.R b/test_named_colors.R index 3508bbe..686ca7c 100644 --- a/test_named_colors.R +++ b/test_named_colors.R @@ -1,260 +1,44 @@ -# Test Script for Named Vector Color Support in desplot/ggdesplot -# Issue #10: https://github.com/kwstat/desplot/issues/10 -# -# This script tests named vector support for col.regions and col.text parameters - +# Test Script for Named Vector Color Support - Issue #10 library(desplot) -library(agridat) - -cat("=================================================================\n") -cat("Testing Named Vector Color Support - Issue #10\n") -cat("=================================================================\n\n") -# Use yates.oats dataset from agridat -data(yates.oats) +# Simple test data: 2 rows x 3 columns, 3 factor levels +test_data <- data.frame( + row = rep(1:2, each=3), + col = rep(1:3, times=2), + treat = factor(rep(c("A", "B", "C"), length.out=6)) +) -# Define colors for testing +# TEST 1: Named vector - forward order my_colors <- c("skyblue", "pink", "lightgreen") -gen_levels <- levels(yates.oats$gen) -cat("Factor levels in data:", paste(gen_levels, collapse=", "), "\n\n") - -# ============================================================================= -# TEST 1: Named vectors with CORRECT order (forward) -# ============================================================================= -cat("TEST 1: Named vector col.regions - FORWARD ORDER\n") -cat("-------------------------------------------------------\n") -named_colors_forward <- my_colors -names(named_colors_forward) <- gen_levels -cat("Named vector:\n") -print(named_colors_forward) - -cat("\nTesting desplot()...\n") -try({ - p1 <- desplot(yates.oats, gen ~ col+row, - col.regions=named_colors_forward, - main="desplot: Named colors (forward)") - print(p1) - cat("✓ desplot with named colors (forward) succeeded\n") -}) - -cat("\nTesting ggdesplot()...\n") -try({ - p2 <- ggdesplot(yates.oats, gen ~ col+row, - col.regions=named_colors_forward, - main="ggdesplot: Named colors (forward)") - print(p2) - cat("✓ ggdesplot with named colors (forward) succeeded\n") -}) - -cat("\n") - -# ============================================================================= -# TEST 2: Named vectors with REVERSED order -# ============================================================================= -cat("TEST 2: Named vector col.regions - REVERSED ORDER\n") -cat("-------------------------------------------------------\n") -named_colors_reversed <- my_colors -names(named_colors_reversed) <- rev(gen_levels) # REVERSED! -cat("Named vector (reversed):\n") -print(named_colors_reversed) +names(my_colors) <- c("A", "B", "C") +desplot(test_data, treat ~ col*row, col.regions=my_colors, main="Test 1: Named forward", gg=FALSE) +desplot(test_data, treat ~ col*row, col.regions=my_colors, main="Test 1: Named forward (gg)", gg=TRUE) -cat("\nTesting desplot()...\n") -try({ - p3 <- desplot(yates.oats, gen ~ col+row, - col.regions=named_colors_reversed, - main="desplot: Named colors (reversed)") - print(p3) - cat("✓ desplot with named colors (reversed) succeeded\n") - cat(" Colors should match by NAME, not position!\n") -}) +# TEST 2: Named vector - reversed order (KEY TEST from issue #10) +my_colors_rev <- c("skyblue", "pink", "lightgreen") +names(my_colors_rev) <- c("C", "B", "A") # REVERSED! +desplot(test_data, treat ~ col*row, col.regions=my_colors_rev, main="Test 2: Named reversed", gg=FALSE) +desplot(test_data, treat ~ col*row, col.regions=my_colors_rev, main="Test 2: Named reversed (gg)", gg=TRUE) -cat("\nTesting ggdesplot()...\n") -try({ - p4 <- ggdesplot(yates.oats, gen ~ col+row, - col.regions=named_colors_reversed, - main="ggdesplot: Named colors (reversed)") - print(p4) - cat("✓ ggdesplot with named colors (reversed) succeeded\n") - cat(" Colors should match by NAME, not position!\n") -}) - -cat("\n") - -# ============================================================================= -# TEST 3: Named vectors with PARTIAL names (should warn + fallback) -# ============================================================================= -cat("TEST 3: Named vector col.regions - PARTIAL NAMES (should warn)\n") -cat("-------------------------------------------------------\n") +# TEST 3: Partial names (should warn and fallback) partial_colors <- c("red", "blue") -names(partial_colors) <- gen_levels[1:2] # Only first 2 levels -cat("Named vector (partial - missing one level):\n") -print(partial_colors) - -cat("\nTesting desplot()...\n") -cat("EXPECTED: Warning about missing level, fallback to positional\n") -try({ - p5 <- desplot(yates.oats, gen ~ col+row, - col.regions=partial_colors, - main="desplot: Partial names (should warn)") - print(p5) - cat("✓ desplot handled partial names (check for warning above)\n") -}) - -cat("\nTesting ggdesplot()...\n") -cat("EXPECTED: Warning about missing level, fallback to positional\n") -try({ - p6 <- ggdesplot(yates.oats, gen ~ col+row, - col.regions=partial_colors, - main="ggdesplot: Partial names (should warn)") - print(p6) - cat("✓ ggdesplot handled partial names (check for warning above)\n") -}) +names(partial_colors) <- c("A", "B") # Missing C +desplot(test_data, treat ~ col*row, col.regions=partial_colors, main="Test 3: Partial names", gg=FALSE) +desplot(test_data, treat ~ col*row, col.regions=partial_colors, main="Test 3: Partial names (gg)", gg=TRUE) -cat("\n") - -# ============================================================================= -# TEST 4: Named vectors with EXTRA names (should work, extras ignored) -# ============================================================================= -cat("TEST 4: Named vector col.regions - EXTRA NAMES (should work)\n") -cat("-------------------------------------------------------\n") +# TEST 4: Extra names (should work, extras ignored) extra_colors <- c("purple", "orange", "brown", "yellow") -names(extra_colors) <- c(gen_levels, "ExtraLevel") # One extra name -cat("Named vector (with extra name):\n") -print(extra_colors) - -cat("\nTesting desplot()...\n") -try({ - p7 <- desplot(yates.oats, gen ~ col+row, - col.regions=extra_colors, - main="desplot: Extra names (should work)") - print(p7) - cat("✓ desplot with extra names succeeded (extras ignored)\n") -}) - -cat("\nTesting ggdesplot()...\n") -try({ - p8 <- ggdesplot(yates.oats, gen ~ col+row, - col.regions=extra_colors, - main="ggdesplot: Extra names (should work)") - print(p8) - cat("✓ ggdesplot with extra names succeeded (extras ignored)\n") -}) +names(extra_colors) <- c("A", "B", "C", "D") # D doesn't exist +desplot(test_data, treat ~ col*row, col.regions=extra_colors, main="Test 4: Extra names", gg=FALSE) +desplot(test_data, treat ~ col*row, col.regions=extra_colors, main="Test 4: Extra names (gg)", gg=TRUE) -cat("\n") - -# ============================================================================= -# TEST 5: UNNAMED vectors (backward compatibility) -# ============================================================================= -cat("TEST 5: UNNAMED vector col.regions (backward compatibility)\n") -cat("-------------------------------------------------------\n") +# TEST 5: Unnamed vector (backward compatibility) unnamed_colors <- c("coral", "cyan", "gold") -cat("Unnamed vector:\n") -print(unnamed_colors) - -cat("\nTesting desplot()...\n") -try({ - p9 <- desplot(yates.oats, gen ~ col+row, - col.regions=unnamed_colors, - main="desplot: Unnamed colors") - print(p9) - cat("✓ desplot with unnamed colors succeeded (positional matching)\n") -}) - -cat("\nTesting ggdesplot()...\n") -try({ - p10 <- ggdesplot(yates.oats, gen ~ col+row, - col.regions=unnamed_colors, - main="ggdesplot: Unnamed colors") - print(p10) - cat("✓ ggdesplot with unnamed colors succeeded (positional matching)\n") -}) - -cat("\n") +desplot(test_data, treat ~ col*row, col.regions=unnamed_colors, main="Test 5: Unnamed", gg=FALSE) +desplot(test_data, treat ~ col*row, col.regions=unnamed_colors, main="Test 5: Unnamed (gg)", gg=TRUE) -# ============================================================================= -# TEST 6: Named vectors for col.text (outline colors) -# ============================================================================= -cat("TEST 6: Named vector col.text (outline colors)\n") -cat("-------------------------------------------------------\n") +# TEST 6: Named col.text (outline colors) text_colors <- c("red", "blue", "green") -names(text_colors) <- rev(gen_levels) # Reversed order -cat("Named vector for col.text (reversed):\n") -print(text_colors) - -cat("\nTesting desplot()...\n") -try({ - p11 <- desplot(yates.oats, gen ~ col+row, - col=gen, - col.text=text_colors, - main="desplot: Named col.text") - print(p11) - cat("✓ desplot with named col.text succeeded\n") -}) - -cat("\nTesting ggdesplot()...\n") -try({ - p12 <- ggdesplot(yates.oats, gen ~ col+row, - col=gen, - col.text=text_colors, - main="ggdesplot: Named col.text") - print(p12) - cat("✓ ggdesplot with named col.text succeeded\n") -}) - -cat("\n") - -# ============================================================================= -# TEST 7: BOTH col.regions AND col.text with named vectors -# ============================================================================= -cat("TEST 7: BOTH col.regions AND col.text with named vectors\n") -cat("-------------------------------------------------------\n") -fill_colors <- c("lightyellow", "lightblue", "lightpink") -names(fill_colors) <- gen_levels -outline_colors <- c("darkred", "darkblue", "darkgreen") -names(outline_colors) <- rev(gen_levels) # Reversed! - -cat("Named col.regions:\n") -print(fill_colors) -cat("\nNamed col.text (reversed):\n") -print(outline_colors) - -cat("\nTesting desplot()...\n") -try({ - p13 <- desplot(yates.oats, gen ~ col+row, - col.regions=fill_colors, - col=gen, - col.text=outline_colors, - main="desplot: Both named colors") - print(p13) - cat("✓ desplot with both named colors succeeded\n") -}) - -cat("\nTesting ggdesplot()...\n") -try({ - p14 <- ggdesplot(yates.oats, gen ~ col+row, - col.regions=fill_colors, - col=gen, - col.text=outline_colors, - main="ggdesplot: Both named colors") - print(p14) - cat("✓ ggdesplot with both named colors succeeded\n") -}) - -cat("\n") - -# ============================================================================= -# SUMMARY -# ============================================================================= -cat("=================================================================\n") -cat("TEST SUMMARY\n") -cat("=================================================================\n") -cat("All tests completed! Check the output above for:\n") -cat(" 1. ✓ marks indicate successful execution\n") -cat(" 2. Warnings about partial names (TEST 3)\n") -cat(" 3. Visual confirmation that colors match correctly\n") -cat("\nKey verification:\n") -cat(" - TEST 2: Reversed names should show SAME colors as TEST 1\n") -cat(" (because matching by name, not position)\n") -cat(" - TEST 3: Should show warnings and fallback behavior\n") -cat(" - TEST 5: Should work exactly as before (backward compatible)\n") -cat("=================================================================\n") +names(text_colors) <- c("C", "B", "A") # Reversed +desplot(test_data, treat ~ col*row, col=treat, col.text=text_colors, main="Test 6: Named col.text", gg=FALSE) +desplot(test_data, treat ~ col*row, col=treat, col.text=text_colors, main="Test 6: Named col.text (gg)", gg=TRUE)