Skip to content

Commit 67ecee9

Browse files
atsyplenkovatsyplenkov
authored
Merge pull request #20 from atsyplenkov/measures
feat: add `measure` class
2 parents 6eef2b7 + 6fa04c5 commit 67ecee9

25 files changed

Lines changed: 304 additions & 217 deletions

‎.Rbuildignore‎

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -18,3 +18,4 @@
1818
^codemeta\.json$
1919
^CODE_OF_CONDUCT\.md$
2020
^src/.*\.o$
21+
^dev\.R$

‎DESCRIPTION‎

Lines changed: 15 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -11,7 +11,8 @@ Depends: R (>= 4.1.0)
1111
Imports:
1212
Rcpp (>= 1.0.12),
1313
rlang (>= 1.1.0),
14-
yardstick (>= 1.3.1)
14+
yardstick (>= 1.3.1),
15+
checkmate (>= 2.3.1)
1516
LinkingTo: Rcpp
1617
Roxygen: list(markdown = TRUE)
1718
RoxygenNote: 7.3.2
@@ -26,3 +27,16 @@ URL: https://github.com/atsyplenkov/tidyhydro, https://atsyplenkov.github.io/tid
2627
BugReports: https://github.com/atsyplenkov/tidyhydro/issues
2728
LazyData: true
2829
Config/Needs/website: bench, ggplot2, quarto, lubridate, dplyr
30+
Collate:
31+
'RcppExports.R'
32+
'aaa-new.R'
33+
'central-tendency.R'
34+
'data.R'
35+
'kge.R'
36+
'mse.R'
37+
'nse.R'
38+
'pbias.R'
39+
'press.R'
40+
'sfe.R'
41+
'tidyhydro-package.R'
42+
'variability.R'

‎NAMESPACE‎

Lines changed: 20 additions & 9 deletions
Original file line numberDiff line numberDiff line change
@@ -2,15 +2,10 @@ useDynLib(tidyhydro, .registration = TRUE)
22
importFrom(Rcpp, evalCpp)
33
# exportPattern("^[[:alpha:]]+")
44

5-
S3method(nse, data.frame)
6-
S3method(kge, data.frame)
7-
S3method(kge2012, data.frame)
8-
S3method(mse, data.frame)
9-
S3method(rmse, data.frame)
10-
S3method(pbias, data.frame)
11-
S3method(press, data.frame)
12-
S3method(cv, data.frame)
13-
S3method(sfe, data.frame)
5+
S3method(print, measure)
6+
S3method(format, measure)
7+
8+
# general functions
149
export(nse)
1510
export(kge)
1611
export(kge2012)
@@ -20,6 +15,21 @@ export(pbias)
2015
export(press)
2116
export(sfe)
2217
export(cv)
18+
export(gm)
19+
20+
# data.frame methods
21+
S3method(nse, data.frame)
22+
S3method(kge, data.frame)
23+
S3method(kge2012, data.frame)
24+
S3method(mse, data.frame)
25+
S3method(rmse, data.frame)
26+
S3method(pbias, data.frame)
27+
S3method(press, data.frame)
28+
S3method(sfe, data.frame)
29+
S3method(cv, data.frame)
30+
S3method(gm, data.frame)
31+
32+
# vector functions
2333
export(nse_vec)
2434
export(kge_vec)
2535
export(kge2012_vec)
@@ -29,3 +39,4 @@ export(pbias_vec)
2939
export(press_vec)
3040
export(sfe_vec)
3141
export(cv_vec)
42+
export(gm_vec)

‎R/aaa-new.R‎

Lines changed: 73 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,73 @@
1+
# Modified after https://github.com/tidymodels/yardstick/blob/main/R/aaa-new.R
2+
3+
#' Construct a new measure function
4+
#' @keywords summary_stats
5+
#'
6+
#' @description
7+
#' These functions provide convenient wrappers to create the three types of
8+
#' measure functions in `tidyhydro`: measures of central tendency, variability
9+
#' and symmetry. They add a measure-specific class to `fn` and
10+
#' mimic a behaviour of [metric_set][yardstick::metric_set]. These features
11+
#' are used by measure_set.
12+
#'
13+
#' See [Custom performance
14+
#' metrics](https://www.tidymodels.org/learn/develop/metrics/) for more
15+
#' information about creating custom metrics.
16+
#'
17+
#' @param fn A function. The measure function to attach a measure-specific class
18+
#'
19+
#' @name new-measure
20+
NULL
21+
22+
#' @rdname new-measure
23+
#' @export
24+
new_tendency_measure <- function(fn) {
25+
new_measure(fn, class = "tendency_measure")
26+
}
27+
28+
#' @rdname new-measure
29+
#' @export
30+
new_var_measure <- function(fn) {
31+
new_measure(fn, class = "var_measure")
32+
}
33+
34+
#' @rdname new-measure
35+
#' @export
36+
new_sym_measure <- function(fn) {
37+
new_measure(fn, class = "sym_measure")
38+
}
39+
40+
new_measure <- function(fn, class = NULL) {
41+
checkmate::assert_function(fn, args = "data")
42+
43+
class <- c(class, "measure", "function")
44+
45+
structure(fn, class = class)
46+
}
47+
48+
is_measure <- function(x) {
49+
inherits(x, "measure")
50+
}
51+
52+
#' @noRd
53+
#' @export
54+
print.measure <- function(x, ...) {
55+
cat(format(x), sep = "\n")
56+
invisible(x)
57+
}
58+
59+
#' @noRd
60+
#' @export
61+
format.measure <- function(x, ...) {
62+
first_class <- class(x)[[1]]
63+
measure_type <-
64+
switch(
65+
first_class,
66+
"tendency_measure" = "Measure of Central Tendency",
67+
"var_measure" = "Measure of Variability",
68+
"sym_measure" = "Measure of Distribution Symmetry",
69+
"measure"
70+
)
71+
72+
cat(paste("A", measure_type))
73+
}

