From f8a5a58e03c42987a3f2bc292a578604af5f8ddd Mon Sep 17 00:00:00 2001 From: AviraL0013 Date: Mon, 9 Mar 2026 00:07:13 +0530 Subject: [PATCH 1/4] add renderer test for student performance subject comparison --- tests/testthat/test-renderer-grade-trends.R | 133 ++++++++++++++++++++ 1 file changed, 133 insertions(+) create mode 100644 tests/testthat/test-renderer-grade-trends.R diff --git a/tests/testthat/test-renderer-grade-trends.R b/tests/testthat/test-renderer-grade-trends.R new file mode 100644 index 000000000..2c4ab76ef --- /dev/null +++ b/tests/testthat/test-renderer-grade-trends.R @@ -0,0 +1,133 @@ +library(XML) +library(animint2) + +acontext("student performance subject comparison") + +subject_summary <- data.frame( + subject = rep(c( + "Mathematics", "Physics", "Chemistry", + "Biology", "English", "History" + ), times = 2), + mean_grade = c( + 72.5, 74.3, 75.8, 77.2, 79.1, 80.4, + 73.5, 75.3, 76.8, 78.2, 80.1, 81.4 + ), + semester = rep(c("Sem1", "Sem2"), each = 6), + stringsAsFactors = FALSE +) + +student_points <- data.frame( + subject = rep(c( + "Mathematics", "Physics", "Chemistry", + "Biology", "English", "History" + ), each = 5), + grade = c( + 65, 70, 72, 75, 80, + 68, 72, 74, 76, 82, + 70, 73, 75, 78, 83, + 72, 75, 77, 80, 85, + 74, 77, 79, 82, 87, + 75, 78, 80, 83, 88 + ), + semester = rep("Sem1", 30), + stringsAsFactors = FALSE +) + +viz <- animint( + subjectComparison = ggplot() + + theme_bw() + + theme_animint(width = 680, height = 380) + + geom_bar( + aes( + x = subject, y = mean_grade, + fill = subject, key = subject + ), + showSelected = "semester", + clickSelects = "subject", + data = subject_summary, + stat = "identity", + position = "identity", + alpha = 0.7 + ) + + geom_point( + aes( + x = subject, y = grade, + color = subject, + key = paste(subject, grade) + ), + showSelected = "semester", + clickSelects = "subject", + data = student_points, + alpha = 0.6 + ) + + ggtitle("Subject Performance Comparison") + + xlab("Subject") + + ylab("Grade (%)"), + first = list(semester = "Sem1", subject = "Mathematics") +) + +info <- animint2HTML(viz) + +# test 1 - exactly 6 bar rects rendered, one per subject +test_that("subjectComparison renders exactly 6 bar rects for 6 subjects", { + rects <- getNodeSet( + info$html, + "//rect[not(@class)]" + ) + expect_equal(length(rects), 6L) +}) + +# test 2 - point circles rendered for student grades +test_that("subjectComparison renders point circles for students", { + circles <- getNodeSet( + info$html, + '//g[contains(@class,"geom")]//circle' + ) + expect_true(length(circles) > 0) +}) + +# test 3 - selector widget exists for subject +test_that("subject selector widget is present", { + inputs <- getNodeSet( + info$html, + "//select | //input[@type='radio']" + ) + expect_true(length(inputs) > 0) +}) + +# test 4 - semester selector has exactly 2 options (Sem1 and Sem2) +test_that("semester selector has exactly 2 options", { + options <- getNodeSet( + info$html, + "//select//option" + ) + expect_equal(length(options), 2L) +}) + +# test 5 - plot title is rendered correctly in SVG +test_that("plot title text is rendered in SVG", { + titles <- getNodeSet( + info$html, + '//text[contains(text(), "Subject Performance Comparison")]' + ) + expect_true(length(titles) > 0) +}) + +# test 6 - all 6 subject names appear as axis tick labels +test_that("all 6 subject names appear as x axis labels", { + subjects <- c( + "Mathematics", "Physics", "Chemistry", + "Biology", "English", "History" + ) + tick_nodes <- getNodeSet( + info$html, + "//g[contains(@class,'xaxis')]//text" + ) + tick_labels <- sapply(tick_nodes, xmlValue) + for (s in subjects) { + expect_true( + any(grepl(s, tick_labels)), + info = paste("subject not found in axis labels:", s) + ) + } +}) From e904fa187fedb0f24830805a9e5689ccd6a18ca3 Mon Sep 17 00:00:00 2001 From: AviraL0013 Date: Wed, 11 Mar 2026 00:06:30 +0530 Subject: [PATCH 2/4] address review: add clickID interaction test and use expect_equal for title --- tests/testthat/test-renderer-grade-trends.R | 34 ++++++++++++++++++--- 1 file changed, 30 insertions(+), 4 deletions(-) diff --git a/tests/testthat/test-renderer-grade-trends.R b/tests/testthat/test-renderer-grade-trends.R index 2c4ab76ef..a1efcd0df 100644 --- a/tests/testthat/test-renderer-grade-trends.R +++ b/tests/testthat/test-renderer-grade-trends.R @@ -18,7 +18,7 @@ subject_summary <- data.frame( student_points <- data.frame( subject = rep(c( - "Mathematics", "Physics", "Chemistry", + "Mathematics", "Physics", "Chemistry", "Biology", "English", "History" ), each = 5), grade = c( @@ -104,13 +104,13 @@ test_that("semester selector has exactly 2 options", { expect_equal(length(options), 2L) }) -# test 5 - plot title is rendered correctly in SVG -test_that("plot title text is rendered in SVG", { +# test 5 - plot title is rendered correctly in SVG (fixed: more specific) +test_that("plot title text is rendered exactly once in SVG", { titles <- getNodeSet( info$html, '//text[contains(text(), "Subject Performance Comparison")]' ) - expect_true(length(titles) > 0) + expect_equal(length(titles), 1L) }) # test 6 - all 6 subject names appear as axis tick labels @@ -131,3 +131,29 @@ test_that("all 6 subject names appear as x axis labels", { ) } }) + +# test 7 - clickID on Physics updates selected subject in browser +test_that("clicking Physics bar updates the selected subject", { + clickID("Physics") + Sys.sleep(1) + html_after <- getHTML() + # after clicking Physics, circles for Physics should be visible + circles_after <- getNodeSet( + html_after, + '//g[contains(@class,"geom")]//circle' + ) + expect_true(length(circles_after) > 0) +}) + +# test 8 - clicking Sem2 option updates bars to show Sem2 data +test_that("selecting Sem2 updates bars to show Sem2 mean grades", { + clickHTML(xpath = "//option[@value='Sem2']") + Sys.sleep(1) + html_after <- getHTML() + rects_after <- getNodeSet( + html_after, + "//rect[not(@class)]" + ) + # bars should still be 6 after semester change + expect_equal(length(rects_after), 6L) +}) From 15d64c045157c826f7539a06fc0a3079a253f65d Mon Sep 17 00:00:00 2001 From: AviraL0013 Date: Wed, 11 Mar 2026 03:18:59 +0530 Subject: [PATCH 3/4] fix clickID test to check Physics label opacity change --- tests/testthat/test-renderer-grade-trends.R | 27 +++++++++++++++------ 1 file changed, 20 insertions(+), 7 deletions(-) diff --git a/tests/testthat/test-renderer-grade-trends.R b/tests/testthat/test-renderer-grade-trends.R index a1efcd0df..28729d86f 100644 --- a/tests/testthat/test-renderer-grade-trends.R +++ b/tests/testthat/test-renderer-grade-trends.R @@ -132,17 +132,30 @@ test_that("all 6 subject names appear as x axis labels", { } }) -# test 7 - clickID on Physics updates selected subject in browser -test_that("clicking Physics bar updates the selected subject", { - clickID("Physics") +# test 7 - clicking Physics legend highlights Physics bar +test_that("clicking Physics legend toggles Physics selection", { + # before - only Mathematics selected + html_before <- getHTML() + math_label <- getNodeSet( + html_before, + '//td[@id="plot_subjectComparison_subject_variable_Mathematics_label"]' + ) + before_opacity <- xmlGetAttr(math_label[[1]], "style") + + # click Physics to add it to selection + clickID("plot_subjectComparison_subject_variable_Physics") Sys.sleep(1) + + # after - Physics label should now be full opacity html_after <- getHTML() - # after clicking Physics, circles for Physics should be visible - circles_after <- getNodeSet( + physics_label <- getNodeSet( html_after, - '//g[contains(@class,"geom")]//circle' + '//td[@id="plot_subjectComparison_subject_variable_Physics_label"]' ) - expect_true(length(circles_after) > 0) + after_opacity <- xmlGetAttr(physics_label[[1]], "style") + + # Physics opacity changes from 0.5 to 1 after click + expect_true(grepl("opacity: 1", after_opacity)) }) # test 8 - clicking Sem2 option updates bars to show Sem2 data From 6d258106b2cada8c1f508d5ebb1a5abd9b538fca Mon Sep 17 00:00:00 2001 From: AviraL0013 Date: Wed, 11 Mar 2026 03:24:33 +0530 Subject: [PATCH 4/4] remove test 8 keep only 7 tests --- tests/testthat/test-renderer-grade-trends.R | 13 +------------ 1 file changed, 1 insertion(+), 12 deletions(-) diff --git a/tests/testthat/test-renderer-grade-trends.R b/tests/testthat/test-renderer-grade-trends.R index 28729d86f..ff929f738 100644 --- a/tests/testthat/test-renderer-grade-trends.R +++ b/tests/testthat/test-renderer-grade-trends.R @@ -158,15 +158,4 @@ test_that("clicking Physics legend toggles Physics selection", { expect_true(grepl("opacity: 1", after_opacity)) }) -# test 8 - clicking Sem2 option updates bars to show Sem2 data -test_that("selecting Sem2 updates bars to show Sem2 mean grades", { - clickHTML(xpath = "//option[@value='Sem2']") - Sys.sleep(1) - html_after <- getHTML() - rects_after <- getNodeSet( - html_after, - "//rect[not(@class)]" - ) - # bars should still be 6 after semester change - expect_equal(length(rects_after), 6L) -}) +