@@ -26,6 +26,25 @@ is_timevarying <- function(.data, .cols) {
2626 )
2727}
2828
29+ # ' Assert an argument has known prototype and/or size or is NULL
30+ # '
31+ # ' @inheritParams vctrs::vec_assert
32+ # '
33+ # ' @returns Either throws an error or returns `x`, invisibly.
34+ vec_assert_or_null <- function (
35+ x ,
36+ ptype = NULL ,
37+ size = NULL ,
38+ arg = caller_arg(x ),
39+ call = caller_env()
40+ ) {
41+ if (! is.null(x )) {
42+ vctrs :: vec_assert(x = x , ptype = ptype , size = size , arg = arg , call = call )
43+ } else {
44+ NULL
45+ }
46+ }
47+
2948# ' Root-mean-squared error
3049# '
3150# ' @param obs observations vector
@@ -68,6 +87,63 @@ mpe <- function (obs, pred) {
6887 sum((obs - pred )/ obs )/ length(obs )
6988}
7089
90+ # ' Accuracy
91+ # '
92+ # ' Accuracy provides a measure of clinical suitability, defined by whether model
93+ # ' predicted drug concentrations fall within an absolute OR relative error
94+ # ' margin of the measured concentrations.
95+ # '
96+ # ' @param obs Observations vector.
97+ # ' @param pred Predictions vector.
98+ # ' @param error_abs,error_rel Positive number providing an absolute or relative
99+ # ' error margin. The cutoff is exclusive of the error margin. Defaults to `0`,
100+ # ' meaning no predictions fall within the error margin.
101+ # '
102+ # ' @returns For `is_accurate()`, `is_accurate_abs()`, and `is_accurate_rel()`: A
103+ # ' logical vector indicating whether or not each predicted drug concentration
104+ # ' was considered accurate according to the specified absolute or relative
105+ # ' error margin(s).
106+ # '
107+ # ' For `accuracy()`: A single value between 0 and 1 indicating the proportion
108+ # ' of predicted drug concentrations that fell within the specified absolute
109+ # ' and relative error margins.
110+ # '
111+ # ' @examples
112+ # ' # Does the predicted drug concentration fall within 0.5 mg/L error margin?
113+ # ' is_accurate_abs(6, 5, error_abs = 0.5)
114+ # '
115+ # ' # Does the predicted drug concentration fall within 25% error margin?
116+ # ' is_accurate_rel(6, 5, error_rel = 0.25)
117+ # '
118+ # ' # Does the predicted drug concentration fall within 0.5 mg/L OR 25%?
119+ # ' is_accurate(6, 5, error_abs = 0.5, error_rel = 0.25)
120+ # '
121+ # ' # What proportion of predicted drug concentrations fell within 0.5 mg/L OR 25%?
122+ # ' accuracy(rnorm(10, 6), rnorm(10, 5), error_abs = 0.5, error_rel = 0.25)
123+ # '
124+ # ' @export
125+ accuracy <- function (obs , pred , error_abs = 0 , error_rel = 0 ) {
126+ mean(is_accurate(obs , pred , error_abs , error_rel ))
127+ }
128+
129+ # ' @rdname accuracy
130+ # ' @export
131+ is_accurate <- function (obs , pred , error_abs = 0 , error_rel = 0 ) {
132+ is_accurate_abs(obs , pred , error_abs ) | is_accurate_rel(obs , pred , error_rel )
133+ }
134+
135+ # ' @rdname accuracy
136+ # ' @export
137+ is_accurate_abs <- function (obs , pred , error_abs = 0 ) {
138+ abs(pred - obs ) < error_abs
139+ }
140+
141+ # ' @rdname accuracy
142+ # ' @export
143+ is_accurate_rel <- function (obs , pred , error_rel = 0 ) {
144+ (pred / obs > 1 - error_rel ) & (pred / obs < 1 + error_rel )
145+ }
146+
71147# ' Weighted sum-of-squares of residuals
72148# '
73149# ' @inheritParams rmse
@@ -83,3 +159,4 @@ ss <- function(obs, pred, w = NULL) {
83159 if (sum(w ) == 0 ) return (NA )
84160 sum(w * (obs - pred )^ 2 )
85161}
162+
0 commit comments