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
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
|
#' Convert Between Odds and Probabilities
#'
#' @param odds The *Odds* (or `log(odds)` when `log = TRUE`) to convert.
#' @param probs Probability values to convert.
#' @param log Take in or output log odds (such as in logistic models).
#' @param select When a data frame is passed, character or list of of column
#' names to be transformed.
#' @param exclude When a data frame is passed, character or list of column names
#' to be excluded from transformation.
#' @param ... Arguments passed to or from other methods.
#'
#' @return Converted index.
#'
#' @seealso [stats::plogis()]
#' @family convert between effect sizes
#'
#' @examples
#' odds_to_probs(3)
#' odds_to_probs(1.09, log = TRUE)
#'
#' probs_to_odds(0.95)
#' probs_to_odds(0.95, log = TRUE)
#' @export
#' @aliases convert_odds_to_probs
odds_to_probs <- function(odds, log = FALSE, ...) {
UseMethod("odds_to_probs")
}
#' @export
convert_odds_to_probs <- odds_to_probs
#' @export
#' @importFrom stats plogis
odds_to_probs.numeric <- function(odds, log = FALSE, ...) {
if (log) {
stats::plogis(odds)
} else {
stats::plogis(log(odds))
}
}
#' @rdname odds_to_probs
#' @export
odds_to_probs.data.frame <- function(odds, log = FALSE, select = NULL, exclude = NULL, ...) {
.odds_to_probs_df(odds = odds, log = log, select = select, exclude = exclude, ...)
}
#' @rdname odds_to_probs
#' @aliases convert_probs_to_odds
#' @export
probs_to_odds <- function(probs, log = FALSE, ...) {
UseMethod("probs_to_odds")
}
#' @export
convert_probs_to_odds <- probs_to_odds
#' @export
#' @importFrom stats qlogis
probs_to_odds.numeric <- function(probs, log = FALSE, ...) {
if (log) {
stats::qlogis(probs)
} else {
exp(stats::qlogis(probs))
}
}
#' @rdname odds_to_probs
#' @export
probs_to_odds.data.frame <- function(probs, log = FALSE, select = NULL, exclude = NULL, ...) {
.odds_to_probs_df(probs = probs, log = log, select = select, exclude = exclude, ...)
}
# Data frame --------------------------------------------------------------
#' @keywords internal
.odds_to_probs_df <- function(odds = NULL, probs = NULL, log = FALSE, select = NULL, exclude = NULL, ...) {
# If vector
if (!is.null(odds)) {
df <- odds
} else {
df <- probs
}
# check for formula notation, convert to character vector
if (inherits(select, "formula")) {
select <- all.vars(select)
}
if (inherits(exclude, "formula")) {
exclude <- all.vars(exclude)
}
# Variable order
var_order <- names(df)
# Keep subset
if (!is.null(select) && select %in% names(df)) {
select <- as.vector(select)
to_keep <- as.data.frame(df[!names(df) %in% select])
df <- df[names(df) %in% select]
} else {
to_keep <- NULL
}
# Remove exceptions
if (!is.null(exclude) && exclude %in% names(df)) {
exclude <- as.vector(exclude)
if (is.null(to_keep)) {
to_keep <- as.data.frame(df[exclude])
} else {
to_keep <- cbind(to_keep, as.data.frame(df[exclude]))
}
df <- df[!names(df) %in% exclude]
}
# Remove non-numerics
is_num <- vapply(df, is.numeric, logical(1))
dfother <- df[!is_num]
dfnum <- df[is_num]
# Tranform
if (!is.null(odds)) {
dfnum <- data.frame(lapply(dfnum, odds_to_probs.numeric, log = log))
} else {
dfnum <- data.frame(lapply(dfnum, probs_to_odds.numeric, log = log))
}
# Add non-numerics
if (is.null(ncol(dfother))) {
df <- dfnum
} else {
df <- cbind(dfother, dfnum)
}
# Add exceptions
if (!is.null(select) || !is.null(exclude) && exists("to_keep")) {
df <- cbind(df, to_keep)
}
# Reorder
df <- df[var_order]
return(df)
}
|
