Debug which functions access .Random.seed

README.md

Who is touching the .Random.seed?

Inspired by a Stack Overflow question, here’s a way of tracking what’s been modifying the .Random.seed.

Since R makes static analysis impossible in general, the following is a runtime tracer that injects itself into the .Random.seed variable via an active binding:

NOTE: This will only work properly if called directly by the user at the top level. In particular, it won’t work inside an RMarkdown report or similar, where the top-level call is rmarkdown::render(), or knitr::knit(), or similar; rather than, say, sample().

trace_random_seed()
sample(10)

Getting .Random.seed; called from sample(10)
Setting .Random.seed; called from sample(10)

 [1]  2  5  9  8  7  4  1  6 10  3

The user can control whether all or only specific calls are logged …

untrace_random_seed()
trace_random_seed(ignore = sample.int)
sample(10)

Getting .Random.seed; called from sample(10)
Setting .Random.seed; called from sample(10)

 [1]  8  1  9  5  2  3  7  4 10  6

sample.int(10)

 [1]  3  4  7  5  1  2  9  8 10  6

… whether only to log getter or setter (default is both) …

untrace_random_seed()
trace_random_seed(what = 'setter')
sample(10)

Setting .Random.seed; called from sample(10)

[1]  2  9  8  5  3  7  4  6 10  1

… and, finally, the user can switch tracing off again.

untrace_random_seed()
sample(10)

 [1]  4  6 10  8  9  3  1  7  5  2

trace_rng.r

#' Trace where the `.Random.seed is being used
#'
#' `trace_random_seed()` activates tracking of the `.Random.seed` variable. `untrace_random_seed()` deactivates it.
#' @param what which action to trace; one of `'both'`, `'getter'`, `'setter'` (default: `'both'`)
#' @param ignore a function or a list of functions to ignore when tracing
#' @export
trace_random_seed = local({
  self = environment()

  function (what = c('both', 'getter', 'setter'), ignore = NULL) {
    what = match.arg(what)
    if (is.function(ignore)) ignore = list(ignore)

    if (exists('.Random.seed', .GlobalEnv)) {
      if (bindingIsActive('.Random.seed', .GlobalEnv)) {
        warning('.Random.seed is already being traced')
        return(invisible())
      }
    } else {
      set.seed(NULL)
    }

    # Save existing seed before deleting
    self$random_seed = .GlobalEnv$.Random.seed
    rm(.Random.seed, envir = .GlobalEnv)

    trace_seed = function (new_value) {
      mode = if (missing(new_value)) 'getter' else 'setter'

      if (
        sys.nframe() > 1L
        && ! any(vapply(ignore, identical, logical(1L), sys.function(1L)))
        && what %in% c('both', mode)
      ) {
        action = if (mode == 'getter') 'Getting' else 'Setting'
        message(action, ' .Random.seed; called from ', strtrim(deparse(sys.call(1L)), 50L))
      }

      if (mode == 'setter') {
        self$random_seed = new_value
      }

      random_seed
    }

    makeActiveBinding('.Random.seed', trace_seed, .GlobalEnv)
  }
})

#' @rdname trace_random_seed
#' @export
untrace_random_seed = function () {
  if (! (exists('.Random.seed', .GlobalEnv) && bindingIsActive('.Random.seed', .GlobalEnv))) {
    warning('.Random.seed is not being traced')
    return(invisible())
  }

  seed = suppressMessages(.GlobalEnv$.Random.seed)
  rm('.Random.seed', envir = .GlobalEnv)
  assign('.Random.seed', seed, .GlobalEnv)
}