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:

debug_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 …

debug_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) …

debug_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 debugging off again.

undebug_random_seed()
sample(10)

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

debug_rng.r

debug_random_seed = local({
    function (what = c('both', 'getter', 'setter'), ignore = NULL) {
        seed_scope = parent.env(environment())

        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 debugged')
                return(invisible())
            }
        } else {
            set.seed(NULL)
        }

        # Save existing seed before deleting
        assign('random_seed', .Random.seed, seed_scope)
        rm(.Random.seed, envir = globalenv())

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

            if (sys.nframe() > 1 &&
                ! any(vapply(ignore, identical, logical(1), sys.function(1))) &&
                what %in% c('both', mode)
            ) {
                msg = if (mode == 'getter')
                    'Getting .Random.seed'
                else
                    'Setting .Random.seed'

                message(msg, '; called from ', strtrim(deparse(sys.call(1)), 50))
            }

            if (mode == 'setter') {
                assign('random_seed', new_value, seed_scope)
            }

            random_seed
        }

        makeActiveBinding('.Random.seed', debug_seed, globalenv())
    }
})

undebug_random_seed = function () {
    if (! (exists('.Random.seed', globalenv()) &&
           bindingIsActive('.Random.seed', globalenv()))) {
        warning('.Random.seed is not being debugged')
        return(invisible())
    }

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