1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
|
marginaleffects_settings <- new.env()
settings_cache <- function(setti) {
out <- list()
for (s in setti) {
out[[s]] <- settings_get(s)
}
return(out)
}
settings_restore <- function(cache) {
for (n in names(cache)) {
settings_set(n, cache[[n]])
}
}
settings_init <- function(settings = NULL) {
settings_rm()
default_settings <- list(
marginaleffects_safefun_return1 = FALSE
)
checkmate::assert_list(settings, null.ok = TRUE, names = "unique")
if (!is.null(settings)) {
settings <- c(settings, default_settings)
}
for (i in seq_along(settings)) {
settings_set(names(settings)[i], settings[[i]])
}
}
# https://stackoverflow.com/questions/79786610/solved-r-package-loading-error-onattach-failed-in-attachnamespace
settings_read_persistent <- function() {
dn <- tools::R_user_dir(package = "marginaleffects", which = "config")
if (!dir.exists(dn)) dir.create(dn, recursive = TRUE)
fn <- file.path(dn, "config.rds")
if (!file.exists(fn)) {
config <- list()
} else {
config <- tryCatch(readRDS(fn), error = function(err) {
warning("marginaleffects: loading persistence failed, this can happen when ",
sQuote(file.path(dn, "config.rds"), FALSE), " becomes corrupted.\n",
" We suggest you delete this file and/or restore it from another location if able.\n",
" The load failure: ", conditionMessage(err))
list()
})
}
return(invisible(config))
}
settings_get <- function(name) {
# First check in-memory settings
if (name %in% names(marginaleffects_settings)) {
return(get(name, envir = marginaleffects_settings))
}
# Then check persistent storage
persistent_config <- settings_read_persistent()
if (name %in% names(persistent_config)) {
return(persistent_config[[name]])
}
return(NULL)
}
settings_set <- function(name, value, persistent = FALSE) {
if (persistent) {
# Save to persistent storage
config <- settings_read_persistent()
config[[name]] <- value
dn <- tools::R_user_dir(package = "marginaleffects", which = "config")
fn <- file.path(dn, "config.rds")
saveRDS(config, fn)
} else {
# Save to in-memory storage
assign(name, value = value, envir = marginaleffects_settings)
}
}
settings_rm <- function(name = NULL) {
if (is.null(name)) {
rm(list = names(marginaleffects_settings), envir = marginaleffects_settings)
} else if (name %in% names(marginaleffects_settings)) {
rm(list = name, envir = marginaleffects_settings)
}
}
settings_delete <- function() {
dn <- tools::R_user_dir(package = "marginaleffects", which = "config")
fn <- file.path(dn, "config.rds")
if (file.exists(fn)) hush(unlink(fn))
message("`marginaleffects` returned to default settings.", call. = FALSE)
}
settings_equal <- function(name, comparison) {
k <- settings_get(name)
if (!is.null(k) && length(comparison) == 1 && k == comparison) {
out <- TRUE
} else if (!is.null(k) && length(comparison) > 1 && k %in% comparison) {
out <- TRUE
} else {
out <- FALSE
}
return(out)
}
|