‎R/central-tendency.R‎

Lines changed: 66 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,66 @@
1+
#' Geometric Mean (GM)
2+
#' @keywords summary_stats
3+
#'
4+
#' @family descriptive statistics
5+
#' @templateVar fn gm
6+
#' @template return
7+
#'
8+
#' @param data A `data.frame` containing the columns specified by the `truth`
9+
#' and `estimate` arguments.
10+
#'
11+
#' @param truth The column identifier for the true results
12+
#' (that is `numeric`). This should be an unquoted column name although
13+
#' this argument is passed by expression and supports
14+
#' [quasiquotation][rlang::quasiquotation] (you can unquote column
15+
#' names). For `_vec()` functions, a `numeric` vector.
16+
#'
17+
#' @param na_rm A `logical` value indicating whether `NA`
18+
#' values should be stripped before the computation proceeds.
19+
#'
20+
#' @param ... Not currently used.
21+
#'
22+
#' @template examples-description
23+
#'
24+
#' @export
25+
#'
26+
27+
# TODO:
28+
# Add tests
29+
30+
gm <- function(data, ...) {
31+
UseMethod("gm")
32+
}
33+
34+
gm <- new_tendency_measure(gm)
35+
36+
#' @rdname gm
37+
#' @export
38+
gm.data.frame <- function(
39+
data,
40+
truth,
41+
na_rm = TRUE,
42+
...
43+
) {
44+
yardstick::numeric_metric_summarizer(
45+
name = "gm",
46+
fn = gm_vec,
47+
data = data,
48+
truth = !!rlang::enquo(truth),
49+
estimate = !!rlang::enquo(truth),
50+
na_rm = na_rm
51+
)
52+
}
53+
54+
#' @rdname gm
55+
#' @export
56+
gm_vec <- function(
57+
truth,
58+
na_rm = TRUE,
59+
...
60+
) {
61+
checkmate::assert_numeric(
62+
truth,
63+
lower = 1e-323
64+
)
65+
exp(mean(log(truth), na.rm = na_rm))
66+
}

‎R/kge.R‎

Lines changed: 2 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -42,8 +42,7 @@
4242
#' For further discussion, see Knoben et al. (2019), who caution against
4343
#' directly translating NSE-based interpretation thresholds to KGE.
4444
#'
45-
#' @family numeric metrics
46-
#' @family accuracy metrics
45+
#' @family KGE variants
4746
#' @templateVar fn kge
4847
#' @template return
4948
#'
@@ -170,8 +169,7 @@ kge_vec <- function(
170169
#' For further discussion, see Knoben et al. (2019), who caution against
171170
#' directly translating NSE-based interpretation thresholds to KGE.
172171
#'
173-
#' @family numeric metrics
174-
#' @family accuracy metrics
172+
#' @family KGE variants
175173
#' @templateVar fn kge2012
176174
#' @template return
177175
#'

‎R/nse.R‎

Lines changed: 1 addition & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -35,8 +35,7 @@
3535
#' - **Satisfactory** -- 0.5 < `nse()` < 0.6
3636
#' - **Poor** -- `nse()` <= 0.5
3737
#'
38-
#' @family numeric metrics
39-
#' @family accuracy metrics
38+
#' @family NSE variants
4039
#' @templateVar fn nse
4140
#' @template return
4241
#'

‎R/pbias.R‎

Lines changed: 0 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -33,7 +33,6 @@
3333
#' - **Poor** -- `pbias()` >= ±15.0
3434
#'
3535
#' @family numeric metrics
36-
#' @family accuracy metrics
3736
#' @templateVar fn pbias
3837
#' @template return
3938
#'

‎R/press.R‎

Lines changed: 1 addition & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -35,8 +35,7 @@
3535
#' different transformations of response variable, e.g. linear regression and
3636
#' log-transformed linear regression (*Helsel et al., 2020*).
3737
#'
38-
#' @family numeric metrics
39-
#' @family accuracy metrics
38+
#' @family regression metrics
4039
#' @templateVar fn press
4140
#' @template return
4241
#'

‎R/sfe.R‎

Lines changed: 1 addition & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -19,8 +19,7 @@
1919
#' \item \eqn{obs} defines model observations at time step \eqn{i}
2020
#' }
2121
#'
22-
#' @family numeric metrics
23-
#' @family accuracy metrics
22+
#' @family regression metrics
2423
#' @templateVar fn sfe
2524
#' @template return
2625
#'

0 commit comments

Comments
 (0)