Evaluate a function to transf and atransf that can alias with expected functions such that xlab is set to corresponding label.
ltrainstg opened this issue · 4 comments
Feature Request
Be able to pass a custom function to the transf and atransf variables and get the expected xlab.
Summary
I like to use a variable for the transf and atransf when automating results of forest plots but the way these are parsed in forest and .setlab only the explicit text arguments are recognized.
I did some digging and I think it is possible to resolve this with a few changes by taking advantage of this stack post.
https://stackoverflow.com/questions/32266433/in-r-how-do-i-test-that-two-functions-have-the-same-definition
Reproducible Example (if applicable)
The xlab is different for these two forest plots because the first will capture the character and the
get_atransf <- function(measure=""){
if (is.null(measure)){
measure <- ""
}
inv.function <- ""
if(measure %in% c('MD', 'SMD', 'RD','MN', 'PR')) inv.function <- identity
if(measure %in% c('OR', 'RR', 'PLN')) inv.function <- exp
if(measure %in% c('PLO')) return(transf.ilogit)
return(inv.function )
}
res <- rma(measure="PLO", xi=ci, ni=n2i, data=dat.nielweise2007)
forest(res, atransf = transf.ilogit)
forest(res, atransf =get_atransf('PLO'))We can check that these two things should be the same, but the behavior differs because only the text argument of atransf is parsed and not what it evaluates.
identical(deparse(transf.ilogit), deparse(get_atransf('PLO')))Suggested Edit 1
In the defaults plots we need to change how the argument is substituted then deparsed.
Because of substitute we just get the function name, but we want what the function evaluates since the test_atransf_as_a_function returns the 'default' back transform for the measure.
#transf.char <- deparse(substitute(transf))
#atransf.char <- deparse(substitute(atransf))
transf.char <- deparse(transf)
atransf.char <- deparse(atransf)Suggested Edit 2
A corresponding edit in .setlabs is need.
Here we create a list of possible functions and deparse them.
So long as any are identical we can use the recommended label.
Here I just make a dummy .setlabs for a test case.
setlab_custom <- function(measure, transf.char, atransf.char, gentype, short=FALSE){
if (measure == "PLO") {
if (transf.char == "FALSE" && atransf.char == "FALSE") {
lab <- ifelse(short, "Log[Odds]", "Log Odds")
} else {
lab <- ifelse(short, lab, "Transformed Log Odds")
# Take all the possible expected matching functions and deparse them
# This allows us to pass funtions as variables in metafor.
funct_list <- list(transf.ilogit.int, transf.ilogit, plogis)
funct_list <- lapply(funct_list, deparse)
if (any(sapply(funct_list, identical, atransf.char)))
lab <- ifelse(short, "Proportion", "Proportion (logit scale)")
}
}
return(lab)
}
# Current only way using explicit text argument
# It works since this is the current design.
atransf.char <- deparse(substitute(transf.ilogit))
metafor:::.setlab("PLO", "FALSE", atransf.char,gentype=1)
# using a function that takes a variable fails
# it just takes the string of the exact argument
atransf.char <- deparse(substitute(get_atransf('PLO')))
metafor:::.setlab("PLO", "FALSE", atransf.char,gentype=1)
# New method saves what the argument evaluates to
# New evaluation checks all possible good evaluations.
atransf.char <- deparse(get_atransf('PLO'))
setlab_custom("PLO", "FALSE", atransf.char,gentype=1)
sessionInfo()
R version 4.1.0 (2021-05-18)
Platform: x86_64-pc-linux-gnu (64-bit)
Running under: Ubuntu 20.04.2 LTS
Matrix products: default
BLAS: /usr/lib/x86_64-linux-gnu/blas/libblas.so.3.9.0
LAPACK: /usr/lib/x86_64-linux-gnu/lapack/liblapack.so.3.9.0
locale:
[1] LC_CTYPE=en_US.UTF-8 LC_NUMERIC=C LC_TIME=en_US.UTF-8
[4] LC_COLLATE=en_US.UTF-8 LC_MONETARY=en_US.UTF-8 LC_MESSAGES=en_US.UTF-8
[7] LC_PAPER=en_US.UTF-8 LC_NAME=C LC_ADDRESS=C
[10] LC_TELEPHONE=C LC_MEASUREMENT=en_US.UTF-8 LC_IDENTIFICATION=C
attached base packages:
[1] stats graphics grDevices utils datasets methods base
other attached packages:
[1] DREmetafor_1.0 metafor_2.4-0 Matrix_1.3-3
loaded via a namespace (and not attached):
[1] Rcpp_1.0.6 pillar_1.4.7 compiler_4.1.0 tools_4.1.0
[5] boot_1.3-28 digest_0.6.27 jsonlite_1.7.2 evaluate_0.14
[9] lifecycle_0.2.0 tibble_3.0.4 nlme_3.1-152 gtable_0.3.0
[13] lattice_0.20-44 pkgconfig_2.0.3 rlang_0.4.10 personograph_0.1.3
[17] yaml_2.2.1 xfun_0.24 dplyr_1.0.2 stringr_1.4.0
[21] knitr_1.33 generics_0.1.0 vctrs_0.3.8 grid_4.1.0
[25] tidyselect_1.1.0 grImport_0.9-3 glue_1.4.2 R6_2.5.0
[29] XML_3.99-0.5 rmarkdown_2.6 pander_0.6.4 ggplot2_3.3.3
[33] purrr_0.3.4 magrittr_2.0.1 htmltools_0.5.0 DREutils_1.0
[37] scales_1.1.1 ellipsis_0.3.2 colorspace_2.0-0 stringi_1.6.2
[41] munsell_0.5.0 crayon_1.4.1 Cairo_1.5-12.2
Apologies for the slow response, but this came in just as I went on my summer break and afterwards I had some catching up to do on some other tasks. This is an interesting suggestion and I will see if I can fully implement this.
Yes. This works for us. I tried the most common cases we handle.
We've been using a switch statement to handle this, but it's much nicer when it's handled by the package.
Thanks for taking the time to look into this.
Test Cases
atransf Function
get_atransf <- function(measure=""){
if (is.null(measure)){
measure <- ""
}
inv.function <- FALSE
if(measure %in% c('MD', 'SMD', 'RD','MN', 'PR')) inv.function <- FALSE
if(measure %in% c('OR', 'RR', 'PLN')) inv.function <- exp
if(measure %in% c('PLO')) return(transf.ilogit)
return(inv.function )
}
Single Proportion
measure <- "PR"
res <- rma(measure=measure, xi=ci, ni=n2i, data=dat.nielweise2007)
forest(res, atransf =get_atransf(measure))
forest(res)
measure <- "PLO"
res <- rma(measure=measure, xi=ci, ni=n2i, data=dat.nielweise2007)
forest(res, atransf =get_atransf(measure))
forest(res )
measure <- "PLN"
res <- rma(measure=measure, xi=ci, ni=n2i, data=dat.nielweise2007)
forest(res, atransf =get_atransf(measure))
forest(res )
Two Proportions
measure <- "OR"
dat <- escalc(measure=measure, ai=tpos, bi=tneg, ci=cpos, di=cneg, data=dat.bcg)
res <- rma(yi, vi,data=dat)
forest(res, atransf =get_atransf(measure))
forest(res )
measure <- "RR"
dat <- escalc(measure=measure, ai=tpos, bi=tneg, ci=cpos, di=cneg, data=dat.bcg)
res <- rma(yi, vi,data=dat)
forest(res, atransf =get_atransf(measure))
forest(res )
measure <- "RD"
dat <- escalc(measure=measure, ai=tpos, bi=tneg, ci=cpos, di=cneg, data=dat.bcg)
res <- rma(yi, vi,data=dat)
forest(res, atransf =get_atransf(measure))
forest(res )
Two Means
measure <- 'MD'
dat1 <- escalc(measure=measure, m1i=m1i, sd1i=sd1i, n1i=n1i,
m2i=m2i, sd2i=sd2i, n2i=n2i, data=dat.normand1999)
res <- rma(yi, vi, data=dat1)
forest(res, atransf =get_atransf(measure))
forest(res)
measure <- 'SMD'
dat1 <- escalc(measure=measure, m1i=m1i, sd1i=sd1i, n1i=n1i,
m2i=m2i, sd2i=sd2i, n2i=n2i, data=dat.normand1999)
res <- rma(yi, vi, data=dat1)
forest(res, atransf =get_atransf(measure))
forest(res)
Happy to hear that and thanks for the suggestion!