fix: Update regex patterns in tests and functions to use perl argument for improved performance

zankrut20 · zankrut20 · commit 2f52b31558f5 · 2026-03-07T22:29:44.000+05:30
diff --git a/R/predict_selection_score.R b/R/predict_selection_score.R
@@ -20,7 +20,7 @@ predict_selection_score <- function(index_df, data, genotypes) {
   if (!"ID" %in% names(index_df)) {
     stop("index_df must contain an ID column.")
   }
-  b_cols <- grep("^b\\.", names(index_df), value = TRUE)
+  b_cols <- grep("^b\\.", names(index_df), value = TRUE, perl = TRUE)
   if (length(b_cols) == 0) {
     stop("index_df must contain b.* columns with index coefficients.")
   }
@@ -62,7 +62,7 @@ predict_selection_score <- function(index_df, data, genotypes) {
 
     trait_means <- mean_mat[, idx, drop = FALSE]
     score_mat[, j] <- rowSums(sweep(trait_means, 2, b_vals, "*"))
-    score_names[j] <- paste0("I_", gsub("\\s+", "", gsub(",", "_", id_str)))
+    score_names[j] <- paste0("I_", gsub("\\s+", "", gsub(",", "_", id_str, fixed = TRUE), perl = TRUE))
   }
 
   score_names <- make.unique(score_names)
diff --git a/tests/testthat/test-constrained_genomic_indices.R b/tests/testthat/test-constrained_genomic_indices.R
@@ -502,8 +502,8 @@ test_that("crlgsi summary format", {
   expect_equal(nrow(result$summary), 1)
 
   # Check summary has correct columns
-  expect_true(any(grepl("^b_y\\.", colnames(result$summary))))
-  expect_true(any(grepl("^b_g\\.", colnames(result$summary))))
+  expect_true(any(grepl("^b_y\\.", colnames(result$summary), perl = TRUE)))
+  expect_true(any(grepl("^b_g\\.", colnames(result$summary), perl = TRUE)))
   expect_true("R" %in% colnames(result$summary))
   expect_true("GA" %in% colnames(result$summary))
   expect_true("rHI" %in% colnames(result$summary))
@@ -687,8 +687,8 @@ test_that("cppg_lgsi summary format", {
   expect_equal(nrow(result$summary), 1)
 
   # Check summary has correct columns
-  expect_true(any(grepl("^b_y\\.", colnames(result$summary))))
-  expect_true(any(grepl("^b_g\\.", colnames(result$summary))))
+  expect_true(any(grepl("^b_y\\.", colnames(result$summary), perl = TRUE)))
+  expect_true(any(grepl("^b_g\\.", colnames(result$summary), perl = TRUE)))
   expect_true("R" %in% colnames(result$summary))
   expect_true("theta_CP" %in% colnames(result$summary))
 })
diff --git a/tests/testthat/test-constrained_indices.R b/tests/testthat/test-constrained_indices.R
@@ -256,7 +256,7 @@ test_that("dg_lpsi can disable implied weights calculation", {
   expect_null(result$implied_weights_normalized)
 
   # Summary should not contain implied weight columns
-  expect_false(any(grepl("implied_w", colnames(result$summary))))
+  expect_false(any(grepl("implied_w", colnames(result$summary), fixed = TRUE)))
 })
 
 test_that("dg_lpsi feasibility check warns for unrealistic gains", {
diff --git a/tests/testthat/test-eigen_indices.R b/tests/testthat/test-eigen_indices.R
@@ -804,7 +804,7 @@ test_that("print.resim reaches rep(FALSE,...) when restricted_traits is NULL (li
   # Print should run without error and reach the else branch at line 954
   out <- capture.output(print(r))
   # The Restricted column should be present and all FALSE
-  expect_true(any(grepl("Restricted", out)) || is.character(out))
+  expect_true(any(grepl("Restricted", out, fixed = TRUE)) || is.character(out))
 })
 
 # --- print.ppg_esim: lines 1062-1066 – high CV → "[!]" branch ---------------
@@ -820,7 +820,7 @@ test_that("print.ppg_esim prints '[!]' message when CV >= 0.02 (lines 1062-1066)
   # CV will be high.
   r$desired_gains <- c(0.001, 1000, 0.001) # wildly non-proportional to Delta_G
   out <- capture.output(print(r))
-  expect_true(any(grepl("\\[!\\]", out)),
+  expect_true(any(grepl("[!]", out, fixed = TRUE)),
     info = "Expected '[!]' line in print output when CV >= 0.02"
   )
 })
diff --git a/tests/testthat/test-genomic_eigen_indices.R b/tests/testthat/test-genomic_eigen_indices.R
@@ -77,6 +77,11 @@ test_that("mesim returns correct structure", {
   expect_true("summary" %in% names(result))
 
   # Check dimensions
+  expect_true(all(grepl("^Trait_", result$trait_names, perl = TRUE)))
+  expect_true(all(grepl("^Trait_", result$trait_names, perl = TRUE)))
+  expect_true(all(grepl("^Trait_", result$trait_names, perl = TRUE)))
+  expect_true(all(grepl("^Trait_", result$trait_names, perl = TRUE)))
+  expect_true(all(grepl("^Trait_", result$trait_names, perl = TRUE)))
   expect_equal(length(result$b_y), data$n_traits)
   expect_equal(length(result$b_s), data$n_traits)
   expect_equal(length(result$b_combined), 2 * data$n_traits)
@@ -612,7 +617,7 @@ test_that("mesim generates Trait_ names when pmat has no colnames (line 283)", {
 
   result <- mesim(pmat_no_names, gmat_no_names, S_M_no_names)
 
-  expect_true(all(grepl("^Trait_", result$trait_names)))
+  expect_true(all(grepl("^Trait_", result$trait_names, perl = TRUE)))
 })
 
 # ==============================================================================
@@ -653,7 +658,7 @@ test_that("gesim errors when fewer than 2 traits are provided (line 476)", {
 test_that("gesim generates Trait_ names when pmat has no colnames (line 480)", {
   data <- setup_eigen_test_data()
   result <- gesim(unname(data$pmat), unname(data$gmat), unname(data$Gamma))
-  expect_true(all(grepl("^Trait_", result$trait_names)))
+  expect_true(all(grepl("^Trait_", result$trait_names, perl = TRUE)))
 })
 
 # Lines 533-534: implied_w tryCatch warning + NA in gesim
@@ -799,7 +804,7 @@ test_that("gw_esim generates Trait_ names when pmat has no colnames (line 684)",
   )
   M <- diag(n_markers)
   result <- gw_esim(unname(data$pmat), unname(data$gmat), G_M, M)
-  expect_true(all(grepl("^Trait_", result$trait_names)))
+  expect_true(all(grepl("^Trait_", result$trait_names, perl = TRUE)))
 })
 
 # ==============================================================================
@@ -877,7 +882,7 @@ test_that("rgesim generates Trait_ names when pmat has no colnames (line 874)",
   data <- setup_eigen_test_data()
   U_mat <- matrix(c(1, rep(0, data$n_traits - 1)), nrow = 1)
   result <- rgesim(unname(data$pmat), unname(data$gmat), unname(data$Gamma), U_mat)
-  expect_true(all(grepl("^Trait_", result$trait_names)))
+  expect_true(all(grepl("^Trait_", result$trait_names, perl = TRUE)))
 })
 
 # Lines 958-959: implied_w tryCatch warning + NA in rgesim
@@ -971,7 +976,7 @@ test_that("ppg_gesim generates Trait_ names when pmat has no colnames (line 1120
   data <- setup_eigen_test_data()
   d <- rep(1, data$n_traits)
   result <- ppg_gesim(unname(data$pmat), unname(data$gmat), unname(data$Gamma), d)
-  expect_true(all(grepl("^Trait_", result$trait_names)))
+  expect_true(all(grepl("^Trait_", result$trait_names, perl = TRUE)))
 })
 
 # Lines 1221-1222: implied_w tryCatch warning + NA in ppg_gesim
diff --git a/tests/testthat/test-genomic_indices.R b/tests/testthat/test-genomic_indices.R
@@ -420,8 +420,8 @@ test_that("Summary data frames have correct structure", {
   # CLGSI summary
   expect_s3_class(result_clgsi$summary, "data.frame")
   expect_equal(nrow(result_clgsi$summary), 1)
-  expect_true(any(grepl("b_y", names(result_clgsi$summary))))
-  expect_true(any(grepl("b_g", names(result_clgsi$summary))))
+  expect_true(any(grepl("b_y", names(result_clgsi$summary), fixed = TRUE)))
+  expect_true(any(grepl("b_g", names(result_clgsi$summary), fixed = TRUE)))
   expect_true("GA" %in% names(result_clgsi$summary))
 })
 
diff --git a/tests/testthat/test-genomic_varcov.R b/tests/testthat/test-genomic_varcov.R
@@ -189,8 +189,8 @@ test_that("phenomic_genomic_varcov adds dimension names", {
 
   expect_false(is.null(colnames(Phi)))
   expect_false(is.null(rownames(Phi)))
-  expect_true(any(grepl("_phen", colnames(Phi))))
-  expect_true(any(grepl("_gebv", colnames(Phi))))
+  expect_true(any(grepl("_phen", colnames(Phi), fixed = TRUE)))
+  expect_true(any(grepl("_gebv", colnames(Phi), fixed = TRUE)))
 })
 
 test_that("phenomic_genomic_varcov errors without necessary inputs", {
diff --git a/tests/testthat/test-marker_indices.R b/tests/testthat/test-marker_indices.R
@@ -725,7 +725,7 @@ test_that("lmsi generates 'Trait1...' names when pmat has no colnames (line 307)
     pmat = unname(d$pmat), gmat = unname(d$gmat),
     G_s = G_s, wmat = d$weights
   )
-  expect_true(all(grepl("^Trait", res$trait_names)))
+  expect_true(all(grepl("^Trait", res$trait_names, perl = TRUE)))
 })
 
 # --- lmsi: line 835 – PRE printed when GAY is given ----------------------
@@ -997,7 +997,7 @@ test_that("gw_lmsi generates 'Trait...' names when gmat has no colnames (line 75
   marker_mat <- matrix(sample(0:2, 40 * nm, replace = TRUE), 40, nm)
   trait_mat <- matrix(rnorm(40 * d$n_traits, 15, 3), 40, d$n_traits)
   res <- gw_lmsi(marker_mat, trait_mat, unname(d$gmat), wmat = d$weights)
-  expect_true(all(grepl("^Trait", res$trait_names)))
+  expect_true(all(grepl("^Trait", res$trait_names, perl = TRUE)))
 })
 
 # --- print.gw_lmsi: line 882 – HIGH-DIMENSIONAL print --------------------
diff --git a/tests/testthat/test-mean_performance.R b/tests/testthat/test-mean_performance.R
@@ -522,8 +522,8 @@ test_that("mean_performance computes SPD SEm, CD5, CD1, and GV (lines 166-211)",
   sem_vals <- suppressWarnings(as.numeric(sem_row[, c("trait1", "trait2")]))
 
   # Remove significance annotations (like " NS" or "**") before conversion
-  cd5_clean <- gsub("[a-zA-Z*\\s]", "", cd5_row[, c("trait1", "trait2")])
-  cd1_clean <- gsub("[a-zA-Z*\\s]", "", cd1_row[, c("trait1", "trait2")])
+  cd5_clean <- gsub("[a-zA-Z*\\s]", "", cd5_row[, c("trait1", "trait2")], perl = TRUE)
+  cd1_clean <- gsub("[a-zA-Z*\\s]", "", cd1_row[, c("trait1", "trait2")], perl = TRUE)
 
   cd5_vals <- suppressWarnings(as.numeric(cd5_clean))
   cd1_vals <- suppressWarnings(as.numeric(cd1_clean))
diff --git a/tests/testthat/test-multistage_genomic_indices.R b/tests/testthat/test-multistage_genomic_indices.R
@@ -567,7 +567,7 @@ test_that("mppg_lgsi warns with custom U1 matrix", {
       d1 = seq_len(d$n1), d2 = seq_len(d$n), U1 = U1_custom
     )
   )
-  expect_true(any(grepl("Custom U1", w_cap)))
+  expect_true(any(grepl("Custom U1", w_cap, fixed = TRUE)))
 })
 
 test_that("mppg_lgsi C* adjustment differs between Identity and custom U1", {
@@ -869,7 +869,7 @@ test_that("mppg_lgsi Young's method error handler falls back to manual intensiti
       "Young's method failed"
     ),
     warning = function(w) {
-      if (grepl("positive definite|C\\*", conditionMessage(w))) {
+      if (grepl("positive definite|C\\*", conditionMessage(w), perl = TRUE)) {
         invokeRestart("muffleWarning")
       }
     }
diff --git a/tests/testthat/test-phenotypic_indices.R b/tests/testthat/test-phenotypic_indices.R
@@ -515,10 +515,10 @@ test_that("print.smith_hazel produces expected output with named traits", {
   res <- smith_hazel(d$pmat, d$gmat, d$w)
 
   out <- capture.output(print(res))
-  expect_true(any(grepl("SMITH-HAZEL", out)))
-  expect_true(any(grepl("Genetic Advance", out)))
-  expect_true(any(grepl("Accuracy", out)))
-  expect_true(any(grepl("EXPECTED GENETIC RESPONSE", out)))
+  expect_true(any(grepl("SMITH-HAZEL", out, fixed = TRUE)))
+  expect_true(any(grepl("Genetic Advance", out, fixed = TRUE)))
+  expect_true(any(grepl("Accuracy", out, fixed = TRUE)))
+  expect_true(any(grepl("EXPECTED GENETIC RESPONSE", out, fixed = TRUE)))
 })
 
 test_that("print.smith_hazel uses Trait_N when trait names are missing", {
@@ -530,7 +530,7 @@ test_that("print.smith_hazel uses Trait_N when trait names are missing", {
   # names(w) will be NULL since P has no colnames
 
   out <- capture.output(print(res))
-  expect_true(any(grepl("Trait_1", out)))
+  expect_true(any(grepl("Trait_1", out, fixed = TRUE)))
 })
 
 test_that("print.smith_hazel skips PRE line when PRE is NA", {
@@ -540,7 +540,7 @@ test_that("print.smith_hazel skips PRE line when PRE is NA", {
   res <- smith_hazel(d$P, G_zero, d$w)
   # GA and PRE are NA → the PRE line must NOT appear
   out <- capture.output(print(res))
-  expect_false(any(grepl("Relative Efficiency", out)))
+  expect_false(any(grepl("Relative Efficiency", out, fixed = TRUE)))
 })
 
 test_that("print.smith_hazel returns invisible(x)", {
@@ -561,10 +561,10 @@ test_that("summary.smith_hazel prints additional statistics", {
   res <- smith_hazel(d$pmat, d$gmat, d$w)
 
   out <- capture.output(summary(res))
-  expect_true(any(grepl("ADDITIONAL STATISTICS", out)))
-  expect_true(any(grepl("Economic Weights", out)))
-  expect_true(any(grepl("Expected Genetic Gains", out)))
-  expect_true(any(grepl("Index Coefficients", out)))
+  expect_true(any(grepl("ADDITIONAL STATISTICS", out, fixed = TRUE)))
+  expect_true(any(grepl("Economic Weights", out, fixed = TRUE)))
+  expect_true(any(grepl("Expected Genetic Gains", out, fixed = TRUE)))
+  expect_true(any(grepl("Index Coefficients", out, fixed = TRUE)))
 })
 
 test_that("summary.smith_hazel returns invisible(object)", {
@@ -585,9 +585,9 @@ test_that("print.base_index produces expected output with named traits", {
   res <- base_index(d$pmat, d$gmat, d$w)
 
   out <- capture.output(print(res))
-  expect_true(any(grepl("BASE INDEX", out)))
-  expect_true(any(grepl("Genetic Advance", out)))
-  expect_true(any(grepl("COMPARISON WITH OPTIMAL LPSI", out)))
+  expect_true(any(grepl("BASE INDEX", out, fixed = TRUE)))
+  expect_true(any(grepl("Genetic Advance", out, fixed = TRUE)))
+  expect_true(any(grepl("COMPARISON WITH OPTIMAL LPSI", out, fixed = TRUE)))
 })
 
 test_that("print.base_index uses Trait_N when trait names are missing", {
@@ -597,18 +597,18 @@ test_that("print.base_index uses Trait_N when trait names are missing", {
   res <- base_index(P, G, w, compare_to_lpsi = FALSE)
 
   out <- capture.output(print(res))
-  expect_true(any(grepl("Trait_1", out)))
+  expect_true(any(grepl("Trait_1", out, fixed = TRUE)))
 })
 
 test_that("print.base_index skips LPSI section when compare_to_lpsi = FALSE", {
   d <- setup_phen_data_small()
   res <- base_index(d$P, d$G, d$w, compare_to_lpsi = FALSE)
 
   out <- capture.output(print(res))
-  expect_false(any(grepl("COMPARISON WITH OPTIMAL LPSI", out)))
+  expect_false(any(grepl("COMPARISON WITH OPTIMAL LPSI", out, fixed = TRUE)))
   # PRE itself is still printed (GA is finite when b=w with PD P)
   # but the LPSI comparison block is absent
-  expect_false(any(grepl("Efficiency Ratio", out)))
+  expect_false(any(grepl("Efficiency Ratio", out, fixed = TRUE)))
 })
 
 test_that("print.base_index skips PRE line when PRE is NA via smith_hazel with G_zero", {
@@ -621,7 +621,7 @@ test_that("print.base_index skips PRE line when PRE is NA via smith_hazel with G
   expect_true(is.na(res$PRE))
 
   out <- capture.output(print(res))
-  expect_false(any(grepl("Relative Efficiency", out)))
+  expect_false(any(grepl("Relative Efficiency", out, fixed = TRUE)))
 })
 
 test_that("print.base_index shows efficiency_ratio >= 0.95 message", {
@@ -633,7 +633,7 @@ test_that("print.base_index shows efficiency_ratio >= 0.95 message", {
 
   expect_gte(res$lpsi_comparison$efficiency_ratio, 0.95)
   out <- capture.output(print(res))
-  expect_true(any(grepl(">=95%", out)))
+  expect_true(any(grepl(">=95%", out, fixed = TRUE)))
 })
 
 test_that("print.base_index shows efficiency_ratio < 0.9 message", {
@@ -663,7 +663,7 @@ test_that("print.base_index shows efficiency_ratio < 0.9 message", {
     class = c("base_index", "selection_index", "list")
   )
   out <- capture.output(print(mock_res))
-  expect_true(any(grepl("<90%", out)))
+  expect_true(any(grepl("<90%", out, fixed = TRUE)))
 })
 
 test_that("print.base_index returns invisible(x)", {
@@ -684,18 +684,18 @@ test_that("summary.base_index prints additional details with comparison", {
   res <- base_index(d$pmat, d$gmat, d$w)
 
   out <- capture.output(summary(res))
-  expect_true(any(grepl("ADDITIONAL DETAILS", out)))
-  expect_true(any(grepl("LPSI vs Base Index", out)))
-  expect_true(any(grepl("Response correlation", out)))
+  expect_true(any(grepl("ADDITIONAL DETAILS", out, fixed = TRUE)))
+  expect_true(any(grepl("LPSI vs Base Index", out, fixed = TRUE)))
+  expect_true(any(grepl("Response correlation", out, fixed = TRUE)))
 })
 
 test_that("summary.base_index prints without lpsi_comparison when disabled", {
   d <- setup_phen_data_small()
   res <- base_index(d$P, d$G, d$w, compare_to_lpsi = FALSE)
 
   out <- capture.output(summary(res))
-  expect_true(any(grepl("ADDITIONAL DETAILS", out)))
-  expect_false(any(grepl("LPSI vs Base Index", out)))
+  expect_true(any(grepl("ADDITIONAL DETAILS", out, fixed = TRUE)))
+  expect_false(any(grepl("LPSI vs Base Index", out, fixed = TRUE)))
 })
 
 test_that("summary.base_index shows low-correlation warning when cor < 0.8", {
@@ -725,7 +725,7 @@ test_that("summary.base_index shows low-correlation warning when cor < 0.8", {
     class = c("base_index", "selection_index", "list")
   )
   out <- capture.output(summary(mock_res))
-  expect_true(any(grepl("Low correlation", out)))
+  expect_true(any(grepl("Low correlation", out, fixed = TRUE)))
 })
 
 test_that("summary.base_index returns invisible(object)", {
diff --git a/tests/testthat/test-predict_selection_score.R b/tests/testthat/test-predict_selection_score.R
@@ -20,7 +20,7 @@ test_that("predict_selection_score includes rank columns", {
   scores <- predict_selection_score(cindex, data = seldata[, 3:9], genotypes = seldata[, 2])
 
   # Check that rank columns exist for each index
-  rank_cols <- colnames(scores)[grepl("_Rank$", colnames(scores))]
+  rank_cols <- colnames(scores)[grepl("_Rank$", colnames(scores), perl = TRUE)]
   expect_true(length(rank_cols) > 0)
 })
 
@@ -33,7 +33,7 @@ test_that("predict_selection_score ranks are valid", {
   scores <- predict_selection_score(cindex, data = seldata[, 3:9], genotypes = seldata[, 2])
 
   # Get rank columns
-  rank_cols <- colnames(scores)[grepl("_Rank$", colnames(scores))]
+  rank_cols <- colnames(scores)[grepl("_Rank$", colnames(scores), perl = TRUE)]
 
   for (col in rank_cols) {
     # Ranks should be numeric
@@ -58,7 +58,7 @@ test_that("predict_selection_score higher scores get lower ranks", {
   scores <- predict_selection_score(cindex, data = seldata[, 3:9], genotypes = seldata[, 2])
 
   # Get first score and rank columns
-  score_col <- colnames(scores)[!colnames(scores) %in% c("Genotypes", grep("_Rank$", colnames(scores), value = TRUE))]
+  score_col <- colnames(scores)[!colnames(scores) %in% c("Genotypes", grep("_Rank$", colnames(scores), value = TRUE, perl = TRUE))]
   rank_col <- paste0(score_col[1], "_Rank")
 
   # Check that higher scores have lower (better) ranks
@@ -81,9 +81,9 @@ test_that("predict_selection_score works with multiple indices", {
 
   # Should have multiple index scores and corresponding ranks
   all_cols <- colnames(scores)
-  rank_cols <- all_cols[grepl("_Rank$", all_cols)]
-  score_cols <- all_cols[grepl("^I_", all_cols)]
-  score_cols <- score_cols[!grepl("_Rank$", score_cols)] # Remove rank columns
+  rank_cols <- all_cols[grepl("_Rank$", all_cols, perl = TRUE)]
+  score_cols <- all_cols[grepl("^I_", all_cols, perl = TRUE)]
+  score_cols <- score_cols[!grepl("_Rank$", score_cols, perl = TRUE)] # Remove rank columns
 
   expect_equal(length(rank_cols), length(score_cols))
   expect_true(length(score_cols) > 1) # Multiple indices
@@ -126,7 +126,7 @@ test_that("predict_selection_score additional input validations (lines 21-59)",
 
   # line 25: missing b.* columns
   cindex_no_b <- cindex
-  b_cols <- grep("^b\\.", names(cindex_no_b), value = TRUE)
+  b_cols <- grep("^b\\.", names(cindex_no_b), value = TRUE, perl = TRUE)
   for (col in b_cols) cindex_no_b[[col]] <- NULL
   expect_error(
     predict_selection_score(cindex_no_b, data = seldata[, 3:9], genotypes = seldata[, 2]),
diff --git a/tests/testthat/test-stochastic_simulation.R b/tests/testthat/test-stochastic_simulation.R
@@ -830,8 +830,8 @@ test_that("print.selection_simulation prints restricted traits line (line 835)",
   )
   # Line 834 `if (!is.null(x$parameters$restricted_traits))` fires → line 835
   out <- capture.output(print(r))
-  expect_true(any(grepl("Restricted traits", out)))
-  expect_true(any(grepl("2", out)))
+  expect_true(any(grepl("Restricted traits", out, fixed = TRUE)))
+  expect_true(any(grepl("2", out, fixed = TRUE)))
 })
 
 # --- plot.selection_simulation type="gain": lines 906-915 --------------------

Original file line number	Diff line number	Diff line change
`@@ -20,7 +20,7 @@ predict_selection_score <- function(index_df, data, genotypes) {`
`20`	`20`	`if (!"ID" %in% names(index_df)) {`
`21`	`21`	`stop("index_df must contain an ID column.")`
`22`	`22`	`}`
`23`		`- b_cols <- grep("^b\\.", names(index_df), value = TRUE)`
	`23`	`+ b_cols <- grep("^b\\.", names(index_df), value = TRUE, perl = TRUE)`
`24`	`24`	`if (length(b_cols) == 0) {`
`25`	`25`	`stop("index_df must contain b.* columns with index coefficients.")`
`26`	`26`	`}`
`@@ -62,7 +62,7 @@ predict_selection_score <- function(index_df, data, genotypes) {`
`62`	`62`
`63`	`63`	`trait_means <- mean_mat[, idx, drop = FALSE]`
`64`	`64`	`score_mat[, j] <- rowSums(sweep(trait_means, 2, b_vals, "*"))`
`65`		`- score_names[j] <- paste0("I_", gsub("\\s+", "", gsub(",", "_", id_str)))`
	`65`	`+ score_names[j] <- paste0("I_", gsub("\\s+", "", gsub(",", "_", id_str, fixed = TRUE), perl = TRUE))`
`66`	`66`	`}`
`67`	`67`
`68`	`68`	`score_names <- make.unique(score_names)`
Original file line number	Diff line number	Diff line change
`@@ -567,7 +567,7 @@ test_that("mppg_lgsi warns with custom U1 matrix", {`
`567`	`567`	`d1 = seq_len(d$n1), d2 = seq_len(d$n), U1 = U1_custom`
`568`	`568`	`)`
`569`	`569`	`)`
`570`		`- expect_true(any(grepl("Custom U1", w_cap)))`
	`570`	`+ expect_true(any(grepl("Custom U1", w_cap, fixed = TRUE)))`
`571`	`571`	`})`
`572`	`572`
`573`	`573`	`test_that("mppg_lgsi C* adjustment differs between Identity and custom U1", {`
`@@ -869,7 +869,7 @@ test_that("mppg_lgsi Young's method error handler falls back to manual intensiti`
`869`	`869`	`"Young's method failed"`
`870`	`870`	`),`
`871`	`871`	`warning = function(w) {`
`872`		`- if (grepl("positive definite\|C\\*", conditionMessage(w))) {`
	`872`	`+ if (grepl("positive definite\|C\\*", conditionMessage(w), perl = TRUE)) {`
`873`	`873`	`invokeRestart("muffleWarning")`
`874`	`874`	`}`
`875`	`875`	`}`