Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Adds finalize methods to R6 class (ghost issue) #606

Merged
merged 10 commits into from
Aug 2, 2024

Conversation

averissimo
Copy link
Contributor

@averissimo averissimo commented Aug 2, 2024

WIP. Still testing with more filter option

Companion of insightsengineering/teal#1275

Changes description

  • Removes all observeEvents generated from FilterData when finalize method is called.

How to test

  • Override observeEvent in {teal.slice} in order to keep track of all that are created
    • Stores observers in .tmp_list on .GlobalEnv
  • Place browser() call somewhere with access to FilterData object
  • Run snippet at bottom that shows count of observers that have not been destroyed
    • These are shown in order of creation <order>_<parent r6 class>_<memory address>
  • Run finalize()
  • Run snippet again
Example teal app
.tmp_list <- rlang::new_environment()

options(
  teal.log_level = "INFO",
  teal.show_js_log = TRUE,
  # teal.bs_theme = bslib::bs_theme(version = 5),
  shiny.bookmarkStore = "server"
)

pkgload::load_all("../teal.slice")
pkgload::load_all("../teal")

data <- teal::teal_data_module(
  ui = function(id) {
    ns <- shiny::NS(id)
    shiny::tagList(
      shiny::checkboxGroupInput(
        ns("datasets"),
        "Datasets",
        choices = c("ADSL", "ADTTE", "iris", "CO2", "miniACC"),
        selected = c("ADSL", "ADTTE", "iris", "CO2")
      ),
      shiny::actionButton(ns("submit"), label = "Submit")
    )
  },
  server = function(id, ...) {
    shiny::moduleServer(id, function(input, output, session) {
      code <- list(
        ADSL = expression(
          ADSL <- teal.data::rADSL
        ),
        ADTTE = expression({
          ADTTE <- teal.data::rADTTE
          ADTTE$CNSRL <- as.logical(ADTTE$CNSR)
        }),
        iris = expression(
          iris <- iris
        ),
        CO2 = expression({
          CO2 <- CO2
          factors <- names(Filter(isTRUE, vapply(CO2, is.factor, logical(1L))))
          CO2[factors] <- lapply(CO2[factors], as.character)
        }),
        miniACC = expression({
          data(
            "miniACC",
            package = "MultiAssayExperiment",
            envir = environment(),
            overwrite = TRUE
          )
          miniACC <- miniACC
        })
      )

      datasets <- reactive(input$datasets)

      shiny::eventReactive(input$submit, {
        code_to_eval <- do.call(c, code[datasets()])
        data <- teal.code::eval_code(teal.data::teal_data(), code_to_eval)

        join_keys(data) <- default_cdisc_join_keys[datasets()]
        teal.data::datanames(data) <- datasets()
        data
      })
    })
  },
  once = FALSE
)

teal::init(
  data = data,
  modules = teal::modules(
    teal::example_module(label = "A"),
    teal::example_module(label = "B")
  ),
  filter = teal::teal_slices(
    # FilterRange
    teal.slice::teal_slice("ADSL", "AGE", selected = c(18L, 65L)),
    # FilterExpr
    teal_slice(
      dataname = "ADSL",
      id = "Female adults",
      expr = "SEX == 'F' & AGE >= 18",
      title = "Female adults"
    ),
    # FilterDatetime
    teal_slice(
      dataname = "ADTTE",
      varname = "ADTM",
      id = "Analysis DTM",
      selected = c("2019-03-25 07:06:18", "2020-01-22 15:03:58"),
      title = "Female adults"
    ),
    # FilterDate with LSTALVDT
    teal_slice(
      dataname = "ADSL",
      varname = "LSTALVDT",
      id = "Last Alive Date",
      selected = c("2022-02-14", "2022-11-24"),
      title = "Last Alive Date"
    ),
    # FilterEmpty
    # FilterLogical with CNSRL
    teal_slice(
      dataname = "ADTTE",
      varname = "CNSRL",
      id = "Censored",
      selected = TRUE,
      title = "Censored"
    ),
    module_specific = TRUE,
    teal.slice::teal_slice("ADSL", "SEX")
  ),
  title = "yada"
) |>
  shiny::runApp()
