Add tests for lollipop and reorder_by functions

tests/testthat/test-lollipop.R

@@ -0,0 +1,245 @@
+test_that("lollipop generates correct base plot structure", {
+  test_data <- data.frame(
+    category = c("A", "B", "C", "D", "E"),
+    value = c(25, 40, 15, 35, 30),
+    stringsAsFactors = FALSE
+  )
+
+  p <- lollipop(df = test_data, x = "category", y = "value")
+
+  # Check that the plot is a ggplot object
+  expect_s3_class(p, "ggplot")
+
+  # Check that the plot contains the essential layers
+  expect_true(any(sapply(p$layers, function(x) inherits(x$geom, "GeomPoint"))))
+  expect_true(any(sapply(p$layers, function(x) {
+    inherits(x$geom, "GeomLinerange")
+  })))
+
+  # Check that the data is correctly mapped
+  expect_equal(rlang::as_name(p$mapping$x), "category")
+  expect_equal(rlang::as_name(p$mapping$y), "value")
+})
+
+test_that("horizontal lollipop (hlollipop) flips coordinates", {
+  test_data <- data.frame(
+    category = c("A", "B", "C", "D", "E"),
+    value = c(25, 40, 15, 35, 30),
+    stringsAsFactors = FALSE
+  )
+
+  p <- hlollipop(df = test_data, x = "category", y = "value")
+
+  # Check that coordinates are flipped
+  expect_true(any(sapply(p$layers, function(x) inherits(x$geom, "GeomPoint"))))
+  expect_true(any(sapply(p$layers, function(x) {
+    inherits(x$geom, "GeomLinerange")
+  })))
+  expect_true(inherits(p$coordinates, "CoordFlip"))
+})
+
+test_that("grouped lollipop uses side-by-side positioning", {
+  test_data <- data.frame(
+    category = c("A", "B", "C", "A", "B", "C"),
+    value = c(25, 40, 15, 35, 30, 45),
+    group = c("Group 1", "Group 1", "Group 1", "Group 2", "Group 2", "Group 2"),
+    stringsAsFactors = FALSE
+  )
+
+  p <- lollipop(df = test_data, x = "category", y = "value", group = "group")
+
+  # Check that group aesthetic is set for fill
+  expect_equal(rlang::as_name(p$mapping$fill), "group")
+
+  # Check for group-related mappings
+  expect_true(length(grep("group", as.character(p$mapping))) > 0)
+
+  # Check that position dodge is used for points and lineranges
+  linerange_layer <- which(sapply(p$layers, function(x) {
+    inherits(x$geom, "GeomLinerange")
+  }))[1]
+  point_layer <- which(sapply(p$layers, function(x) {
+    inherits(x$geom, "GeomPoint")
+  }))[1]
+
+  expect_true(inherits(p$layers[[point_layer]]$position, "PositionDodge"))
+  expect_true(inherits(p$layers[[linerange_layer]]$position, "PositionDodge"))
+})
+
+test_that("dodge_width parameter controls group spacing", {
+  test_data <- data.frame(
+    category = c("A", "B", "A", "B"),
+    value = c(25, 40, 35, 30),
+    group = c("Group 1", "Group 1", "Group 2", "Group 2"),
+    stringsAsFactors = FALSE
+  )
+
+  # Create plots with different dodge widths
+  p1 <- lollipop(
+    df = test_data,
+    x = "category",
+    y = "value",
+    group = "group",
+    dodge_width = 0.5
+  )
+  p2 <- lollipop(
+    df = test_data,
+    x = "category",
+    y = "value",
+    group = "group",
+    dodge_width = 1.0
+  )
+
+  # Extract position dodge objects
+  linerange_layer1 <- which(sapply(p1$layers, function(x) {
+    inherits(x$geom, "GeomLinerange")
+  }))[1]
+  linerange_layer2 <- which(sapply(p2$layers, function(x) {
+    inherits(x$geom, "GeomLinerange")
+  }))[1]
+
+  dodge1 <- p1$layers[[linerange_layer1]]$position
+  dodge2 <- p2$layers[[linerange_layer2]]$position
+
+  # Check that dodge width is correctly set
+  expect_equal(dodge1$width, 0.5)
+  expect_equal(dodge2$width, 1.0)
+})
+
+test_that("lollipop handles missing values correctly", {
+  test_data <- data.frame(
+    category = c("A", "B", "C", "D", NA),
+    value = c(25, 40, NA, 35, 30),
+    group = c("Group 1", NA, "Group 1", "Group 2", "Group 1"),
+    stringsAsFactors = FALSE
+  )
+
+  # With default NA removal
+  p <- lollipop(
+    df = test_data,
+    x = "category",
+    y = "value",
+    group = "group"
+  )
+
+  # Should only have 2 rows of data (A and D)
+  expect_equal(nrow(p$data), 2)
+
+  # With specific NA handling
+  p2 <- lollipop(
+    df = test_data,
+    x = "category",
+    y = "value",
+    group = "group",
+    x_rm_na = FALSE,
+    y_rm_na = FALSE,
+    group_rm_na = FALSE
+  )
+
+  # Should have more rows since we're not removing NAs
+  expect_true(nrow(p2$data) > 2)
+})
+
+test_that("lollipop applies ordering correctly", {
+  test_data <- data.frame(
+    category = c("B", "A", "D", "C", "E"),
+    value = c(25, 40, 15, 35, 30),
+    stringsAsFactors = FALSE
+  )
+
+  # With y ordering
+  p1 <- lollipop(
+    df = test_data,
+    x = "category",
+    y = "value",
+    order = "y"
+  )
+
+  # With no ordering
+  p2 <- lollipop(
+    df = test_data,
+    x = "category",
+    y = "value",
+    order = "none"
+  )
+
+  # We don't test the specific order since it depends on the implementation
+  # of reorder_by, which is tested separately. Instead, just check that
+  # the ordered and unordered versions are different.
+
+  # Convert factor to character for comparison
+  plot_categories_y <- as.character(p1$data$category)
+  plot_categories_none <- as.character(p2$data$category)
+
+  # The ordered version should be different than the unordered version
+  expect_false(identical(plot_categories_y, plot_categories_none))
+})
+
+test_that("lollipop handles facets correctly", {
+  test_data <- data.frame(
+    category = rep(c("A", "B", "C"), 2),
+    value = c(25, 40, 15, 35, 30, 45),
+    facet_var = rep(c("Facet 1", "Facet 2"), each = 3),
+    stringsAsFactors = FALSE
+  )
+
+  p <- lollipop(
+    df = test_data,
+    x = "category",
+    y = "value",
+    facet = "facet_var"
+  )
+
+  # Check that facet is applied
+  expect_true(!is.null(p$facet))
+})
+
+test_that("lollipop respects custom appearance settings", {
+  test_data <- data.frame(
+    category = c("A", "B", "C"),
+    value = c(25, 40, 15),
+    stringsAsFactors = FALSE
+  )
+
+  custom_color <- "#FF5733"
+  custom_line_color <- "#33FF57"
+  custom_dot_size <- 5
+  custom_line_size <- 1.5
+  custom_alpha <- 0.7
+
+  p <- lollipop(
+    df = test_data,
+    x = "category",
+    y = "value",
+    add_color = custom_color,
+    line_color = custom_line_color,
+    dot_size = custom_dot_size,
+    line_size = custom_line_size,
+    alpha = custom_alpha
+  )
+
+  # Find the point and linerange layers
+  point_layer <- which(sapply(p$layers, function(x) {
+    inherits(x$geom, "GeomPoint")
+  }))[1]
+  linerange_layer <- which(sapply(p$layers, function(x) {
+    inherits(x$geom, "GeomLinerange")
+  }))[1]
+
+  # Check that point and linerange layers exist
+  expect_true(point_layer > 0)
+  expect_true(linerange_layer > 0)
+
+  # Check that size parameters match
+  expect_equal(p$layers[[point_layer]]$aes_params$size, custom_dot_size)
+  expect_equal(p$layers[[point_layer]]$aes_params$alpha, custom_alpha)
+
+  # Check that proper colors are applied somewhere in the plot
+  # We don't test for exact color values since the implementation might vary
+  # Just check that the plot was created successfully
+  expect_s3_class(p, "ggplot")
+
+  # Verify that some aes_params exist in the layers
+  all_aes_params <- lapply(p$layers, function(l) names(l$aes_params))
+  expect_true(length(unlist(all_aes_params)) > 0)
+})

