Can use .g2, g3, etc. when selecting by operators

Tests passed.
sfcheung · Jun 28, 2023 · 30317ea · 30317ea
1 parent fe0356d
commit 30317ea
Show file tree

Hide file tree

Showing 2 changed files with 59 additions and 1 deletion.
diff --git a/R/pars_id.R b/R/pars_id.R
@@ -334,6 +334,8 @@ pars_id_op <- function(pars,
     pars_c <- keep_ops(pars_c, pt_ops)
     out0 <- integer(0)
     if (ngp > 1) {
+        lavlabel_gp <- get_g1(ptable$lavlabel)
+        ptable$lavlabel <- add_g1(ptable$lavlabel)
         for (x in seq_along(pars_c)) {
             tmp <- sapply(glabels, function(y) {
                       grepl(paste0("\\.", y), pars_c[x])
@@ -345,8 +347,25 @@ pars_id_op <- function(pars,
                                   gsub(pattern = paste0("\\.", glabels[gp_tmp]),
                                        replacement = "",
                                        x = pars_c[x])), ]
-                out0 <- c(out0, pt_tmp$rowid)
+              } else {
+                pt_tmp <- NULL
+              }
+            glavlabels <- paste0("g", seq_len(ngp))
+            tmp <- sapply(glavlabels, function(y) {
+                      grepl(paste0("\\.", y), pars_c[x])
+                    })
+            if (any(tmp)) {
+                gp_tmp <- which(tmp)
+                pt_tmp2 <- ptable[(ptable$group == gp_tmp) &
+                                 (ptable$op ==
+                                  gsub(pattern = paste0("\\.", glavlabels[gp_tmp]),
+                                       replacement = "",
+                                       x = pars_c[x])), ]
+              } else {
+                pt_tmp2 <- NULL
               }
+            out0 <- c(out0, pt_tmp$rowid,
+                            pt_tmp2$rowid)
           }
       }
     # For both operators without suffixes

diff --git a/tests/testthat/test-est_change_loo_multi_select_by_op.R b/tests/testthat/test-est_change_loo_multi_select_by_op.R
@@ -45,9 +45,18 @@ est_change_rerun_test6 <- est_change(rerun_out,
                                 c("f3 ~ f2", "=~", "~~"))
 est_change_rerun_test7 <- est_change(rerun_out,
                                 c("~1"))
+# Address issue 87
+est_change_rerun_test_87_1 <- est_change(rerun_out,
+                                c("=~.g2", "~~"))
+est_change_rerun_test_87_2 <- est_change(rerun_out,
+                                c("~~.g2"))
+est_change_rerun_test_87_3 <- est_change(rerun_out,
+                                c("=~.g1", "~1", "f3 ~ f2.g2"))
+
 
 parameters_names <- paste0(est0$lhs, est0$op, est0$rhs)
 parameters_names[est0$group == 2] <- paste0(parameters_names[est0$group == 2], ".g2")
+parameters_names_no_user_labels <- parameters_names
 # Use label if available
 tmp <- (est0$label != "") & !grepl(".p", est0$label)
 parameters_names[tmp] <- est0$label[tmp]
@@ -58,6 +67,24 @@ parameters_names_loads <- parameters_names[(est0$op == "=~") & !is.na(est0$z)]
 parameters_names_def <- parameters_names[(est0$op == ":=") & !is.na(est0$z)]
 parameters_names_int <- parameters_names[(est0$op == "~1") & !is.na(est0$z)]
 
+parameters_names_87_1 <- c(parameters_names[(est0$op == "=~") &
+                                            !is.na(est0$z) &
+                                            est0$group == 2],
+                           parameters_names[(est0$op == "~~") &
+                                             !is.na(est0$z)])
+parameters_names_87_2 <- c(parameters_names[(est0$op == "~~") &
+                                            !is.na(est0$z) &
+                                            est0$group == 2])
+parameters_names_87_3 <- c(parameters_names[(est0$op == "=~") &
+                                            !is.na(est0$z) &
+                                            est0$group == 1],
+                           parameters_names[(est0$op == "~1") &
+                                            !is.na(est0$z)],
+                           parameters_names[(est0$op == "~") &
+                                            (est0$lhs == "f3") &
+                                            (est0$rhs == "f2") &
+                                            est0$group == 2])
+
 test_that("Parameter selected by operators", {
     expect_equal(ignore_attr = TRUE,
         sort(colnames(est_change_rerun_test1)),
@@ -92,4 +119,16 @@ test_that("Parameter selected by operators", {
         sort(colnames(est_change_rerun_test7)),
         sort(c("gcd", parameters_names_int))
       )
+    expect_equal(ignore_attr = TRUE,
+        sort(colnames(est_change_rerun_test_87_1)),
+        sort(c("gcd", parameters_names_87_1))
+      )
+    expect_equal(ignore_attr = TRUE,
+        sort(colnames(est_change_rerun_test_87_2)),
+        sort(c("gcd", parameters_names_87_2))
+      )
+    expect_equal(ignore_attr = TRUE,
+        sort(colnames(est_change_rerun_test_87_3)),
+        sort(c("gcd", parameters_names_87_3))
+      )
   })