Fix focal fill error when personID column uses non-default name

R/ggpedigreeCoreHelpers.R

@@ -168,7 +168,7 @@ createFillColumn <- function(ped,
     stop(paste(
       "focal_fill_personID",
       focal_fill_personID,
-      "not found in ped$personID."
+      paste0("not found in ped$", personID, ".")
     ))
   }
   fill_df <- data.frame(
@@ -177,8 +177,8 @@ createFillColumn <- function(ped,
   ) # needs to match the same data type
 
   remove(com_mat) # remove the focal_fill_personID column
-  # Ensure fill_df$personID is of the same type as ped$personID
-  if (is.numeric(ped$personID)) {
+  # Ensure fill_df$personID is of the same type as ped[[personID]]
+  if (is.numeric(ped[[personID]])) {
     fill_df$personID <- as.numeric(fill_df$personID)
   }
   if (config$focal_fill_force_zero == TRUE) {
@@ -377,7 +377,7 @@ addFocalFillColumn <- function(ds_ped,
             component = config$focal_fill_component,
             config = config
           ),
-          by = dplyr::join_by(personID == !!rlang::sym(personID))
+          by = dplyr::join_by(!!rlang::sym(personID) == personID)
         )
 
       # -----

tests/testthat/test-clinicalPedigree.R

@@ -51,8 +51,8 @@
 
   # delete svg files after reading
 
-  file.remove("built_coded.svg")
-  file.remove("built_uncoded.svg")
+ # file.remove("built_coded.svg")
+#  file.remove("built_uncoded.svg")
 
   expect_true(any(grepl("fill:\\s*#FF0000", built_coded.svg)))
   expect_true(any(grepl("fill:\\s*#FF0000", built_uncoded.svg)))
@@ -158,6 +158,29 @@
     )
   )
   expect_s3_class(p, "gg")
+
+
+  # expect_equal(as_label(p$layers[[?]]$mapping$fill), "as.factor(SEP)")
+  # could by any of the layers that has fill mapping, but should be the same in both plots since unaffected_fill_color just fills in NA values in the data
+  fill_mappings <- vapply(
+    p$layers,
+    function(layer) {
+      fill <- layer$mapping$fill
+      if (rlang::is_missing(fill) || is.null(fill)) NA_character_ else as_label(fill)
+    },
+    character(1)
+  )
+  colnames_mappings <- vapply(
+    p$layers,
+    function(layer) {
+      color <- layer$mapping$colour
+      if (rlang::is_missing(color) || is.null(color)) NA_character_ else as_label(color)
+    },
+    character(1)
+  )
+
+  expect_true("as.factor(SEP)" %in% fill_mappings)
+  expect_true("as.factor(INCLUS)" %in% colnames_mappings)
 })
 
 test_that("all features compose without error", {

tests/testthat/test-ggPedigree.R

@@ -286,6 +286,31 @@ test_that("focal fill works with ID", {
   expect_true(all(p3$data$focal_fill[p3$data$personID == 8] == 1))
 })
 
+test_that("focal fill works with non-standard personID column name", {
+  library(BGmisc)
+  data("potter") # load example data from BGmisc
+
+  # Rename personID column to a non-standard name
+  potter_renamed <- potter
+  names(potter_renamed)[names(potter_renamed) == "personID"] <- "ID"
+
+  p <- ggPedigree(potter_renamed,
+    famID = "famID",
+    personID = "ID",
+    config = list(
+      focal_fill_include = TRUE,
+      sex_color_include = FALSE,
+      focal_fill_personID = 8
+    )
+  )
+  expect_s3_class(p, "gg") # Should return a ggplot object
+  expect_true("focal_fill" %in% names(p$data)) # focal_fill column should be present
+  expect_true(all(p$data$focal_fill >= 0 & p$data$focal_fill <= 1)) # focal_fill values should be between 0 and 1
+
+  # focal_fill for ID 8 should be 1
+  expect_true(all(p$data$focal_fill[p$data$ID == 8] == 1))
+})
+
 test_that("focal fill works with ID and different methods", {
   library(BGmisc)
   data("potter") # load example data from BGmisc