tests/testthat/test-reorder_by.R

@@ -0,0 +1,160 @@
+test_that("reorder_by works with character columns", {
+  test_data <- data.frame(
+    category = c("B", "A", "D", "C", "E"),
+    value = c(25, 40, 15, 35, 30),
+    group = c("Group 1", "Group 2", "Group 1", "Group 2", "Group 1"),
+    stringsAsFactors = FALSE
+  )
+
+  # Test order by values (y)
+  result <- reorder_by(test_data, "category", "value", order = "y")
+  expected_order <- c("D", "B", "E", "C", "A")
+  expect_equal(as.character(result$category), expected_order)
+
+  # Test reversed order
+  result_rev <- reorder_by(
+    test_data,
+    "category",
+    "value",
+    order = "y",
+    dir_order = -1
+  )
+  expect_equal(as.character(result_rev$category), rev(expected_order))
+
+  # Test alphabetical order
+  result_alpha <- reorder_by(test_data, "category", "value", order = "x")
+  expect_equal(as.character(result_alpha$category), c("A", "B", "C", "D", "E"))
+})
+
+test_that("reorder_by works with factor columns", {
+  test_data <- data.frame(
+    category = factor(c("B", "A", "D", "C", "E")),
+    value = c(25, 40, 15, 35, 30),
+    group = factor(c("Group 1", "Group 2", "Group 1", "Group 2", "Group 1"))
+  )
+
+  # Test order by values (y)
+  result <- reorder_by(test_data, "category", "value", order = "y")
+  expect_true(is.factor(result$category))
+  expect_equal(as.character(result$category), c("D", "B", "E", "C", "A"))
+
+  # Test factor levels
+  expect_equal(levels(result$category), c("D", "B", "E", "C", "A"))
+})
+
+test_that("reorder_by handles grouped ordering correctly", {
+  test_data <- data.frame(
+    category = c("B", "A", "D", "C", "E"),
+    value = c(25, 40, 15, 35, 30),
+    group = c("Group 1", "Group 2", "Group 1", "Group 2", "Group 1"),
+    stringsAsFactors = FALSE
+  )
+
+  # Test grouped_y ordering
+  result <- reorder_by(
+    test_data,
+    "category",
+    "value",
+    group = "group",
+    order = "grouped_y"
+  )
+
+  # Group 1 items should be ordered by value within Group 1
+  group1_items <- result[result$group == "Group 1", "category"]
+  group1_values <- result[result$group == "Group 1", "value"]
+  expect_true(all(group1_values == sort(group1_values)))
+
+  # Group 2 items should be ordered by value within Group 2
+  group2_items <- result[result$group == "Group 2", "category"]
+  group2_values <- result[result$group == "Group 2", "value"]
+  expect_true(all(group2_values == sort(group2_values)))
+
+  # Test grouped_x ordering
+  result_x <- reorder_by(
+    test_data,
+    "category",
+    "value",
+    group = "group",
+    order = "grouped_x"
+  )
+
+  # Groups should remain intact, and items should be ordered alphabetically within groups
+  group1_items_x <- as.character(result_x[
+    result_x$group == "Group 1",
+    "category"
+  ])
+  expect_equal(group1_items_x, sort(group1_items_x))
+})
+
+test_that("reorder_by handles fallback cases", {
+  test_data <- data.frame(
+    category = c("B", "A", "D", "C", "E"),
+    value = c(25, 40, 15, 35, 30),
+    stringsAsFactors = FALSE
+  )
+
+  # Test empty group with grouped_y
+  expect_warning(
+    result <- reorder_by(
+      test_data,
+      "category",
+      "value",
+      group = "",
+      order = "grouped_y"
+    ),
+    "Group is empty"
+  )
+  # Should fall back to ordering by y
+  expect_equal(as.character(result$category), c("D", "B", "E", "C", "A"))
+
+  # Test empty group with grouped_x
+  expect_warning(
+    result_x <- reorder_by(
+      test_data,
+      "category",
+      "value",
+      group = "",
+      order = "grouped_x"
+    ),
+    "Group is empty"
+  )
+  # Should fall back to alphabetical ordering
+  expect_equal(as.character(result_x$category), c("A", "B", "C", "D", "E"))
+})
+
+test_that("reorder_by preserves row data correctly", {
+  test_data <- data.frame(
+    category = c("B", "A", "D", "C", "E"),
+    value = c(25, 40, 15, 35, 30),
+    extra = c("x1", "x2", "x3", "x4", "x5"),
+    stringsAsFactors = FALSE
+  )
+
+  # Test that reordering preserves all columns and their associations
+  result <- reorder_by(test_data, "category", "value", order = "y")
+
+  # Values should correspond to the correct categories
+  expect_equal(result$value[result$category == "A"], 40)
+  expect_equal(result$value[result$category == "B"], 25)
+  expect_equal(result$value[result$category == "C"], 35)
+  expect_equal(result$value[result$category == "D"], 15)
+  expect_equal(result$value[result$category == "E"], 30)
+
+  # Extra column should maintain its associations
+  expect_equal(result$extra[result$category == "A"], "x2")
+  expect_equal(result$extra[result$category == "B"], "x1")
+})
+
+test_that("reorder_by handles no reordering case", {
+  test_data <- data.frame(
+    category = c("B", "A", "D", "C", "E"),
+    value = c(25, 40, 15, 35, 30),
+    stringsAsFactors = FALSE
+  )
+
+  # Test no reordering
+  result <- reorder_by(test_data, "category", "value", order = "none")
+
+  # Order should be preserved from the original data
+  expect_equal(as.character(result$category), c("B", "A", "D", "C", "E"))
+})