262 Fix improper code dependency (#264)

Fixes #262 and
insightsengineering/teal.gallery#218

Alternative solution:
#263

Functions were kept on the left side of the dependency graph, which lead
to cyclic unwanted dependencies.
Now all functions, even when used on the LHS are moved to the RHS of the
dependency graph.

```r
devtools::load_all(".")
devtools::load_all("../teal.data")
data <- teal_data()
data <- within(data, {
  library(random.cdisc.data)
  library(nestcolor)
  
  ADSL <- radsl(seed = 1)
  ADMH <- radmh(ADSL, seed = 1)
  ADVS <- radvs(ADSL, seed = 1)
  teal.data::col_labels(ADMH[c("MHDISTAT")]) <- c("Status of Disease")
  
  ADVS <- dplyr::inner_join(x = ADVS, y = ADSL[, c("STUDYID", "USUBJID"), drop = FALSE], by = c("STUDYID", "USUBJID"))
  
})
data@code
cat(get_code(data, names = "ADVS"))
```

```r
library(random.cdisc.data)
library(nestcolor)
ADSL <- radsl(seed = 1)
ADVS <- radvs(ADSL, seed = 1)
ADVS <- dplyr::inner_join(x = ADVS, y = ADSL[, c("STUDYID", "USUBJID"), drop = FALSE], by = c("STUDYID", "USUBJID"))
```

---------

Signed-off-by: Marcin <[email protected]>
Co-authored-by: github-actions <41898282+github-actions[bot]@users.noreply.github.com>
Co-authored-by: Dawid Kałędkowski <[email protected]>

Author: 3 people

R/utils-get_code_dependency.R

@@ -303,6 +303,7 @@ extract_occurrence <- function(pd) {
 
   after <- match(min(x$id[assign_cond]), sort(x$id[c(min(assign_cond), sym_cond)])) - 1
   ans <- append(x[sym_cond, "text"], "<-", after = max(1, after))
+  ans <- move_functions_after_arrow(ans, unique(x[sym_fc_cond, "text"]))
   roll <- in_parenthesis(pd)
   if (length(roll)) {
     c(setdiff(ans, roll), roll)
@@ -311,6 +312,29 @@ extract_occurrence <- function(pd) {
   }
 }
 
+#' Moves function names to the right side of dependency graph
+#'
+#' Changes status of the function call from dependent to dependency if occurs in the lhs.
+#' Technically, it means to move function names after the dependency operator.
+#' For example, for `attributes(a) <- b` the dependency graph should look like `c("a", "<-", "b", "attributes")`.
+#'
+#' @param ans `character` vector of object names in dependency graph.
+#' @param functions `character` vector of function names.
+#'
+#' @return
+#' A character vector.
+#' @keywords internal
+#' @noRd
+move_functions_after_arrow <- function(ans, functions) {
+  arrow_pos <- which(ans == "<-")
+  if (length(arrow_pos) == 0) {
+    return(ans)
+  }
+  before_arrow <- setdiff(ans[1:arrow_pos], functions)
+  after_arrow <- ans[(arrow_pos + 1):length(ans)]
+  c(before_arrow, unique(c(intersect(ans[1:arrow_pos], functions), after_arrow)))
+}
+
 #' Extract side effects
 #'
 #' Extracts all object names from the code that are marked with `@linksto` tag.

tests/testthat/test-qenv_get_code.R

@@ -290,6 +290,20 @@ testthat::describe("get_code for specific names", {
       )
     }
   )
+  testthat::it(
+    "doesn't consider function called on the lhs as a dependent in this call (dependency in further calls)",
+    {
+      code <- c(
+        "object_list <- list(x = iris, y = iris)",
+        "object_list_2 <- list(x = mtcars, y = mtcars)",
+        "object_list_2[c('x')] <- c('string')",
+        "object_list[c('x')] <- c('string')"
+      )
+      q <- eval_code(qenv(), code = code)
+      result <- get_code(q, names = "object_list")
+      testthat::expect_identical(result, paste(code[c(1, 4)], collapse = "\n"))
+    }
+  )
 })