"observeEvent" override
observeEvent = function(eventExpr,
                        handlerExpr,
                        ...
  ) {
  logger::log_info("yada")

  rlang::enquo(eventExpr)
  rlang::enquo(handlerExpr)

  obs <- do.call(
    shiny::observeEvent,
    list(
      eventExpr = rlang::enquo(eventExpr),
      handlerExpr = rlang::enquo(handlerExpr),
      ...
    ),
    envir = parent.frame()
  )

  # Create a temporary list to store observers and parent objects
  if (is.null(.GlobalEnv$.tmp_list)) .GlobalEnv$.tmp_list <- rlang::new_environment()

  self <- parent.env(parent.env(parent.frame()))$self
  obj_addr <- rlang::obj_address(self) |>
    as.character() |>
    stringr::str_replace("0x", "")

  obj_addr <- paste0(class(self)[1], "_", obj_addr)

  .tmp_list[["objects"]] <- c(
    list(),
    .tmp_list[["objects"]],
    setNames(list(self), obj_addr)
  )

  .tmp_list[[sprintf("%03d_%s", length(.tmp_list[["objects"]]), obj_addr)]] <- c(
    list(),
    .tmp_list[[obj_addr]],
    list(obs)
  )

  obs
}
Snippet to analyse ".tmp_list"
ls(.tmp_list) |>
  purrr::keep(~!grepl("^objects$", .x)) |>
  vapply(
    \(x) {
      sum(
        vapply(
          .tmp_list[[x]],
          \(.x) isFALSE(.x$.destroyed),
          integer(1L)
        )
      )
    },
    integer(1L)
  ) |>
  as.list() |>
  jsonlite::toJSON(pretty = TRUE, auto_unbox = TRUE)

text444

…ce@669_insertUI@main

* origin/669_insertUI@main:
  [skip actions] Bump version to 0.5.1.9006
  Removes 'plotly_relayout' warning from console (#601)
…ce@669_insertUI@main

* origin/669_insertUI@main:
  fix: duplicated slices are lingering the filter panel after DDL reload (#602)
  [skip roxygen] [skip vbump] Roxygen Man Pages Auto Update
@gogonzo gogonzo self-assigned this Aug 2, 2024
@gogonzo gogonzo added the core label Aug 2, 2024
Copy link
Contributor

@gogonzo gogonzo left a comment

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Replace FilterState$destroy_observers with finalize

@averissimo averissimo marked this pull request as ready for review August 2, 2024 10:03
@averissimo averissimo requested a review from gogonzo August 2, 2024 10:12
Copy link
Contributor

@gogonzo gogonzo left a comment

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Works fine. Some things to consider in a future:

  • public$finalize vs existing private$finalize. Is it possible to trigger private$finalize without gc(), is it safe to destroy it that hard.
  • Is it relevant to include destroy_shiny <- function() to other classes than FilterState. Theoretically, FilteredDataset/FilterStates create some new inputs which are not destroyed (only their observers)

@averissimo
Copy link
Contributor Author

Works fine. Some things to consider in a future:

* public$finalize vs existing private$finalize. Is it possible to trigger `private$finalize` without `gc()`, is it safe to destroy it that hard.

I believe it's safe, the object should not be used once we call finalize. I'll see if there's a way to destroy it more explicitly without waiting for gc().

Maybe via the memory address 😈 (my new favorite rlang function rlang::obj_address)

ft <- R6::R6Class(
  "FinalizeTest",
  public = list(
    initialize = function() {
      message(">>> Initializing")
    },
    am_self = function() {
      rlang::obj_address(self)
    }
  ),
  private = list(
    finalize = function() {
      message(">>> Finalizing")
    }
  )
)

aa <- ft$new()
#> Initializing

message(
  "obj address `{rlang::obj_address(aa)}`",
  "is the same as the self address inside the R6 `{aa$am_self()}`",
  .sep = " "
)
#> obj address `{rlang::obj_address(aa)}`is the same as the self address inside the R6 `{aa$am_self()}`
aa <- NULL
Sys.sleep(1)
gc(full = TRUE)
#> >>> Finalizing
#>           used (Mb) gc trigger (Mb) max used (Mb)
#> Ncells  655298   35    1468394 78.5   727062 38.9
#> Vcells 1172184    9    8388608 64.0  1972780 15.1

Created on 2024-08-02 with reprex v2.1.1

* Is it relevant to include `destroy_shiny <- function()` to other classes than FilterState. Theoretically, FilteredDataset/FilterStates create some new inputs which are not destroyed (only their observers)

Good point, something to see in the (near?) future

@averissimo averissimo merged commit 7765327 into 669_insertUI@main Aug 2, 2024
1 check passed
@averissimo averissimo deleted the teal_slice@669_insertUI@main branch August 2, 2024 11:17
@github-actions github-actions bot locked and limited conversation to collaborators Aug 2, 2024
Sign up for free to subscribe to this conversation on GitHub. Already have an account? Sign in.
Labels
Projects
None yet
Development

Successfully merging this pull request may close these issues.

2 participants