diff --git a/.lintr b/.lintr index b0e8abefe..c575e7c95 100644 --- a/.lintr +++ b/.lintr @@ -1,7 +1,7 @@ linters: linters_with_defaults( absolute_path_linter = NULL, commented_code_linter = NULL, - cyclocomp_linter = cyclocomp_linter(25), + cyclocomp_linter = cyclocomp_linter(125), extraction_operator_linter = NULL, implicit_integer_linter = NULL, line_length_linter(120), @@ -9,6 +9,7 @@ linters: linters_with_defaults( nonportable_path_linter = NULL, object_name_linter = NULL, object_length_linter(50), + library_call_linter = NULL, object_usage_linter = NULL, todo_comment_linter = NULL, undesirable_function_linter(c("mapply" = NA, "sapply" = NA, "setwd" = NA)), diff --git a/CRAN-SUBMISSION b/CRAN-SUBMISSION index 6e4648664..521ab7ac2 100644 --- a/CRAN-SUBMISSION +++ b/CRAN-SUBMISSION @@ -1,3 +1,3 @@ -Version: 0.21.6 -Date: 2024-03-17 15:06:23 UTC -SHA: fa0a2223f09a2b641762866e202cd54ddc65b3b3 +Version: 0.22.2 +Date: 2024-09-03 21:16:57 UTC +SHA: 367dcec5489ffa53d5b768af6cfaadf1afe69666 diff --git a/DESCRIPTION b/DESCRIPTION index 2ab5124f9..950418f45 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,18 +1,18 @@ Type: Package Package: parameters Title: Processing of Model Parameters -Version: 0.21.6.7 +Version: 0.22.2.18 Authors@R: c(person(given = "Daniel", family = "Lüdecke", role = c("aut", "cre"), email = "d.luedecke@uke.de", - comment = c(ORCID = "0000-0002-8895-3206", Twitter = "@strengejacke")), + comment = c(ORCID = "0000-0002-8895-3206")), person(given = "Dominique", family = "Makowski", role = "aut", email = "dom.makowski@gmail.com", - comment = c(ORCID = "0000-0001-5375-9967", Twitter = "@Dom_Makowski")), + comment = c(ORCID = "0000-0001-5375-9967")), person(given = "Mattan S.", family = "Ben-Shachar", role = "aut", @@ -22,7 +22,7 @@ Authors@R: family = "Patil", role = "aut", email = "patilindrajeet.science@gmail.com", - comment = c(ORCID = "0000-0003-1995-6531", Twitter = "@patilindrajeets")), + comment = c(ORCID = "0000-0003-1995-6531")), person(given = "Søren", family = "Højsgaard", role = "aut", @@ -31,7 +31,7 @@ Authors@R: family = "Wiernik", role = "aut", email = "brenton@wiernik.org", - comment = c(ORCID = "0000-0001-9560-6336", Twitter = "@bmwiernik")), + comment = c(ORCID = "0000-0001-9560-6336")), person(given = "Zen J.", family = "Lau", role = "ctb", @@ -40,12 +40,12 @@ Authors@R: family = "Arel-Bundock", role = "ctb", email = "vincent.arel-bundock@umontreal.ca", - comment = c(ORCID = "0000-0003-1995-6531", Twitter = "@vincentab")), + comment = c(ORCID = "0000-0003-2042-7063")), person(given = "Jeffrey", family = "Girard", role = "ctb", email = "me@jmgirard.com", - comment = c(ORCID = "0000-0002-7359-3746", Twitter = "@jeffreymgirard")), + comment = c(ORCID = "0000-0002-7359-3746")), person(given = "Christina", family = "Maimone", role = "rev", @@ -58,7 +58,7 @@ Authors@R: family = "Morrison", role = "ctb", email = "dmorrison01@ucla.edu", - comment = c(ORCID = "0000-0002-7195-830X", Twitter = "@demstats1")), + comment = c(ORCID = "0000-0002-7195-830X")), person(given = "Joseph", family = "Luchman", role = "ctb", @@ -79,9 +79,9 @@ BugReports: https://github.com/easystats/parameters/issues Depends: R (>= 3.6) Imports: - bayestestR (>= 0.13.2), - datawizard (>= 0.10.0), - insight (>= 0.19.10), + bayestestR (>= 0.14.0), + datawizard (>= 0.13.0), + insight (>= 0.20.5), graphics, methods, stats, @@ -101,6 +101,7 @@ Suggests: brglm2, brms, broom, + broom.mixed, cAIC4, car, carData, @@ -108,10 +109,12 @@ Suggests: ClassDiscovery, clubSandwich, cluster, + cobalt, coda, coxme, cplm, dbscan, + distributional, domir (>= 0.2.0), drc, DRR, @@ -133,11 +136,12 @@ Suggests: ggeffects (>= 1.3.2), ggplot2, GLMMadaptive, - glmmTMB, + glmmTMB (>= 1.1.10), + glmtoolbox, GPArotation, gt, haven, - httr, + httr2, Hmisc, ivreg, knitr, @@ -151,7 +155,7 @@ Suggests: logspline, lqmm, M3C, - marginaleffects (>= 0.16.0), + marginaleffects (>= 0.20.1), MASS, Matrix, mclogit, @@ -177,7 +181,7 @@ Suggests: panelr, pbkrtest, PCDimension, - performance (>= 0.10.8), + performance (>= 0.12.0), plm, PMCMRplus, poorman, @@ -188,8 +192,10 @@ Suggests: pvclust, quantreg, randomForest, + RcppEigen, rmarkdown, rms, + rstan, rstanarm, sandwich, see (>= 0.8.1), @@ -197,25 +203,25 @@ Suggests: sparsepca, survey, survival, + svylme, testthat (>= 3.2.1), tidyselect, tinytable (>= 0.1.0), TMB, truncreg, + vdiffr, VGAM, + WeightIt (>= 1.2.0), withr, WRS2 VignetteBuilder: knitr Encoding: UTF-8 Language: en-US -RoxygenNote: 7.3.1 +RoxygenNote: 7.3.2 Roxygen: list(markdown = TRUE) Config/testthat/edition: 3 Config/testthat/parallel: true -Config/Needs/website: - rstudio/bslib, - r-lib/pkgdown, - easystats/easystatstemplate +Config/Needs/website: easystats/easystatstemplate Config/rcmdcheck/ignore-inconsequential-notes: true -Remotes: easystats/insight +Remotes: easystats/bayestestR#678 diff --git a/NAMESPACE b/NAMESPACE index b4974aef4..172919606 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -42,6 +42,7 @@ S3method(ci,gamm4) S3method(ci,geeglm) S3method(ci,glht) S3method(ci,glm) +S3method(ci,glmgee) S3method(ci,glmm) S3method(ci,glmmTMB) S3method(ci,hglm) @@ -81,11 +82,13 @@ S3method(ci,mmrm_fit) S3method(ci,mmrm_tmb) S3method(ci,model_fit) S3method(ci,multinom) +S3method(ci,multinom_weightit) S3method(ci,negbin) S3method(ci,negbinirr) S3method(ci,negbinmfx) S3method(ci,nestedLogit) S3method(ci,nlrq) +S3method(ci,ordinal_weightit) S3method(ci,parameters_standardized) S3method(ci,pgmm) S3method(ci,phyloglm) @@ -117,61 +120,6 @@ S3method(convert_efa_to_cfa,fa) S3method(convert_efa_to_cfa,fa.ci) S3method(convert_efa_to_cfa,parameters_efa) S3method(convert_efa_to_cfa,parameters_pca) -S3method(degrees_of_freedom,BBmm) -S3method(degrees_of_freedom,BBreg) -S3method(degrees_of_freedom,betamfx) -S3method(degrees_of_freedom,betaor) -S3method(degrees_of_freedom,bfsl) -S3method(degrees_of_freedom,bigglm) -S3method(degrees_of_freedom,biglm) -S3method(degrees_of_freedom,cgam) -S3method(degrees_of_freedom,cgamm) -S3method(degrees_of_freedom,coeftest) -S3method(degrees_of_freedom,complmrob) -S3method(degrees_of_freedom,default) -S3method(degrees_of_freedom,emmGrid) -S3method(degrees_of_freedom,emm_list) -S3method(degrees_of_freedom,fixest) -S3method(degrees_of_freedom,fixest_multi) -S3method(degrees_of_freedom,garch) -S3method(degrees_of_freedom,glht) -S3method(degrees_of_freedom,gls) -S3method(degrees_of_freedom,hglm) -S3method(degrees_of_freedom,ivFixed) -S3method(degrees_of_freedom,ivprobit) -S3method(degrees_of_freedom,logitmfx) -S3method(degrees_of_freedom,logitor) -S3method(degrees_of_freedom,lqm) -S3method(degrees_of_freedom,lqmm) -S3method(degrees_of_freedom,mediate) -S3method(degrees_of_freedom,merModList) -S3method(degrees_of_freedom,mhurdle) -S3method(degrees_of_freedom,mipo) -S3method(degrees_of_freedom,mira) -S3method(degrees_of_freedom,mmrm) -S3method(degrees_of_freedom,mmrm_fit) -S3method(degrees_of_freedom,mmrm_tmb) -S3method(degrees_of_freedom,model_fit) -S3method(degrees_of_freedom,multinom) -S3method(degrees_of_freedom,negbinirr) -S3method(degrees_of_freedom,negbinmfx) -S3method(degrees_of_freedom,nestedLogit) -S3method(degrees_of_freedom,nlrq) -S3method(degrees_of_freedom,nnet) -S3method(degrees_of_freedom,plm) -S3method(degrees_of_freedom,poissonirr) -S3method(degrees_of_freedom,poissonmfx) -S3method(degrees_of_freedom,probitmfx) -S3method(degrees_of_freedom,rlm) -S3method(degrees_of_freedom,rq) -S3method(degrees_of_freedom,rqs) -S3method(degrees_of_freedom,rqss) -S3method(degrees_of_freedom,selection) -S3method(degrees_of_freedom,serp) -S3method(degrees_of_freedom,summary.lm) -S3method(degrees_of_freedom,systemfit) -S3method(degrees_of_freedom,truncreg) -S3method(degrees_of_freedom,vgam) S3method(display,compare_parameters) S3method(display,equivalence_test_lm) S3method(display,parameters_brms_meta) @@ -197,6 +145,7 @@ S3method(equivalence_test,lm) S3method(equivalence_test,lme) S3method(equivalence_test,merMod) S3method(equivalence_test,mixed) +S3method(equivalence_test,parameters_model) S3method(equivalence_test,parameters_simulate_model) S3method(equivalence_test,rma) S3method(equivalence_test,wbm) @@ -347,6 +296,7 @@ S3method(model_parameters,mmrm_fit) S3method(model_parameters,mmrm_tmb) S3method(model_parameters,model_fit) S3method(model_parameters,multinom) +S3method(model_parameters,multinom_weightit) S3method(model_parameters,mvord) S3method(model_parameters,negbin) S3method(model_parameters,negbinirr) @@ -354,6 +304,7 @@ S3method(model_parameters,negbinmfx) S3method(model_parameters,nestedLogit) S3method(model_parameters,omega) S3method(model_parameters,onesampb) +S3method(model_parameters,ordinal_weightit) S3method(model_parameters,osrt) S3method(model_parameters,pairwise.htest) S3method(model_parameters,pam) @@ -381,6 +332,7 @@ S3method(model_parameters,stanfit) S3method(model_parameters,stanmvreg) S3method(model_parameters,stanreg) S3method(model_parameters,summary_emm) +S3method(model_parameters,svy2lme) S3method(model_parameters,svyglm) S3method(model_parameters,svytable) S3method(model_parameters,systemfit) @@ -399,6 +351,39 @@ S3method(model_parameters,zeroinfl) S3method(model_parameters,zoo) S3method(p_calibrate,default) S3method(p_calibrate,numeric) +S3method(p_direction,coxph) +S3method(p_direction,feis) +S3method(p_direction,felm) +S3method(p_direction,gee) +S3method(p_direction,glm) +S3method(p_direction,glmmTMB) +S3method(p_direction,gls) +S3method(p_direction,hurdle) +S3method(p_direction,lm) +S3method(p_direction,lme) +S3method(p_direction,merMod) +S3method(p_direction,mixed) +S3method(p_direction,rma) +S3method(p_direction,svyglm) +S3method(p_direction,wbm) +S3method(p_direction,zeroinfl) +S3method(p_significance,coxph) +S3method(p_significance,feis) +S3method(p_significance,felm) +S3method(p_significance,gee) +S3method(p_significance,glm) +S3method(p_significance,glmmTMB) +S3method(p_significance,gls) +S3method(p_significance,hurdle) +S3method(p_significance,lm) +S3method(p_significance,lme) +S3method(p_significance,merMod) +S3method(p_significance,mixed) +S3method(p_significance,parameters_model) +S3method(p_significance,rma) +S3method(p_significance,svyglm) +S3method(p_significance,wbm) +S3method(p_significance,zeroinfl) S3method(p_value,BBmm) S3method(p_value,BBreg) S3method(p_value,BFBayesFactor) @@ -462,6 +447,7 @@ S3method(p_value,gee) S3method(p_value,geeglm) S3method(p_value,glht) S3method(p_value,glimML) +S3method(p_value,glmgee) S3method(p_value,glmm) S3method(p_value,glmx) S3method(p_value,gls) @@ -502,6 +488,7 @@ S3method(p_value,mmrm_fit) S3method(p_value,mmrm_tmb) S3method(p_value,model_fit) S3method(p_value,multinom) +S3method(p_value,multinom_weightit) S3method(p_value,mvord) S3method(p_value,negbin) S3method(p_value,negbinirr) @@ -510,6 +497,7 @@ S3method(p_value,nestedLogit) S3method(p_value,nlrq) S3method(p_value,numeric) S3method(p_value,ols) +S3method(p_value,ordinal_weightit) S3method(p_value,pggls) S3method(p_value,pglm) S3method(p_value,plm) @@ -534,6 +522,7 @@ S3method(p_value,speedlm) S3method(p_value,stanreg) S3method(p_value,summary.lm) S3method(p_value,survreg) +S3method(p_value,svy2lme) S3method(p_value,svyglm) S3method(p_value,svyglm.nb) S3method(p_value,svyglm.zip) @@ -592,6 +581,8 @@ S3method(print,n_clusters_hclust) S3method(print,n_clusters_silhouette) S3method(print,n_factors) S3method(print,p_calibrate) +S3method(print,p_direction_lm) +S3method(print,p_significance_lm) S3method(print,parameters_brms_meta) S3method(print,parameters_clusters) S3method(print,parameters_da) @@ -718,6 +709,7 @@ S3method(simulate_model,zeroinfl) S3method(simulate_parameters,default) S3method(simulate_parameters,glmmTMB) S3method(simulate_parameters,hurdle) +S3method(simulate_parameters,mblogit) S3method(simulate_parameters,mlm) S3method(simulate_parameters,multinom) S3method(simulate_parameters,nestedLogit) @@ -792,6 +784,7 @@ S3method(standard_error,gee) S3method(standard_error,geeglm) S3method(standard_error,glht) S3method(standard_error,glimML) +S3method(standard_error,glmgee) S3method(standard_error,glmm) S3method(standard_error,glmmTMB) S3method(standard_error,glmx) @@ -837,6 +830,7 @@ S3method(standard_error,mmrm_fit) S3method(standard_error,mmrm_tmb) S3method(standard_error,model_fit) S3method(standard_error,multinom) +S3method(standard_error,multinom_weightit) S3method(standard_error,mvord) S3method(standard_error,mvstanreg) S3method(standard_error,negbin) @@ -846,6 +840,7 @@ S3method(standard_error,nestedLogit) S3method(standard_error,nlrq) S3method(standard_error,numeric) S3method(standard_error,ols) +S3method(standard_error,ordinal_weightit) S3method(standard_error,parameters_kurtosis) S3method(standard_error,parameters_skewness) S3method(standard_error,parameters_standardized) @@ -869,6 +864,7 @@ S3method(standard_error,sem) S3method(standard_error,stanreg) S3method(standard_error,summary.lm) S3method(standard_error,survreg) +S3method(standard_error,svy2lme) S3method(standard_error,svyglm) S3method(standard_error,svyglm.nb) S3method(standard_error,svyglm.zip) @@ -954,7 +950,9 @@ export(n_components) export(n_factors) export(n_parameters) export(p_calibrate) +export(p_direction) export(p_function) +export(p_significance) export(p_value) export(p_value_betwithin) export(p_value_kenward) @@ -992,6 +990,8 @@ export(supported_models) export(visualisation_recipe) importFrom(bayestestR,ci) importFrom(bayestestR,equivalence_test) +importFrom(bayestestR,p_direction) +importFrom(bayestestR,p_significance) importFrom(datawizard,demean) importFrom(datawizard,describe_distribution) importFrom(datawizard,kurtosis) diff --git a/NEWS.md b/NEWS.md index a4e219d06..397bb62c8 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,5 +1,122 @@ +# parameters 0.23.0 + +## Breaking Changes + +* Argument `summary` in `model_parameters()` is now deprecated. Please use + `include_info` instead. + +* Changed output style for the included additional information on model formula, + sigma and R2 when printing model parameters. This information now also includes + the RMSE. + +## Changes + +* Used more accurate analytic approach to calculate normal distributions for + the SGPV in `equivalence_test()` and used in `p_significance()`. + +* Added `p_direction()` methods for frequentist models. This is a convenient + way to test the direction of the effect, which formerly was already (and still + is) possible with `pd = TRUE` in `model_parameters()`. + +* `p_function()`, `p_significance()` and `equivalence_test()` get a `vcov` and + `vcov_args` argument, so that results can be based on robust standard errors + and confidence intervals. + +* `equivalence_test()` and `p_significance()` work with objects returned by + `model_parameters()`. + +* `pool_parameters()` now better deals with models with multiple components + (e.g. zero-inflation or dispersion). + +* Revision / enhancement of some documentation. + +* Updated *glmmTMB* methods to work with the latest version of the package. + +* Improved printing for `simulate_parameters()` for models from packages *mclogit*. + +# parameters 0.22.2 + +## New supported models + +* Support for models `glm_weightit`, `multinom_weightit` and `ordinal_weightit` + from package *WeightIt*. + +## Changes + +* Added `p_significance()` methods for frequentist models. + +* Methods for `degrees_of_freedom()` have been removed. `degrees_of_freedom()` + now calls `insight::get_df()`. + +* `model_parameters()` for data frames and `draws` objects from package + *posterior* also gets an `exponentiate` argument. + +## Bug fixes + +* Fixed issue with warning for spuriously high coefficients for Stan-models + (non-Gaussian). + +# parameters 0.22.1 + +## Breaking changes + +* Revised calculation of the second generation p-value (SGPV) in `equivalence_test()`, + which should now be more accurate related to the proportion of the interval + that falls inside the ROPE. Formerly, the confidence interval was simply treated + as uniformly distributed when calculating the SGPV, now the interval is assumed + to be normally distributed. + +## New supported models + +* Support for `svy2lme` models from package *svylme*. + +## Changes + +* `standardize_parameters()` now also prettifies labels of factors. + +## Bug fixes + +* Fixed issue with `equivalence_test()` when ROPE range was not symmetrically + centered around zero (e.g., `range = c(-99, 0.1)`). + +* `model_parameters()` for `anova()` from mixed models now also includes the + denominator degrees of freedom in the output (`df_error`). + +* `print(..., pretty_names = "labels")` for tobit-models from package *AER* now + include value labels, if available. + +* Patch release, to ensure that performance runs with older version of datawizard + on Mac OS X with R (old-release). + +# parameters 0.22.0 + +## Breaking changes + +* Deprecated arguments in `model_parameters()` for `htest`, `aov` and + `BFBayesFactor` objects were removed. + +* Argument `effectsize_type` is deprecated. Please use `es_type` now. This change + was necessary to avoid conflicts with partial matching of argument names (here: + `effects`). + +## New supported models + +* Support for objects from `stats::Box.test()`. + +* Support for `glmgee` models from package *glmtoolbox*. + +## Bug fix + +* Fixed edge case in `predict()` for `factor_analysis()`. + +* Fixed wrong ORCID in `DESCRIPTION`. + # parameters 0.21.7 +## Changes + +* Fixed issues related to latest release from _marginaleffects_. + ## Bug fixes * Fixes issue in `compare_parameters()` for models from package *blme*. @@ -170,7 +287,7 @@ * `as.data.frame` methods for extracting posterior draws via `bootstrap_model()` have been retired. Instead, directly using `bootstrap_model()` is recommended. - + ## Changes to functions * `equivalence_test()` gets a method for `ggeffects` objects from package @@ -322,7 +439,7 @@ * Following functions were moved from package *parameters* to *performance*: `check_sphericity_bartlett()`, `check_kmo()`, `check_factorstructure()` and `check_clusterstructure()`. - + ## Changes to functions * Added `sparse` option to `principal_components()` for sparse PCA. diff --git a/R/1_model_parameters.R b/R/1_model_parameters.R index 991a3704d..ab2c75968 100644 --- a/R/1_model_parameters.R +++ b/R/1_model_parameters.R @@ -41,10 +41,10 @@ #' the number of digits for the output. If `s_value = TRUE`, the p-value will #' be replaced by the S-value in the output (cf. _Rafi and Greenland 2020_). #' `pd` adds an additional column with the _probability of direction_ (see -#' [bayestestR::p_direction()] for details). `groups` can be used to group +#' [`bayestestR::p_direction()`] for details). `groups` can be used to group #' coefficients. It will be passed to the print-method, or can directly be used -#' in `print()`, see documentation in [print.parameters_model()]. Furthermore, -#' see 'Examples' in [model_parameters.default()]. For developers, whose +#' in `print()`, see documentation in [`print.parameters_model()`]. Furthermore, +#' see 'Examples' in [`model_parameters.default()`]. For developers, whose #' interest mainly is to get a "tidy" data frame of model summaries, it is #' recommended to set `pretty_names = FALSE` to speed up computation of the #' summary table. @@ -74,10 +74,7 @@ #' packages or other software packages (like SPSS). To mimic behaviour of SPSS #' or packages such as **lm.beta**, use `standardize = "basic"`. #' -#' @section -#' -#' Standardization Methods: -#' +#' @section Standardization Methods: #' - **refit**: This method is based on a complete model re-fit with a #' standardized version of the data. Hence, this method is equal to #' standardizing the variables before fitting the model. It is the "purest" and @@ -87,7 +84,7 @@ #' include interactions or transformations (e.g., polynomial or spline terms). #' The `robust` (default to `FALSE`) argument enables a robust standardization #' of data, i.e., based on the `median` and `MAD` instead of the `mean` and -#' `SD`. **See [standardize()] for more details.** +#' `SD`. **See [`datawizard::standardize()`] for more details.** #' **Note** that `standardize_parameters(method = "refit")` may not return #' the same results as fitting a model on data that has been standardized with #' `standardize()`; `standardize_parameters()` used the data used by the model @@ -280,21 +277,105 @@ #' p-values are based on the probability of direction ([`bayestestR::p_direction()`]), #' which is converted into a p-value using [`bayestestR::pd_to_p()`]. #' +#' @section Statistical inference - how to quantify evidence: +#' There is no standardized approach to drawing conclusions based on the +#' available data and statistical models. A frequently chosen but also much +#' criticized approach is to evaluate results based on their statistical +#' significance (*Amrhein et al. 2017*). +#' +#' A more sophisticated way would be to test whether estimated effects exceed +#' the "smallest effect size of interest", to avoid even the smallest effects +#' being considered relevant simply because they are statistically significant, +#' but clinically or practically irrelevant (*Lakens et al. 2018, Lakens 2024*). +#' +#' A rather unconventional approach, which is nevertheless advocated by various +#' authors, is to interpret results from classical regression models either in +#' terms of probabilities, similar to the usual approach in Bayesian statistics +#' (*Schweder 2018; Schweder and Hjort 2003; Vos 2022*) or in terms of relative +#' measure of "evidence" or "compatibility" with the data (*Greenland et al. 2022; +#' Rafi and Greenland 2020*), which nevertheless comes close to a probabilistic +#' interpretation. +#' +#' A more detailed discussion of this topic is found in the documentation of +#' [`p_function()`]. +#' +#' The **parameters** package provides several options or functions to aid +#' statistical inference. These are, for example: +#' - [`equivalence_test()`][equivalence_test.lm], to compute the (conditional) +#' equivalence test for frequentist models +#' - [`p_significance()`][p_significance.lm], to compute the probability of +#' *practical significance*, which can be conceptualized as a unidirectional +#' equivalence test +#' - [`p_function()`], or _consonance function_, to compute p-values and +#' compatibility (confidence) intervals for statistical models +#' - the `pd` argument (setting `pd = TRUE`) in `model_parameters()` includes +#' a column with the *probability of direction*, i.e. the probability that a +#' parameter is strictly positive or negative. See [`bayestestR::p_direction()`] +#' for details. If plotting is desired, the [`p_direction()`][p_direction.lm] +#' function can be used, together with `plot()`. +#' - the `s_value` argument (setting `s_value = TRUE`) in `model_parameters()` +#' replaces the p-values with their related _S_-values (*Rafi and Greenland 2020*) +#' - finally, it is possible to generate distributions of model coefficients by +#' generating bootstrap-samples (setting `bootstrap = TRUE`) or simulating +#' draws from model coefficients using [`simulate_model()`]. These samples +#' can then be treated as "posterior samples" and used in many functions from +#' the **bayestestR** package. +#' +#' Most of the above shown options or functions derive from methods originally +#' implemented for Bayesian models (*Makowski et al. 2019*). However, assuming +#' that model assumptions are met (which means, the model fits well to the data, +#' the correct model is chosen that reflects the data generating process +#' (distributional model family) etc.), it seems appropriate to interpret +#' results from classical frequentist models in a "Bayesian way" (more details: +#' documentation in [`p_function()`]). +#' #' @inheritSection format_parameters Interpretation of Interaction Terms #' @inheritSection print.parameters_model Global Options to Customize Messages and Tables when Printing #' #' @references #' +#' - Amrhein, V., Korner-Nievergelt, F., and Roth, T. (2017). The earth is +#' flat (p > 0.05): Significance thresholds and the crisis of unreplicable +#' research. PeerJ, 5, e3544. \doi{10.7717/peerj.3544} +#' +#' - Greenland S, Rafi Z, Matthews R, Higgs M. To Aid Scientific Inference, +#' Emphasize Unconditional Compatibility Descriptions of Statistics. (2022) +#' https://arxiv.org/abs/1909.08583v7 (Accessed November 10, 2022) +#' #' - Hoffman, L. (2015). Longitudinal analysis: Modeling within-person -#' fluctuation and change. Routledge. +#' fluctuation and change. Routledge. #' -#' - Neter, J., Wasserman, W., & Kutner, M. H. (1989). Applied linear -#' regression models. +#' - Lakens, D. (2024). Improving Your Statistical Inferences (Version v1.5.1). +#' Retrieved from https://lakens.github.io/statistical_inferences/. +#' \doi{10.5281/ZENODO.6409077} +#' +#' - Lakens, D., Scheel, A. M., and Isager, P. M. (2018). Equivalence Testing +#' for Psychological Research: A Tutorial. Advances in Methods and Practices +#' in Psychological Science, 1(2), 259–269. \doi{10.1177/2515245918770963} +#' +#' - Makowski, D., Ben-Shachar, M. S., Chen, S. H. A., and Lüdecke, D. (2019). +#' Indices of Effect Existence and Significance in the Bayesian Framework. +#' Frontiers in Psychology, 10, 2767. \doi{10.3389/fpsyg.2019.02767} +#' +#' - Neter, J., Wasserman, W., and Kutner, M. H. (1989). Applied linear +#' regression models. #' #' - Rafi Z, Greenland S. Semantic and cognitive tools to aid statistical -#' science: replace confidence and significance by compatibility and surprise. -#' BMC Medical Research Methodology (2020) 20:244. - +#' science: replace confidence and significance by compatibility and surprise. +#' BMC Medical Research Methodology (2020) 20:244. +#' +#' - Schweder T. Confidence is epistemic probability for empirical science. +#' Journal of Statistical Planning and Inference (2018) 195:116–125. +#' \doi{10.1016/j.jspi.2017.09.016} +#' +#' - Schweder T, Hjort NL. Frequentist analogues of priors and posteriors. +#' In Stigum, B. (ed.), Econometrics and the Philosophy of Economics: Theory +#' Data Confrontation in Economics, pp. 285-217. Princeton University Press, +#' Princeton, NJ, 2003 +#' +#' - Vos P, Holbert D. Frequentist statistical inference without repeated sampling. +#' Synthese 200, 89 (2022). \doi{10.1007/s11229-022-03560-x} +#' #' @return A data frame of indices related to the model's parameters. #' @export model_parameters <- function(model, ...) { @@ -317,8 +398,8 @@ model_parameters <- function(model, ...) { # Add new options to the docs in "print.parameters_model" -# getOption("parameters_summary"): show model summary -# getOption("parameters_mixed_summary"): show model summary for mixed models +# getOption("parameters_info"): show model summary +# getOption("parameters_mixed_info"): show model summary for mixed models # getOption("parameters_cimethod"): show message about CI approximation # getOption("parameters_exponentiate"): show warning about exp for log/logit links # getOption("parameters_labels"): use value/variable labels instead pretty names @@ -331,10 +412,11 @@ model_parameters <- function(model, ...) { parameters <- model_parameters -#' Parameters from (General) Linear Models +#' @title Parameters from (General) Linear Models +#' @name model_parameters.default #' -#' Extract and compute indices and measures to describe parameters of (general) -#' linear models (GLMs). +#' @description Extract and compute indices and measures to describe parameters +#' of (generalized) linear models (GLMs). #' #' @param model Model object. #' @param ci Confidence Interval (CI) level. Default to `0.95` (`95%`). @@ -384,9 +466,10 @@ parameters <- model_parameters #' _Confidence intervals and approximation of degrees of freedom_ in #' [`model_parameters()`] for further details. When `ci_method=NULL`, in most #' cases `"wald"` is used then. -#' @param summary Logical, if `TRUE`, prints summary information about the +#' @param include_info Logical, if `TRUE`, prints summary information about the #' model (model formula, number of observations, residual standard deviation #' and more). +#' @param summary Deprecated, please use `info` instead. #' @param keep Character containing a regular expression pattern that #' describes the parameters that should be included (for `keep`) or excluded #' (for `drop`) in the returned data frame. `keep` may also be a @@ -407,14 +490,25 @@ parameters <- model_parameters #' `$Parameter` column of the parameters table to get the exact parameter #' names. #' @param ... Arguments passed to or from other methods. For instance, when -#' `bootstrap = TRUE`, arguments like `type` or `parallel` are -#' passed down to `bootstrap_model()`. +#' `bootstrap = TRUE`, arguments like `type` or `parallel` are passed down to +#' `bootstrap_model()`. Further non-documented arguments are `digits`, +#' `p_digits`, `ci_digits` and `footer_digits` to set the number of digits for +#' the output. If `s_value = TRUE`, the p-value will be replaced by the +#' S-value in the output (cf. _Rafi and Greenland 2020_). `pd` adds an +#' additional column with the _probability of direction_ (see +#' [`bayestestR::p_direction()`] for details). `groups` can be used to group +#' coefficients. It will be passed to the print-method, or can directly be +#' used in `print()`, see documentation in [`print.parameters_model()`]. +#' Furthermore, see 'Examples' for this function. For developers, whose +#' interest mainly is to get a "tidy" data frame of model summaries, it is +#' recommended to set `pretty_names = FALSE` to speed up computation of the +#' summary table. #' @param drop See `keep`. #' @param verbose Toggle warnings and messages. #' @inheritParams standard_error #' -#' @seealso [`insight::standardize_names()`] to -#' rename columns into a consistent, standardized naming scheme. +#' @seealso [`insight::standardize_names()`] to rename columns into a +#' consistent, standardized naming scheme. #' #' @inheritSection model_parameters Confidence intervals and approximation of degrees of freedom #' @@ -441,6 +535,11 @@ parameters <- model_parameters #' # different p-value style in output #' model_parameters(model, p_digits = 5) #' model_parameters(model, digits = 3, ci_digits = 4, p_digits = "scientific") +#' +#' # report S-value or probability of direction for parameters +#' model_parameters(model, s_value = TRUE) +#' model_parameters(model, pd = TRUE) +#' #' \donttest{ #' # logistic regression model #' model <- glm(vs ~ wt + cyl, data = mtcars, family = "binomial") @@ -468,16 +567,23 @@ model_parameters.default <- function(model, standardize = NULL, exponentiate = FALSE, p_adjust = NULL, + vcov = NULL, + vcov_args = NULL, summary = getOption("parameters_summary", FALSE), + include_info = getOption("parameters_info", FALSE), keep = NULL, drop = NULL, verbose = TRUE, - vcov = NULL, - vcov_args = NULL, ...) { # validation check for inputs .is_model_valid(model) + ## TODO remove deprecated later + if (!missing(summary)) { + .deprecated_warning("summary", "include_info", verbose) + include_info <- summary + } + # validation check, warn if unsupported argument is used. # unsupported arguments will be removed from the argument list. dots <- .check_dots( @@ -499,7 +605,7 @@ model_parameters.default <- function(model, standardize = standardize, exponentiate = exponentiate, p_adjust = p_adjust, - summary = summary, + include_info = include_info, keep_parameters = keep, drop_parameters = drop, vcov = vcov, @@ -556,12 +662,12 @@ model_parameters.default <- function(model, component = "conditional", ci_method = NULL, p_adjust = NULL, - summary = FALSE, + include_info = FALSE, keep_parameters = NULL, drop_parameters = NULL, - verbose = TRUE, vcov = NULL, vcov_args = NULL, + verbose = TRUE, ...) { dots <- list(...) @@ -628,7 +734,7 @@ model_parameters.default <- function(model, iterations, ci_method = ci_method, p_adjust = p_adjust, - summary = summary, + include_info = include_info, verbose = verbose, ... ) @@ -653,15 +759,22 @@ model_parameters.glm <- function(model, standardize = NULL, exponentiate = FALSE, p_adjust = NULL, + vcov = NULL, + vcov_args = NULL, summary = getOption("parameters_summary", FALSE), + include_info = getOption("parameters_info", FALSE), keep = NULL, drop = NULL, - vcov = NULL, - vcov_args = NULL, verbose = TRUE, ...) { dots <- list(...) + ## TODO remove deprecated later + if (!missing(summary)) { + .deprecated_warning("summary", "include_info", verbose) + include_info <- summary + } + # set default if (is.null(ci_method)) { if (isTRUE(bootstrap)) { @@ -699,7 +812,7 @@ model_parameters.glm <- function(model, standardize = standardize, exponentiate = exponentiate, p_adjust = p_adjust, - summary = summary, + include_info = include_info, keep_parameters = keep, drop_parameters = drop, vcov = vcov, diff --git a/R/2_ci.R b/R/2_ci.R index df2b3b966..c010dcf37 100644 --- a/R/2_ci.R +++ b/R/2_ci.R @@ -7,10 +7,9 @@ #' @param ci Confidence Interval (CI) level. Default to `0.95` (`95%`). #' @param dof Number of degrees of freedom to be used when calculating #' confidence intervals. If `NULL` (default), the degrees of freedom are -#' retrieved by calling [`degrees_of_freedom()`] with -#' approximation method defined in `method`. If not `NULL`, use this argument -#' to override the default degrees of freedom used to compute confidence -#' intervals. +#' retrieved by calling [`insight::get_df()`] with approximation method +#' defined in `method`. If not `NULL`, use this argument to override the +#' default degrees of freedom used to compute confidence intervals. #' @param method Method for computing degrees of freedom for #' confidence intervals (CI) and the related p-values. Allowed are following #' options (which vary depending on the model class): `"residual"`, @@ -25,13 +24,25 @@ #' @param iterations The number of bootstrap replicates. Only applies to models #' of class `merMod` when `method=boot`. #' @param verbose Toggle warnings and messages. -#' @param ... Additional arguments +#' @param ... Additional arguments passed down to the underlying functions. +#' E.g., arguments like `vcov` or `vcov_args` can be used to compute confidence +#' intervals using a specific variance-covariance matrix for the standard +#' errors. #' #' @return A data frame containing the CI bounds. #' #' @inheritSection model_parameters Confidence intervals and approximation of degrees of freedom #' -#' @examplesIf require("glmmTMB") +#' @examplesIf require("glmmTMB") && requireNamespace("sandwich") +#' data(qol_cancer) +#' model <- lm(QoL ~ time + age + education, data = qol_cancer) +#' +#' # regular confidence intervals +#' ci(model) +#' +#' # using heteroscedasticity-robust standard errors +#' ci(model, vcov = "HC3") +#' #' \donttest{ #' library(parameters) #' data(Salamanders, package = "glmmTMB") diff --git a/R/3_p_value.R b/R/3_p_value.R index a357443f2..c2c76c886 100644 --- a/R/3_p_value.R +++ b/R/3_p_value.R @@ -48,6 +48,7 @@ p_value.default <- function(model, .is_model_valid(model) dots <- list(...) + p <- NULL if (is.character(method)) { method <- tolower(method) @@ -66,33 +67,29 @@ p_value.default <- function(model, } if (method == "ml1") { - p <- p_value_ml1(model) - return(p) + return(p_value_ml1(model)) } if (method == "betwithin") { - p <- p_value_betwithin(model) - return(p) + return(p_value_betwithin(model)) } if (method %in% c("residual", "wald", "normal", "satterthwaite", "kenward", "kr")) { if (is.null(dof)) { - dof <- degrees_of_freedom(model, method = method, verbose = FALSE) + dof <- insight::get_df(x = model, type = method, verbose = FALSE) } - p <- .p_value_dof( + return(.p_value_dof( model, dof = dof, method = method, component = component, verbose = verbose, ... - ) - return(p) + )) } if (method %in% c("hdi", "eti", "si", "bci", "bcai", "quantile")) { - p <- bayestestR::p_direction(model, ...) - return(p) + return(bayestestR::p_direction(model, ...)) } # robust standard errors @@ -114,7 +111,7 @@ p_value.default <- function(model, se <- do.call("standard_error", fun_args) } - dof <- degrees_of_freedom(model, method = "wald", verbose = FALSE) + dof <- insight::get_df(x = model, type = "wald", verbose = FALSE) se <- merge(se, co, sort = FALSE) se$Statistic <- se$Estimate / se$SE se$p <- 2 * stats::pt(abs(se$Statistic), df = dof, lower.tail = FALSE) @@ -144,20 +141,20 @@ p_value.default <- function(model, }) } - # output - if (!is.null(p)) { - params <- insight::get_parameters(model, component = component) - if (length(p) == nrow(params) && "Component" %in% colnames(params)) { - p <- .data_frame(Parameter = params$Parameter, p = as.vector(p), Component = params$Component) - } else { - p <- .data_frame(Parameter = names(p), p = as.vector(p)) + # failure warning + if (is.null(p)) { + if (isTRUE(verbose)) { + insight::format_warning("Could not extract p-values from model object.") } - return(p) + return(NULL) } - # failure warning - if (is.null(p) && isTRUE(verbose)) { - insight::format_warning("Could not extract p-values from model object.") + # output + params <- insight::get_parameters(model, component = component) + if (length(p) == nrow(params) && "Component" %in% colnames(params)) { + .data_frame(Parameter = params$Parameter, p = as.vector(p), Component = params$Component) + } else { + .data_frame(Parameter = names(p), p = as.vector(p)) } } @@ -172,23 +169,22 @@ p_value.default <- function(model, if (ncol(cs) >= 4) { # do we have a p-value column based on t? pvcn <- which(colnames(cs) == "Pr(>|t|)") - # if not, do we have a p-value column based on z? if (length(pvcn) == 0) { pvcn <- which(colnames(cs) == "Pr(>|z|)") } - # if not, default to 4 - if (length(pvcn) == 0) pvcn <- 4 - + if (length(pvcn) == 0) { + pvcn <- 4 + } p <- cs[, pvcn] - if (is.null(names(p))) { coef_names <- rownames(cs) - if (length(coef_names) == length(p)) names(p) <- coef_names + if (length(coef_names) == length(p)) { + names(p) <- coef_names + } } } - names(p) <- .remove_backticks_from_string(names(p)) p } diff --git a/R/4_standard_error.R b/R/4_standard_error.R index 6dc4b0292..88a2466cb 100644 --- a/R/4_standard_error.R +++ b/R/4_standard_error.R @@ -18,11 +18,12 @@ #' * A string which indicates the kind of uncertainty estimates to return. #' - Heteroskedasticity-consistent: `"vcovHC"`, `"HC"`, `"HC0"`, `"HC1"`, #' `"HC2"`, `"HC3"`, `"HC4"`, `"HC4m"`, `"HC5"`. See `?sandwich::vcovHC`. -#' - Cluster-robust: `"vcovCR"`, `"CR0"`, `"CR1"`, `"CR1p"`, `"CR1S"`, `"CR2"`, -#' `"CR3"`. See `?clubSandwich::vcovCR`. -#' - Bootstrap: `"vcovBS"`, `"xy"`, `"residual"`, `"wild"`, `"mammen"`, `"webb"`. -#' See `?sandwich::vcovBS`. -#' - Other `sandwich` package functions: `"vcovHAC"`, `"vcovPC"`, `"vcovCL"`, `"vcovPL"`. +#' - Cluster-robust: `"vcovCR"`, `"CR0"`, `"CR1"`, `"CR1p"`, `"CR1S"`, +#' `"CR2"`, `"CR3"`. See `?clubSandwich::vcovCR`. +#' - Bootstrap: `"vcovBS"`, `"xy"`, `"residual"`, `"wild"`, `"mammen"`, +#' `"webb"`. See `?sandwich::vcovBS`. +#' - Other `sandwich` package functions: `"vcovHAC"`, `"vcovPC"`, `"vcovCL"`, +#' `"vcovPL"`. #' @param vcov_args List of arguments to be passed to the function identified by #' the `vcov` argument. This function is typically supplied by the **sandwich** #' or **clubSandwich** packages. Please refer to their documentation (e.g., @@ -46,18 +47,18 @@ #' standard errors. Depending on the model, may also include columns for model #' components etc. #' -#' @examples +#' @examplesIf require("sandwich") && require("clubSandwich") #' model <- lm(Petal.Length ~ Sepal.Length * Species, data = iris) #' standard_error(model) #' -#' if (require("sandwich") && require("clubSandwich")) { -#' standard_error(model, vcov = "HC3") +#' # robust standard errors +#' standard_error(model, vcov = "HC3") #' -#' standard_error(model, -#' vcov = "vcovCL", -#' vcov_args = list(cluster = iris$Species) -#' ) -#' } +#' # cluster-robust standard errors +#' standard_error(model, +#' vcov = "vcovCL", +#' vcov_args = list(cluster = iris$Species) +#' ) #' @export standard_error <- function(model, ...) { UseMethod("standard_error") @@ -81,6 +82,10 @@ standard_error.default <- function(model, dots <- list(...) se <- NULL + # if a vcov is provided, we calculate standard errors based on that matrix + # this is usually the case for HC (robust) standard errors + # ------------------------------------------------------------------------ + # vcov: matrix if (is.matrix(vcov)) { se <- sqrt(diag(vcov)) @@ -105,7 +110,9 @@ standard_error.default <- function(model, se <- sqrt(diag(.vcov)) } - # classical se from summary() + # classical SE from summary() + # ------------------------------------------------------------------------ + if (is.null(se)) { se <- .safe({ if (grepl("Zelig-", class(model)[1], fixed = TRUE)) { @@ -116,7 +123,10 @@ standard_error.default <- function(model, }) } - # classical se from get_varcov() + # if retrieving SE from summary() failed, we try to calculate SE based + # on classical se from get_varcov() + # ------------------------------------------------------------------------ + if (is.null(se)) { se <- .safe({ varcov <- insight::get_varcov(model, component = component) @@ -150,26 +160,27 @@ standard_error.default <- function(model, .get_se_from_summary <- function(model, component = NULL) { - cs <- suppressWarnings(stats::coef(summary(model))) + cs <- .safe(suppressWarnings(stats::coef(summary(model)))) se <- NULL - if (is.list(cs) && !is.null(component)) cs <- cs[[component]] - + if (is.list(cs) && !is.null(component)) { + cs <- cs[[component]] + } if (!is.null(cs)) { # do we have a se column? se_col <- which(colnames(cs) == "Std. Error") - # if not, default to 2 - if (length(se_col) == 0) se_col <- 2 - + if (length(se_col) == 0) { + se_col <- 2 + } se <- as.vector(cs[, se_col]) - if (is.null(names(se))) { coef_names <- rownames(cs) - if (length(coef_names) == length(se)) names(se) <- coef_names + if (length(coef_names) == length(se)) { + names(se) <- coef_names + } } } - names(se) <- .remove_backticks_from_string(names(se)) se } diff --git a/R/bootstrap_model.R b/R/bootstrap_model.R index 949bc415a..cdfc66109 100644 --- a/R/bootstrap_model.R +++ b/R/bootstrap_model.R @@ -178,7 +178,7 @@ bootstrap_model.merMod <- function(model, } else { params <- stats::setNames(params$Estimate, params$Parameter) # Transform to named vector } - return(params) + params } if (verbose) { @@ -244,9 +244,7 @@ bootstrap_model.nestedLogit <- function(model, } params <- insight::get_parameters(fit, verbose = FALSE) - params <- stats::setNames(params$Estimate, params$Parameter) # Transform to named vector - - return(params) + stats::setNames(params$Estimate, params$Parameter) # Transform to named vector } results <- boot::boot( diff --git a/R/bootstrap_parameters.R b/R/bootstrap_parameters.R index 474731c09..98c284ab7 100644 --- a/R/bootstrap_parameters.R +++ b/R/bootstrap_parameters.R @@ -9,6 +9,8 @@ #' or `"all"` to compute all tests. For each "test", the corresponding #' **bayestestR** function is called (e.g. [bayestestR::rope()] or #' [bayestestR::p_direction()]) and its results included in the summary output. +#' @param ... Arguments passed to other methods, like [`bootstrap_model()`] or +#' [`bayestestR::describe_posterior()`]. #' @inheritParams bootstrap_model #' @inheritParams bayestestR::describe_posterior #' @@ -40,6 +42,11 @@ #' b <- bootstrap_parameters(model) #' print(b) #' +#' # different type of bootstrapping +#' set.seed(2) +#' b <- bootstrap_parameters(model, type = "balanced") +#' print(b) +#' #' est <- emmeans::emmeans(b, trt.vs.ctrl ~ Species) #' print(model_parameters(est)) #' } diff --git a/R/ci_generic.R b/R/ci_generic.R index d026adc13..1bfad93e3 100644 --- a/R/ci_generic.R +++ b/R/ci_generic.R @@ -97,10 +97,14 @@ } method <- tolower(method) + # Fist, we want standard errors for parameters + # -------------------------------------------- + # if we have adjusted SE, e.g. from kenward-roger, don't recompute # standard errors to save time... if (is.null(se)) { if (!is.null(vcov) || isTRUE(list(...)[["robust"]])) { + # robust (HC) standard errors? stderror <- standard_error(model, component = component, vcov = vcov, @@ -109,6 +113,7 @@ ... ) } else { + # normal standard errors, including small-sample approximations stderror <- switch(method, kenward = se_kenward(model), kr = se_kenward(model), @@ -133,10 +138,13 @@ se <- stderror$SE } + # Next, we need degrees of freedom + # -------------------------------- + # check if we have a valid dof vector if (is.null(dof)) { # residual df - dof <- degrees_of_freedom(model, method = method, verbose = FALSE) + dof <- insight::get_df(x = model, type = method, verbose = FALSE) # make sure we have a value for degrees of freedom if (is.null(dof) || length(dof) == 0 || .is_chi2_model(model, dof)) { dof <- Inf @@ -146,7 +154,9 @@ } } - # calculate CIs + # Now we can calculate CIs + # ------------------------ + alpha <- (1 + ci) / 2 fac <- suppressWarnings(stats::qt(alpha, df = dof)) out <- cbind( @@ -171,7 +181,6 @@ } - .is_chi2_model <- function(model, dof) { statistic <- insight::find_statistic(model) (all(dof == 1) && identical(statistic, "chi-squared statistic")) diff --git a/R/compare_parameters.R b/R/compare_parameters.R index 05305e244..2f03e4576 100644 --- a/R/compare_parameters.R +++ b/R/compare_parameters.R @@ -310,3 +310,19 @@ compare_models <- compare_parameters x } + + +.is_bayesian_model <- function(x, exclude = NULL) { + bayes_classes <- c( + "brmsfit", "stanfit", "MCMCglmm", "stanreg", + "stanmvreg", "bmerMod", "BFBayesFactor", "bamlss", + "bayesx", "mcmc", "bcplm", "bayesQR", "BGGM", + "meta_random", "meta_fixed", "meta_bma", "blavaan", + "blrm", "blmerMod" + ) + # if exclude is not NULL, remove elements in exclude from bayes_class + if (!is.null(exclude)) { + bayes_classes <- bayes_classes[!bayes_classes %in% exclude] + } + inherits(x, bayes_classes) +} diff --git a/R/display.R b/R/display.R index 334854250..6b348bc9e 100644 --- a/R/display.R +++ b/R/display.R @@ -2,15 +2,13 @@ #' @name display.parameters_model #' #' @description Prints tables (i.e. data frame) in different output formats. -#' `print_md()` is a alias for `display(format = "markdown")`, `print_html()` -#' is a alias for `display(format = "html")`. `print_table()` is for specific +#' `print_md()` is an alias for `display(format = "markdown")`, `print_html()` +#' is an alias for `display(format = "html")`. `print_table()` is for specific #' use cases only, and currently only works for `compare_parameters()` objects. #' -#' @param x An object returned by [`model_parameters()`][model_parameters]. -#' @param object An object returned by [`model_parameters()`][model_parameters], -#' [`simulate_parameters()`][simulate_parameters], -#' [`equivalence_test()`][equivalence_test.lm] or -#' [`principal_components()`][principal_components]. +#' @param x An object returned by [`model_parameters()`]. +#' @param object An object returned by [`model_parameters()`],[`simulate_parameters()`], +#' [`equivalence_test()`] or [`principal_components()`]. #' @param format String, indicating the output format. Can be `"markdown"` #' or `"html"`. #' @param align Only applies to HTML tables. May be one of `"left"`, @@ -56,7 +54,7 @@ #' effects in the table. See 'Examples'. An alternative is to set `engine = "tt"` #' in `print_html()` to use the _tinytable_ package for creating HTML tables. #' -#' @seealso [print.parameters_model()] +#' @seealso [print.parameters_model()] and [print.compare_parameters()] #' #' @examplesIf require("gt", quietly = TRUE) #' model <- lm(mpg ~ wt + cyl, data = mtcars) diff --git a/R/dof.R b/R/dof.R index f0848eb2c..fb777adde 100644 --- a/R/dof.R +++ b/R/dof.R @@ -3,39 +3,32 @@ #' Estimate or extract degrees of freedom of models parameters. #' #' @param model A statistical model. -#' @param method Can be `"analytical"` (default, DoFs are estimated based -#' on the model type), `"residual"` in which case they are directly taken -#' from the model if available (for Bayesian models, the goal (looking for -#' help to make it happen) would be to refit the model as a frequentist one -#' before extracting the DoFs), `"ml1"` (see [dof_ml1()]), `"betwithin"` -#' (see [dof_betwithin()]), `"satterthwaite"` (see [`dof_satterthwaite()`]), -#' `"kenward"` (see [`dof_kenward()`]) or `"any"`, which tries to extract DoF -#' by any of those methods, whichever succeeds. See 'Details'. -#' @param ... Currently not used. -#' -#' @details -#' Methods for calculating degrees of freedom: +#' @param method Type of approximation for the degrees of freedom. Can be one of +#' the following: #' -#' - `"analytical"` for models of class `lmerMod`, Kenward-Roger approximated -#' degrees of freedoms are calculated, for other models, `n-k` (number of -#' observations minus number of parameters). -#' - `"residual"` tries to extract residual degrees of freedom, and returns -#' `Inf` if residual degrees of freedom could not be extracted. -#' - `"any"` first tries to extract residual degrees of freedom, and if these -#' are not available, extracts analytical degrees of freedom. -#' - `"nokr"` same as `"analytical"`, but does not Kenward-Roger approximation -#' for models of class `lmerMod`. Instead, always uses `n-k` to calculate df -#' for any model. -#' - `"normal"` returns `Inf`. -#' - `"wald"` returns residual df for models with t-statistic, and `Inf` for all other models. -#' - `"kenward"` calls [`dof_kenward()`]. -#' - `"satterthwaite"` calls [`dof_satterthwaite()`]. -#' - `"ml1"` calls [`dof_ml1()`]. -#' - `"betwithin"` calls [`dof_betwithin()`]. +#' + `"residual"` (aka `"analytical"`) returns the residual degrees of +#' freedom, which usually is what [`stats::df.residual()`] returns. If a +#' model object has no method to extract residual degrees of freedom, these +#' are calculated as `n-p`, i.e. the number of observations minus the number +#' of estimated parameters. If residual degrees of freedom cannot be extracted +#' by either approach, returns `Inf`. +#' + `"wald"` returns residual (aka analytical) degrees of freedom for models +#' with t-statistic, `1` for models with Chi-squared statistic, and `Inf` for +#' all other models. Also returns `Inf` if residual degrees of freedom cannot +#' be extracted. +#' + `"normal"` always returns `Inf`. +#' + `"model"` returns model-based degrees of freedom, i.e. the number of +#' (estimated) parameters. +#' + For mixed models, can also be `"ml1"` (or `"m-l-1"`, approximation of +#' degrees of freedom based on a "m-l-1" heuristic as suggested by _Elff et +#' al. 2019_) or `"between-within"` (or `"betwithin"`). +#' + For mixed models of class `merMod`, `type` can also be `"satterthwaite"` +#' or `"kenward-roger"` (or `"kenward"`). See 'Details'. #' -#' For models with z-statistic, the returned degrees of freedom for model parameters -#' is `Inf` (unless `method = "ml1"` or `method = "betwithin"`), because there is -#' only one distribution for the related test statistic. +#' Usually, when degrees of freedom are required to calculate p-values or +#' confidence intervals, `type = "wald"` is likely to be the best choice in +#' most cases. +#' @param ... Currently not used. #' #' @note #' In many cases, `degrees_of_freedom()` returns the same as `df.residuals()`, @@ -47,17 +40,15 @@ #' `"satterthwaite"`, each model parameter can have a different degree of #' freedom. #' -#' @examples +#' @examplesIf require("lme4", quietly = TRUE) #' model <- lm(Sepal.Length ~ Petal.Length * Species, data = iris) #' dof(model) #' #' model <- glm(vs ~ mpg * cyl, data = mtcars, family = "binomial") #' dof(model) #' \donttest{ -#' if (require("lme4", quietly = TRUE)) { -#' model <- lmer(Sepal.Length ~ Petal.Length + (1 | Species), data = iris) -#' dof(model) -#' } +#' model <- lmer(Sepal.Length ~ Petal.Length + (1 | Species), data = iris) +#' dof(model) #' #' if (require("rstanarm", quietly = TRUE)) { #' model <- stan_glm( @@ -70,84 +61,8 @@ #' } #' } #' @export -degrees_of_freedom <- function(model, ...) { - UseMethod("degrees_of_freedom") -} - - - - -#' @rdname degrees_of_freedom -#' @export -degrees_of_freedom.default <- function(model, method = "analytical", ...) { - # check for valid input - .is_model_valid(model) - - if (is.null(method)) { - method <- "wald" - } - method <- tolower(method) - - method <- match.arg(method, choices = c( - "analytical", "any", "fit", "ml1", "betwithin", "satterthwaite", "kenward", - "nokr", "wald", "kr", "profile", "boot", "uniroot", "residual", "normal", - "likelihood" - )) - - if (!.dof_method_ok(model, method, ...) || method %in% c("profile", "likelihood", "boot", "uniroot")) { - method <- "any" - } - - stat <- insight::find_statistic(model) - - # for z-statistic, always return Inf - if (!is.null(stat) && stat == "z-statistic" && !(method %in% c("ml1", "betwithin"))) { - if (method == "residual") { - return(.degrees_of_freedom_residual(model, verbose = FALSE)) - } else { - return(Inf) - } - } - - # Chi2-distributions usually have 1 df - if (!is.null(stat) && stat == "chi-squared statistic") { - if (method == "residual") { - return(.degrees_of_freedom_residual(model, verbose = FALSE)) - } else { - return(1) - } - } - - if (method == "any") { # nolint - dof <- .degrees_of_freedom_residual(model, verbose = FALSE) - if (is.null(dof) || all(is.infinite(dof)) || anyNA(dof)) { - dof <- .degrees_of_freedom_analytical(model, kenward = FALSE) - } - } else if (method == "ml1") { - dof <- dof_ml1(model) - } else if (method == "wald") { - dof <- .degrees_of_freedom_residual(model, verbose = FALSE) - } else if (method == "normal") { - dof <- Inf - } else if (method == "satterthwaite") { - dof <- dof_satterthwaite(model) - } else if (method == "betwithin") { - dof <- dof_betwithin(model) - } else if (method %in% c("kenward", "kr")) { - dof <- dof_kenward(model) - } else if (method == "analytical") { - dof <- .degrees_of_freedom_analytical(model, kenward = TRUE) - } else if (method == "nokr") { - dof <- .degrees_of_freedom_analytical(model, kenward = FALSE) - } else { - dof <- .degrees_of_freedom_residual(model) - } - - if (!is.null(dof) && length(dof) > 0 && all(dof == 0)) { - insight::format_warning("Model has zero degrees of freedom!") - } - - dof +degrees_of_freedom <- function(model, method = "analytical", ...) { + insight::get_df(x = model, type = method, ...) } #' @rdname degrees_of_freedom @@ -155,110 +70,6 @@ degrees_of_freedom.default <- function(model, method = "analytical", ...) { dof <- degrees_of_freedom - - - -# Analytical approach ------------------------------ - - -#' @keywords internal -.degrees_of_freedom_analytical <- function(model, kenward = TRUE) { - nparam <- n_parameters(model) - n <- insight::n_obs(model) - - if (is.null(n)) { - n <- Inf - } - - if (isTRUE(kenward) && inherits(model, "lmerMod")) { - dof <- as.numeric(dof_kenward(model)) - } else { - dof <- rep(n - nparam, nparam) - } - - dof -} - - - - - -# Model approach (Residual df) ------------------------------ - - -#' @keywords internal -.degrees_of_freedom_residual <- function(model, verbose = TRUE) { - if (.is_bayesian_model(model, exclude = c("bmerMod", "bayesx", "blmerMod", "bglmerMod"))) { - model <- bayestestR::bayesian_as_frequentist(model) - } - - # 1st try - dof <- try(stats::df.residual(model), silent = TRUE) - - # 2nd try - if (inherits(dof, "try-error") || is.null(dof) || all(is.na(dof))) { - junk <- utils::capture.output(dof = try(summary(model)$df[2], silent = TRUE)) - } - - # 3rd try, nlme - if (inherits(dof, "try-error") || is.null(dof) || all(is.na(dof))) { - dof <- try(unname(model$fixDF$X), silent = TRUE) - } - - # last try - if (inherits(dof, "try-error") || is.null(dof) || all(is.na(dof))) { - dof <- Inf - if (verbose) { - insight::format_alert("Could not extract degrees of freedom.") - } - } - - - # special cases - # if (inherits(model, "gam")) { - # dof <- .dof_fit_gam(model, dof) - # } - - dof -} - - - - -# residual df - for models with residual df, but no "df.residual()" method -------------- - - -#' @keywords internal -.degrees_of_freedom_no_dfresid_method <- function(model, method = NULL) { - if (identical(method, "normal")) { - return(Inf) - } else if (!is.null(method) && method %in% c("ml1", "satterthwaite", "betwithin")) { - degrees_of_freedom.default(model, method = method) - } else { - .degrees_of_freedom_analytical(model, kenward = FALSE) - } -} - - - - - - -# helper -------------- - -.dof_fit_gam <- function(model, dof) { - params <- insight::find_parameters(model) - if (!is.null(params$conditional)) { - dof <- rep(dof, length(params$conditional)) - } - if (!is.null(params$smooth_terms)) { - s <- summary(model) - dof <- c(dof, s$s.table[, "Ref.df"]) - } - dof -} - - # Helper, check args ------------------------------ .dof_method_ok <- function(model, method, type = "df_method", verbose = TRUE, ...) { @@ -329,23 +140,3 @@ dof <- degrees_of_freedom return(TRUE) } - - - - -# helper - -.is_bayesian_model <- function(x, exclude = NULL) { - bayes_classes <- c( - "brmsfit", "stanfit", "MCMCglmm", "stanreg", - "stanmvreg", "bmerMod", "BFBayesFactor", "bamlss", - "bayesx", "mcmc", "bcplm", "bayesQR", "BGGM", - "meta_random", "meta_fixed", "meta_bma", "blavaan", - "blrm", "blmerMod" - ) - # if exclude is not NULL, remove elements in exclude from bayes_class - if (!is.null(exclude)) { - bayes_classes <- bayes_classes[!bayes_classes %in% exclude] - } - inherits(x, bayes_classes) -} diff --git a/R/dof_kenward.R b/R/dof_kenward.R index aa9f00c59..4d8976ace 100644 --- a/R/dof_kenward.R +++ b/R/dof_kenward.R @@ -263,7 +263,7 @@ dof_kenward <- function(model) { Gp <- lme4::getME(model, "Gp") n.RT <- length(Gp) - 1 ## Number of random terms (i.e. of (|)'s) - n.lev.by.RT <- sapply(lme4::getME(model, "flist"), function(x) length(levels(x))) + n.lev.by.RT <- sapply(lme4::getME(model, "flist"), nlevels) n.comp.by.RT <- .get.RT.dim.by.RT(model) n.parm.by.RT <- (n.comp.by.RT + 1) * n.comp.by.RT / 2 n.RE.by.RT <- diff(Gp) diff --git a/R/equivalence_test.R b/R/equivalence_test.R index 6f26f60b0..8247de837 100644 --- a/R/equivalence_test.R +++ b/R/equivalence_test.R @@ -10,35 +10,34 @@ bayestestR::equivalence_test #' #' @param x A statistical model. #' @param range The range of practical equivalence of an effect. May be -#' `"default"`, to automatically define this range based on properties of the -#' model's data. +#' `"default"`, to automatically define this range based on properties of the +#' model's data. #' @param ci Confidence Interval (CI) level. Default to `0.95` (`95%`). #' @param rule Character, indicating the rules when testing for practical -#' equivalence. Can be `"bayes"`, `"classic"` or `"cet"`. See -#' 'Details'. +#' equivalence. Can be `"bayes"`, `"classic"` or `"cet"`. See 'Details'. #' @param test Hypothesis test for computing contrasts or pairwise comparisons. -#' See [`?ggeffects::test_predictions`](https://strengejacke.github.io/ggeffects/reference/test_predictions.html) -#' for details. +#' See [`?ggeffects::test_predictions`](https://strengejacke.github.io/ggeffects/reference/test_predictions.html) +#' for details. #' @param verbose Toggle warnings and messages. #' @param ... Arguments passed to or from other methods. #' @inheritParams model_parameters.merMod #' @inheritParams p_value #' -#' @seealso For more details, see [bayestestR::equivalence_test()]. -#' Further readings can be found in the references. +#' @seealso For more details, see [bayestestR::equivalence_test()]. Further +#' readings can be found in the references. See also [`p_significance()`] for +#' a unidirectional equivalence test. #' -#' @details -#' In classical null hypothesis significance testing (NHST) within a frequentist -#' framework, it is not possible to accept the null hypothesis, H0 - unlike -#' in Bayesian statistics, where such probability statements are possible. -#' "[...] one can only reject the null hypothesis if the test +#' @details In classical null hypothesis significance testing (NHST) within a +#' frequentist framework, it is not possible to accept the null hypothesis, H0 - +#' unlike in Bayesian statistics, where such probability statements are +#' possible. "[...] one can only reject the null hypothesis if the test #' statistics falls into the critical region(s), or fail to reject this #' hypothesis. In the latter case, all we can say is that no significant effect #' was observed, but one cannot conclude that the null hypothesis is true." -#' (_Pernet 2017_). One way to address this issues without Bayesian methods -#' is *Equivalence Testing*, as implemented in `equivalence_test()`. -#' While you either can reject the null hypothesis or claim an inconclusive result -#' in NHST, the equivalence test - according to _Pernet_ - adds a third category, +#' (_Pernet 2017_). One way to address this issues without Bayesian methods is +#' *Equivalence Testing*, as implemented in `equivalence_test()`. While you +#' either can reject the null hypothesis or claim an inconclusive result in +#' NHST, the equivalence test - according to _Pernet_ - adds a third category, #' *"accept"*. Roughly speaking, the idea behind equivalence testing in a #' frequentist framework is to check whether an estimate and its uncertainty #' (i.e. confidence interval) falls within a region of "practical equivalence". @@ -62,14 +61,17 @@ bayestestR::equivalence_test #' - "classic" - The TOST rule (Lakens 2017) #' #' This rule follows the "TOST rule", i.e. a two one-sided test procedure -#' (_Lakens 2017_). Following this rule, practical equivalence of an effect -#' (i.e. H0) is *rejected*, when the coefficient is statistically significant -#' *and* the narrow confidence intervals (i.e. `1-2*alpha`) *include* or -#' *exceed* the ROPE boundaries. Practical equivalence is assumed -#' (i.e. H0 "accepted") when the narrow confidence intervals are completely -#' inside the ROPE, no matter if the effect is statistically significant -#' or not. Else, the decision whether to accept or reject practical -#' equivalence is undecided. +#' (_Lakens 2017_). Following this rule... +#' - practical equivalence is assumed (i.e. H0 *"accepted"*) when the narrow +#' confidence intervals are completely inside the ROPE, no matter if the +#' effect is statistically significant or not; +#' - practical equivalence (i.e. H0) is *rejected*, when the coefficient is +#' statistically significant, both when the narrow confidence intervals +#' (i.e. `1-2*alpha`) include or exclude the the ROPE boundaries, but the +#' narrow confidence intervals are *not fully covered* by the ROPE; +#' - else the decision whether to accept or reject practical equivalence is +#' undecided (i.e. when effects are *not* statistically significant *and* +#' the narrow confidence intervals overlaps the ROPE). #' #' - "cet" - Conditional Equivalence Testing (Campbell/Gustafson 2018) #' @@ -91,63 +93,141 @@ bayestestR::equivalence_test #' ## p-Values #' The equivalence p-value is the area of the (cumulative) confidence #' distribution that is outside of the region of equivalence. It can be -#' interpreted as p-value for *rejecting* the alternative hypothesis -#' and *accepting* the "null hypothesis" (i.e. assuming practical -#' equivalence). That is, a high p-value means we reject the assumption of -#' practical equivalence and accept the alternative hypothesis. +#' interpreted as p-value for *rejecting* the alternative hypothesis and +#' *accepting* the "null hypothesis" (i.e. assuming practical equivalence). That +#' is, a high p-value means we reject the assumption of practical equivalence +#' and accept the alternative hypothesis. #' #' ## Second Generation p-Value (SGPV) #' Second generation p-values (SGPV) were proposed as a statistic that #' represents _the proportion of data-supported hypotheses that are also null #' hypotheses_ _(Blume et al. 2018, Lakens and Delacre 2020)_. It represents the -#' proportion of the confidence interval range that is inside the ROPE. +#' proportion of the _full_ confidence interval range (assuming a normally or +#' t-distributed, equal-tailed interval, based on the model) that is inside the +#' ROPE. The SGPV ranges from zero to one. Higher values indicate that the +#' effect is more likely to be practically equivalent ("not of interest"). +#' +#' Note that the assumed interval, which is used to calculate the SGPV, is an +#' estimation of the _full interval_ based on the chosen confidence level. For +#' example, if the 95% confidence interval of a coefficient ranges from -1 to 1, +#' the underlying _full (normally or t-distributed) interval_ approximately +#' ranges from -1.9 to 1.9, see also following code: +#' +#' ``` +#' # simulate full normal distribution +#' out <- bayestestR::distribution_normal(10000, 0, 0.5) +#' # range of "full" distribution +#' range(out) +#' # range of 95% CI +#' round(quantile(out, probs = c(0.025, 0.975)), 2) +#' ``` +#' +#' This ensures that the SGPV always refers to the general compatible parameter +#' space of coefficients, independent from the confidence interval chosen for +#' testing practical equivalence. Therefore, the SGPV of the _full interval_ is +#' similar to the ROPE coverage of Bayesian equivalence tests, see following +#' code: +#' +#' ``` +#' library(bayestestR) +#' library(brms) +#' m <- lm(mpg ~ gear + wt + cyl + hp, data = mtcars) +#' m2 <- brm(mpg ~ gear + wt + cyl + hp, data = mtcars) +#' # SGPV for frequentist models +#' equivalence_test(m) +#' # similar to ROPE coverage of Bayesian models +#' equivalence_test(m2) +#' # similar to ROPE coverage of simulated draws / bootstrap samples +#' equivalence_test(simulate_model(m)) +#' ``` #' #' ## ROPE range #' Some attention is required for finding suitable values for the ROPE limits #' (argument `range`). See 'Details' in [bayestestR::rope_range()] #' for further information. #' +#' @inheritSection model_parameters Statistical inference - how to quantify evidence +#' #' @note There is also a [`plot()`-method](https://easystats.github.io/see/articles/parameters.html) #' implemented in the [**see**-package](https://easystats.github.io/see/). #' #' @references #' +#' - Amrhein, V., Korner-Nievergelt, F., and Roth, T. (2017). The earth is +#' flat (p > 0.05): Significance thresholds and the crisis of unreplicable +#' research. PeerJ, 5, e3544. \doi{10.7717/peerj.3544} +#' #' - Blume, J. D., D'Agostino McGowan, L., Dupont, W. D., & Greevy, R. A. -#' (2018). Second-generation p-values: Improved rigor, reproducibility, & -#' transparency in statistical analyses. PLOS ONE, 13(3), e0188299. -#' https://doi.org/10.1371/journal.pone.0188299 +#' (2018). Second-generation p-values: Improved rigor, reproducibility, & +#' transparency in statistical analyses. PLOS ONE, 13(3), e0188299. +#' https://doi.org/10.1371/journal.pone.0188299 #' #' - Campbell, H., & Gustafson, P. (2018). Conditional equivalence -#' testing: An alternative remedy for publication bias. PLOS ONE, 13(4), -#' e0195145. doi: 10.1371/journal.pone.0195145 +#' testing: An alternative remedy for publication bias. PLOS ONE, 13(4), +#' e0195145. doi: 10.1371/journal.pone.0195145 +#' +#' - Greenland S, Rafi Z, Matthews R, Higgs M. To Aid Scientific Inference, +#' Emphasize Unconditional Compatibility Descriptions of Statistics. (2022) +#' https://arxiv.org/abs/1909.08583v7 (Accessed November 10, 2022) #' #' - Kruschke, J. K. (2014). Doing Bayesian data analysis: A tutorial with -#' R, JAGS, and Stan. Academic Press +#' R, JAGS, and Stan. Academic Press #' #' - Kruschke, J. K. (2018). Rejecting or accepting parameter values in -#' Bayesian estimation. Advances in Methods and Practices in Psychological -#' Science, 1(2), 270-280. doi: 10.1177/2515245918771304 +#' Bayesian estimation. Advances in Methods and Practices in Psychological +#' Science, 1(2), 270-280. doi: 10.1177/2515245918771304 #' #' - Lakens, D. (2017). Equivalence Tests: A Practical Primer for t Tests, -#' Correlations, and Meta-Analyses. Social Psychological and Personality -#' Science, 8(4), 355–362. doi: 10.1177/1948550617697177 +#' Correlations, and Meta-Analyses. Social Psychological and Personality +#' Science, 8(4), 355–362. doi: 10.1177/1948550617697177 +#' +#' - Lakens, D. (2024). Improving Your Statistical Inferences (Version v1.5.1). +#' Retrieved from https://lakens.github.io/statistical_inferences/. +#' \doi{10.5281/ZENODO.6409077} #' -#' - Lakens, D., & Delacre, M. (2020). Equivalence Testing and the Second -#' Generation P-Value. Meta-Psychology, 4. -#' https://doi.org/10.15626/MP.2018.933 +#' - Lakens, D., and Delacre, M. (2020). Equivalence Testing and the Second +#' Generation P-Value. Meta-Psychology, 4. +#' https://doi.org/10.15626/MP.2018.933 +#' +#' - Lakens, D., Scheel, A. M., and Isager, P. M. (2018). Equivalence Testing +#' for Psychological Research: A Tutorial. Advances in Methods and Practices +#' in Psychological Science, 1(2), 259–269. \doi{10.1177/2515245918770963} +#' +#' - Makowski, D., Ben-Shachar, M. S., Chen, S. H. A., and Lüdecke, D. (2019). +#' Indices of Effect Existence and Significance in the Bayesian Framework. +#' Frontiers in Psychology, 10, 2767. \doi{10.3389/fpsyg.2019.02767} #' #' - Pernet, C. (2017). Null hypothesis significance testing: A guide to -#' commonly misunderstood concepts and recommendations for good practice. -#' F1000Research, 4, 621. doi: 10.12688/f1000research.6963.5 +#' commonly misunderstood concepts and recommendations for good practice. +#' F1000Research, 4, 621. doi: 10.12688/f1000research.6963.5 +#' +#' - Rafi Z, Greenland S. Semantic and cognitive tools to aid statistical +#' science: replace confidence and significance by compatibility and surprise. +#' BMC Medical Research Methodology (2020) 20:244. +#' +#' - Schweder T. Confidence is epistemic probability for empirical science. +#' Journal of Statistical Planning and Inference (2018) 195:116–125. +#' \doi{10.1016/j.jspi.2017.09.016} +#' +#' - Schweder T, Hjort NL. Frequentist analogues of priors and posteriors. +#' In Stigum, B. (ed.), Econometrics and the Philosophy of Economics: Theory +#' Data Confrontation in Economics, pp. 285-217. Princeton University Press, +#' Princeton, NJ, 2003 +#' +#' - Vos P, Holbert D. Frequentist statistical inference without repeated sampling. +#' Synthese 200, 89 (2022). \doi{10.1007/s11229-022-03560-x} #' #' @return A data frame. -#' @examples +#' @examplesIf requireNamespace("sandwich") #' data(qol_cancer) #' model <- lm(QoL ~ time + age + education, data = qol_cancer) #' #' # default rule #' equivalence_test(model) #' +#' # using heteroscedasticity-robust standard errors +#' equivalence_test(model, vcov = "HC3") +#' #' # conditional equivalence test #' equivalence_test(model, rule = "cet") #' @@ -161,10 +241,21 @@ equivalence_test.lm <- function(x, range = "default", ci = 0.95, rule = "classic", + vcov = NULL, + vcov_args = NULL, verbose = TRUE, ...) { rule <- match.arg(tolower(rule), choices = c("bayes", "classic", "cet")) - out <- .equivalence_test_frequentist(x, range, ci, rule, verbose, ...) + out <- .equivalence_test_frequentist( + x, + range = range, + ci = ci, + rule = rule, + vcov = vcov, + vcov_args = vcov_args, + verbose, + ... + ) if (is.null(attr(out, "pretty_names", exact = TRUE))) { attr(out, "pretty_names") <- format_parameters(x) @@ -225,6 +316,8 @@ equivalence_test.merMod <- function(x, ci = 0.95, rule = "classic", effects = c("fixed", "random"), + vcov = NULL, + vcov_args = NULL, verbose = TRUE, ...) { # ==== argument matching ==== @@ -236,7 +329,16 @@ equivalence_test.merMod <- function(x, # ==== equivalent testing for fixed or random effects ==== if (effects == "fixed") { - out <- .equivalence_test_frequentist(x, range, ci, rule, verbose, ...) + out <- .equivalence_test_frequentist( + x, + range = range, + ci = ci, + rule = rule, + vcov = vcov, + vcov_args = vcov_args, + verbose, + ... + ) } else { out <- .equivalence_test_frequentist_random(x, range, ci, rule, verbose, ...) } @@ -297,6 +399,18 @@ equivalence_test.parameters_simulate_model <- function(x, } +#' @export +equivalence_test.parameters_model <- function(x, + range = "default", + ci = 0.95, + rule = "classic", + verbose = TRUE, + ...) { + model <- .get_object(x) + equivalence_test(x = model, range = range, ci = ci, rule = rule, verbose = verbose, ...) +} + + #' @rdname equivalence_test.lm #' @export equivalence_test.ggeffects <- function(x, @@ -311,6 +425,7 @@ equivalence_test.ggeffects <- function(x, focal <- attributes(x)$original.terms obj_name <- attributes(x)$model.name ci <- attributes(x)$ci.lvl + dof <- attributes(x)$df x <- .get_ggeffects_model(x) @@ -335,10 +450,12 @@ equivalence_test.ggeffects <- function(x, l <- Map( function(ci_wide, ci_narrow) { .equivalence_test_numeric( + ci = ci, ci_wide, ci_narrow, range_rope = range, rule = rule, + dof = dof, verbose = verbose ) }, conf_int, conf_int2 @@ -398,6 +515,8 @@ equivalence_test.ggeffects <- function(x, range = "default", ci = 0.95, rule = "classic", + vcov = NULL, + vcov_args = NULL, verbose = TRUE, ...) { # ==== define rope range ==== @@ -410,16 +529,28 @@ equivalence_test.ggeffects <- function(x, } + # ==== check degrees of freedom ==== + + df_column <- grep("(df|df_error)", colnames(x)) + if (length(df_column) > 0) { + dof <- unique(x[[df_column]]) + if (length(dof) > 1) { + dof <- Inf + } + } else { + dof <- Inf + } + # ==== requested confidence intervals ==== - params <- conf_int <- .ci_generic(x, ci = ci) + params <- conf_int <- .ci_generic(x, ci = ci, vcov = vcov, vcov_args = vcov_args, ...) conf_int <- as.data.frame(t(conf_int[, c("CI_low", "CI_high")])) # ==== the "narrower" intervals (1-2*alpha) for CET-rules. ==== alpha <- 1 - ci - conf_int2 <- .ci_generic(x, ci = (ci - alpha)) + conf_int2 <- .ci_generic(x, ci = (ci - alpha), vcov = vcov, vcov_args = vcov_args, ...) conf_int2 <- as.data.frame(t(conf_int2[, c("CI_low", "CI_high")])) @@ -428,11 +559,12 @@ equivalence_test.ggeffects <- function(x, l <- Map( function(ci_wide, ci_narrow) { .equivalence_test_numeric( + ci = ci, ci_wide, ci_narrow, range_rope = range, rule = rule, - ci = ci, + dof = dof, verbose = verbose ) }, conf_int, conf_int2 @@ -451,7 +583,7 @@ equivalence_test.ggeffects <- function(x, # ==== (adjusted) p-values for tests ==== - out$p <- .add_p_to_equitest(x, ci, range) + out$p <- .add_p_to_equitest(x, ci, range, vcov = vcov, vcov_args = vcov_args, ...) attr(out, "rope") <- range out @@ -493,7 +625,7 @@ equivalence_test.ggeffects <- function(x, out <- do.call(rbind, lapply(names(params), function(np) { est <- params[[np]][, "(Intercept)"] - stderr <- se[[np]][, "(Intercept)"] + std_err <- se[[np]][, "(Intercept)"] d <- data.frame( Parameter = rownames(params[[np]]), @@ -504,23 +636,23 @@ equivalence_test.ggeffects <- function(x, ) conf_int <- as.data.frame(t(data.frame( - CI_low = est - stderr * fac, - CI_high = est + stderr * fac + CI_low = est - std_err * fac, + CI_high = est + std_err * fac ))) conf_int2 <- as.data.frame(t(data.frame( - CI_low = est - stderr * fac_narrow, - CI_high = est + stderr * fac_narrow + CI_low = est - std_err * fac_narrow, + CI_high = est + std_err * fac_narrow ))) l <- Map( function(ci_wide, ci_narrow) { .equivalence_test_numeric( + ci = ci, ci_wide, ci_narrow, range_rope = range, rule = rule, - ci = ci, verbose = verbose ) }, conf_int, conf_int2 @@ -538,7 +670,13 @@ equivalence_test.ggeffects <- function(x, #' @keywords internal -.equivalence_test_numeric <- function(ci_wide, ci_narrow, range_rope, rule, ci = 0.95, verbose) { +.equivalence_test_numeric <- function(ci = 0.95, + ci_wide, + ci_narrow, + range_rope, + rule, + dof = Inf, + verbose) { final_ci <- NULL # ==== HDI+ROPE decision rule, by Kruschke ==== @@ -559,22 +697,14 @@ equivalence_test.ggeffects <- function(x, if (rule == "classic") { final_ci <- ci_narrow - # significant result? - if (min(ci_narrow) > 0 || max(ci_narrow) < 0) { - # check if CI are entirely inside ROPE. If CI crosses ROPE, reject H0, else accept - if (min(abs(ci_narrow)) < max(abs(range_rope)) && max(abs(ci_narrow)) < max(abs(range_rope))) { - decision <- "Accepted" - } else { - decision <- "Rejected" - } - # non-significant results + if (all(ci_narrow < max(range_rope)) && all(ci_narrow > min(range_rope))) { + # narrow CI is fully inside ROPE - always accept + decision <- "Accepted" + } else if (min(ci_narrow) < 0 && max(ci_narrow) > 0) { + # non-significant results - undecided + decision <- "Undecided" } else { - # check if CI are entirely inside ROPE. If CI crosses ROPE, reject H0, else accept - if (min(abs(ci_narrow)) < max(abs(range_rope)) && max(abs(ci_narrow)) < max(abs(range_rope))) { - decision <- "Accepted" - } else { - decision <- "Undecided" - } + decision <- "Rejected" } } @@ -587,7 +717,7 @@ equivalence_test.ggeffects <- function(x, if (min(ci_wide) > 0 || max(ci_wide) < 0) { decision <- "Rejected" # non-significant results, all narrow CI inside ROPE - } else if (min(abs(ci_narrow)) < max(abs(range_rope)) && max(abs(ci_narrow)) < max(abs(range_rope))) { + } else if (all(ci_narrow < max(range_rope)) && all(ci_narrow > min(range_rope))) { decision <- "Accepted" } else { decision <- "Undecided" @@ -597,10 +727,9 @@ equivalence_test.ggeffects <- function(x, data.frame( CI_low = final_ci[1], CI_high = final_ci[2], - SGPV = .sgpv(range_rope, final_ci), + SGPV = .rope_coverage(ci = ci, range_rope, ci_range = final_ci, dof = dof), ROPE_low = range_rope[1], ROPE_high = range_rope[2], - # ROPE_Percentage = .rope_coverage(range_rope, final_ci), ROPE_Equivalence = decision, stringsAsFactors = FALSE ) @@ -611,31 +740,34 @@ equivalence_test.ggeffects <- function(x, # helper --------------------- - -.sgpv <- function(rope, ci) { - diff_rope <- abs(diff(rope)) +# this function simply takes the length of the range and calculates the proportion +# of that range that is inside the rope. However, this assumed a "flat", i.e. +# uniformly distributed interval, which is not accurate for standard confidence +# intervals. thus, we no longer use this function, but switch to ".rope_coverage()". +.sgpv <- function(range_rope, ci) { + diff_rope <- abs(diff(range_rope)) diff_ci <- abs(diff(ci)) # inside? - if (min(ci) >= min(rope) && max(ci) <= max(rope)) { + if (min(ci) >= min(range_rope) && max(ci) <= max(range_rope)) { coverage <- 1 # outside? - } else if (max(ci) < min(rope) || min(ci) > max(rope)) { + } else if (max(ci) < min(range_rope) || min(ci) > max(range_rope)) { coverage <- 0 # CI covers completely rope? - } else if (max(ci) > max(rope) && min(ci) < min(rope)) { + } else if (max(ci) > max(range_rope) && min(ci) < min(range_rope)) { coverage <- diff_rope / diff_ci # CI inside rope and outside max rope? - } else if (min(ci) >= min(rope) && max(ci) > max(rope)) { - diff_in_rope <- max(rope) - min(ci) + } else if (min(ci) >= min(range_rope) && max(ci) > max(range_rope)) { + diff_in_rope <- max(range_rope) - min(ci) coverage <- diff_in_rope / diff_ci # CI inside rope and outside min rope? - } else if (max(ci) <= max(rope) && min(ci) < min(rope)) { - diff_in_rope <- max(ci) - min(rope) + } else if (max(ci) <= max(range_rope) && min(ci) < min(range_rope)) { + diff_in_rope <- max(ci) - min(range_rope) coverage <- diff_in_rope / diff_ci } @@ -643,36 +775,72 @@ equivalence_test.ggeffects <- function(x, } -## FIXME make sure this works for different CI levels -.rope_coverage <- function(rope, ci_range, ci) { - diff_ci <- abs(diff(ci_range)) - out <- bayestestR::distribution_normal( - n = 1000, - mean = ci_range[2] - (diff_ci / 2), - sd = diff_ci / 3.28 - ) - - rc <- bayestestR::rope(out, range = rope, ci = ci) +# this function simulates a normal distribution, which approximately has the +# same range / limits as the confidence interval, thus indeed representing a +# normally distributed confidence interval. We then calculate the probability +# mass of this interval that is inside the ROPE. +.rope_coverage <- function(ci = 0.95, range_rope, ci_range, dof = Inf) { + out <- .generate_posterior_from_ci(ci, ci_range, dof = dof) + # compare: ci_range and range(out) + # The SGPV refers to the proportion of the confidence interval inside the + # full ROPE - thus, we set ci = 1 here + rc <- bayestestR::rope(out, range = range_rope, ci = 1) rc$ROPE_Percentage } -.add_p_to_equitest <- function(model, ci, range) { +.generate_posterior_from_ci <- function(ci = 0.95, ci_range, dof = Inf, precision = 10000) { + # this function creates an approximate normal distribution that covers the + # CI-range, i.e. we "simulate" a posterior distribution from a frequentist CI + + # sanity check - dof argument + if (is.null(dof)) { + dof <- Inf + } + # first we need the range of the CI (in units), also to calculate the mean of + # the normal distribution + diff_ci <- abs(diff(ci_range)) + mean_dist <- ci_range[2] - (diff_ci / 2) + # then we need the critical values of the quantiles from the CI range + z_value <- stats::qt((1 + ci) / 2, df = dof) + # the range of Z-scores (from lower to upper quantile) gives us the range of + # the provided interval in terms of standard deviations. now we divide the + # known range of the provided CI (in units) by the z-score-range, which will + # give us the standard deviation of the distribution. + sd_dist <- diff_ci / diff(c(-1 * z_value, z_value)) + # generate normal-distribution if we don't have t-distribution, or if + # we don't have necessary packages installed + if (is.infinite(dof) || !insight::check_if_installed("distributional", quietly = TRUE)) { + # tell user to install "distributional" + if (!is.infinite(dof)) { + insight::format_alert("For models with only few degrees of freedom, install the {distributional} package to increase accuracy of `p_direction()`, `p_significance()` and `equivalence_test()`.") # nolint + } + # we now know all parameters (mean and sd) to simulate a normal distribution + bayestestR::distribution_normal(n = precision, mean = mean_dist, sd = sd_dist) + } else { + insight::check_if_installed("distributional") + out <- distributional::dist_student_t(df = dof, mu = mean_dist, sigma = sd_dist) + sort(unlist(distributional::generate(out, times = precision), use.names = FALSE)) + } +} + + +.add_p_to_equitest <- function(model, ci, range, vcov = NULL, vcov_args = NULL, ...) { tryCatch( { params <- insight::get_parameters(model) # degrees of freedom - df <- degrees_of_freedom(model, method = "any") + dof <- insight::get_df(x = model, type = "wald") # mu params$mu <- params$Estimate * -1 # se - se <- standard_error(model) + se <- standard_error(model, vcov = vcov, vcov_args = vcov_args, ...) - stats::pt((range[1] - params$mu) / se$SE, df, lower.tail = TRUE) + - stats::pt((range[2] - params$mu) / se$SE, df, lower.tail = FALSE) + stats::pt((range[1] - params$mu) / se$SE, df = dof, lower.tail = TRUE) + + stats::pt((range[2] - params$mu) / se$SE, df = dof, lower.tail = FALSE) }, error = function(e) { NULL @@ -743,14 +911,12 @@ print.equivalence_test_lm <- function(x, orig_x <- x rule <- attributes(x)$rule - if (!is.null(rule)) { - if (rule == "cet") { - insight::print_color("# Conditional Equivalence Testing\n\n", "blue") - } else if (rule == "classic") { - insight::print_color("# TOST-test for Practical Equivalence\n\n", "blue") - } else { - insight::print_color("# Test for Practical Equivalence\n\n", "blue") - } + if (is.null(rule)) { + insight::print_color("# Test for Practical Equivalence\n\n", "blue") + } else if (rule == "cet") { + insight::print_color("# Conditional Equivalence Testing\n\n", "blue") + } else if (rule == "classic") { + insight::print_color("# TOST-test for Practical Equivalence\n\n", "blue") } else { insight::print_color("# Test for Practical Equivalence\n\n", "blue") } @@ -788,55 +954,3 @@ plot.equivalence_test_lm <- function(x, ...) { insight::check_if_installed("see") NextMethod() } -#' -#' -#' #' @export -#' print_md.equivalence_test_lm <- function(x, -#' digits = 2, -#' ci_digits = digits, -#' p_digits = 3, -#' ci_brackets = NULL, -#' zap_small = FALSE, -#' ...) { -#' orig_x <- x -#' -#' rule <- attributes(x)$rule -#' if (!is.null(rule)) { -#' if (rule == "cet") { -#' title <- "Conditional Equivalence Testing" -#' } else if (rule == "classic") { -#' title <- "TOST-test for Practical Equivalence" -#' } else { -#' title <- "Test for Practical Equivalence" -#' } -#' } else { -#' title <- "Test for Practical Equivalence" -#' } -#' -#' .rope <- attr(x, "rope", exact = TRUE) -#' subtitle <- sprintf(" ROPE: [%.*f %.*f]\n\n", digits, .rope[1], digits, .rope[2]) -#' -#' # formatting -#' x <- format(x, -#' digits = digits, -#' ci_digits = ci_digits, -#' p_digits = p_digits, -#' ci_width = NULL, -#' ci_brackets = ci_brackets, -#' format = "md", -#' zap_small = zap_small, -#' ...) -#' -#' if ("Group" %in% colnames(x)) { -#' group_by <- "Group" -#' } else { -#' group_by <- NULL -#' } -#' -#' cat(insight::export_table(x, -#' format = "md", -#' title = title, -#' subtitle = subtitle, -#' group_by = group_by)) -#' invisible(orig_x) -#' } diff --git a/R/extract_parameters.R b/R/extract_parameters.R index dcccdf5c9..6f6653bd4 100644 --- a/R/extract_parameters.R +++ b/R/extract_parameters.R @@ -16,7 +16,7 @@ keep_parameters = NULL, drop_parameters = NULL, include_sigma = TRUE, - summary = FALSE, + include_info = FALSE, vcov = NULL, vcov_args = NULL, ...) { @@ -91,6 +91,9 @@ c("intercept", "location", "scale"), lengths(model[c("Alpha", "beta", "zeta")]) ) + } else if (inherits(model, "ordinal_weightit")) { + intercept_groups <- rep("conditional", nrow(parameters)) + intercept_groups[grep("|", parameters$Parameter, fixed = TRUE)] <- "intercept" } else { intercept_groups <- NULL } @@ -103,9 +106,9 @@ # ==== CI - only if we don't already have CI for std. parameters - if (is.null(ci)) { - ci_cols <- NULL - } else { + ci_cols <- NULL + if (!is.null(ci)) { + # set up arguments for CI function fun_args <- list(model, ci = ci, component = component, @@ -114,14 +117,13 @@ verbose = verbose ) fun_args <- c(fun_args, dots) + # add method argument if provided if (!is.null(ci_method)) { fun_args[["method"]] <- ci_method } ci_df <- suppressMessages(do.call("ci", fun_args)) - - if (is.null(ci_df)) { - ci_cols <- NULL - } else { + # success? merge CI into parameters + if (!is.null(ci_df)) { # for multiple CI columns, reshape CI-dataframe to match parameters df if (length(ci) > 1) { ci_df <- datawizard::reshape_ci(ci_df) @@ -145,7 +147,7 @@ ) fun_args <- c(fun_args, dots) pval <- do.call("p_value", fun_args) - + # success? merge p-values into parameters if (!is.null(pval)) { parameters <- merge(parameters, pval, by = merge_by, sort = FALSE) } @@ -166,7 +168,7 @@ fun_args[["method"]] <- ci_method } std_err <- do.call("standard_error", fun_args) - + # success? merge SE into parameters if (!is.null(std_err)) { parameters <- merge(parameters, std_err, by = merge_by, sort = FALSE) } @@ -174,7 +176,6 @@ # ==== test statistic - fix values for robust vcov - # deprecated argument `robust = TRUE` if (!is.null(vcov) || isTRUE(dots[["robust"]])) { parameters$Statistic <- parameters$Estimate / parameters$SE @@ -186,9 +187,9 @@ # ==== degrees of freedom if (is.null(ci_method)) { - df_error <- degrees_of_freedom(model, method = "any", verbose = FALSE) + df_error <- insight::get_df(x = model, type = "wald", verbose = FALSE) } else { - df_error <- degrees_of_freedom(model, method = ci_method, verbose = FALSE) + df_error <- insight::get_df(x = model, type = ci_method, verbose = FALSE) } if (!is.null(df_error) && (length(df_error) == 1 || length(df_error) == nrow(parameters))) { if (length(df_error) == 1) { @@ -224,7 +225,7 @@ if (inherits(model, "polr") && !is.null(intercept_groups)) { parameters$Component <- "beta" parameters$Component[intercept_groups] <- "alpha" - } else if (inherits(model, c("clm", "clm2")) && !is.null(intercept_groups)) { + } else if (inherits(model, c("clm", "clm2", "ordinal_weightit")) && !is.null(intercept_groups)) { parameters$Component <- intercept_groups } @@ -300,7 +301,7 @@ # ==== add sigma and residual df - if (isTRUE(include_sigma) || isTRUE(summary)) { + if (isTRUE(include_sigma) || isTRUE(include_info)) { parameters <- .add_sigma_residual_df(parameters, model) } @@ -318,7 +319,7 @@ sig <- .safe(suppressWarnings(insight::get_sigma(model, ci = NULL, verbose = FALSE))) attr(params, "sigma") <- as.numeric(sig) - resdf <- .safe(suppressWarnings(insight::get_df(model, type = "residual"))) + resdf <- .safe(suppressWarnings(insight::get_df(x = model, type = "residual"))) attr(params, "residual_df") <- as.numeric(resdf) } params @@ -355,7 +356,7 @@ verbose = TRUE) { # check pattern if (!is.null(keep) && length(keep) > 1) { - keep <- paste0("(", paste0(keep, collapse = "|"), ")") + keep <- paste0("(", paste(keep, collapse = "|"), ")") if (verbose) { insight::format_alert( sprintf("The `keep` argument has more than 1 element. Merging into following regular expression: `%s`.", keep) @@ -365,7 +366,7 @@ # check pattern if (!is.null(drop) && length(drop) > 1) { - drop <- paste0("(", paste0(drop, collapse = "|"), ")") + drop <- paste0("(", paste(drop, collapse = "|"), ")") if (verbose) { insight::format_alert( sprintf("The `drop` argument has more than 1 element. Merging into following regular expression: `%s`.", drop) @@ -423,7 +424,7 @@ keep_parameters = NULL, drop_parameters = NULL, include_sigma = FALSE, - summary = FALSE, + include_info = FALSE, vcov = NULL, vcov_args = NULL, verbose = TRUE, @@ -451,7 +452,7 @@ # Degrees of freedom if (.dof_method_ok(model, ci_method)) { - dof <- degrees_of_freedom(model, method = ci_method, verbose = FALSE) + dof <- insight::get_df(x = model, type = ci_method, verbose = FALSE) } else { dof <- Inf } @@ -467,9 +468,8 @@ # CI - only if we don't already have CI for std. parameters - if (is.null(ci)) { - ci_cols <- NULL - } else { + ci_cols <- NULL + if (!is.null(ci)) { # robust (current or deprecated) if (!is.null(vcov) || isTRUE(list(...)[["robust"]])) { fun_args <- list(model, @@ -486,7 +486,9 @@ } else { ci_df <- ci(model, ci = ci, method = ci_method, effects = "fixed") } - if (length(ci) > 1) ci_df <- datawizard::reshape_ci(ci_df) + if (length(ci) > 1) { + ci_df <- datawizard::reshape_ci(ci_df) + } ci_cols <- names(ci_df)[!names(ci_df) %in% c("CI", "Parameter")] parameters <- merge(parameters, ci_df, by = "Parameter", sort = FALSE) } @@ -563,7 +565,7 @@ if (!ci_method %in% special_ci_methods) { df_error <- data.frame( Parameter = parameters$Parameter, - df_error = degrees_of_freedom(model, method = "any"), + df_error = insight::get_df(x = model, type = "wald"), stringsAsFactors = FALSE ) } @@ -637,7 +639,7 @@ # add sigma - if (isTRUE(include_sigma) || isTRUE(summary)) { + if (isTRUE(include_sigma) || isTRUE(include_info)) { parameters <- .add_sigma_residual_df(parameters, model) } diff --git a/R/extract_parameters_anova.R b/R/extract_parameters_anova.R index ab3e2df9b..b46b750ed 100644 --- a/R/extract_parameters_anova.R +++ b/R/extract_parameters_anova.R @@ -49,6 +49,7 @@ names(parameters) <- gsub("Resid. Dev", "Deviance_error", names(parameters), fixed = TRUE) # error-df if (!"df_error" %in% names(parameters)) { + names(parameters) <- gsub("DenDF", "df_error", names(parameters), fixed = TRUE) names(parameters) <- gsub("den Df", "df_error", names(parameters), fixed = TRUE) names(parameters) <- gsub("Res.Df", "df_error", names(parameters), fixed = TRUE) names(parameters) <- gsub("Resid. Df", "df_error", names(parameters), fixed = TRUE) @@ -68,8 +69,13 @@ # Reorder row.names(parameters) <- NULL - order <- c("Response", "Group", "Parameter", "Coefficient", "SE", "Pillai", "AIC", "BIC", "Log_Likelihood", "Chi2", "Chi2_df", "RSS", "Sum_Squares", "Sum_Squares_Partial", "Sum_Squares_Error", "df", "Deviance", "Statistic", "df_num", "df_error", "Deviance_error", "Mean_Square", "F", "Rao", "p") - parameters <- parameters[order[order %in% names(parameters)]] + col_order <- c( + "Response", "Group", "Parameter", "Coefficient", "SE", "Pillai", "AIC", + "BIC", "Log_Likelihood", "Chi2", "Chi2_df", "RSS", "Sum_Squares", + "Sum_Squares_Partial", "Sum_Squares_Error", "df", "Deviance", "Statistic", + "df_num", "df_error", "Deviance_error", "Mean_Square", "F", "Rao", "p" + ) + parameters <- parameters[col_order[col_order %in% names(parameters)]] insight::text_remove_backticks(parameters, verbose = FALSE) } @@ -235,7 +241,7 @@ Parameter = model$terms[i], df = model$df[i], Statistic = test[1], - `F` = test[2], + `F` = test[2], # nolint df_num = test[3], df_error = test[4], p = stats::pf(test[2], test[3], test[4], lower.tail = FALSE), @@ -311,7 +317,7 @@ .power_for_aov <- function(model, params) { if (requireNamespace("effectsize", quietly = TRUE)) { - power <- tryCatch( + power_aov <- tryCatch( { cohens_f2 <- effectsize::cohens_f_squared(model, partial = TRUE, verbose = FALSE) @@ -329,8 +335,8 @@ ) } - if (!is.null(power)) { - params <- merge(params, cohens_f2[c("Parameter", "Power")], sort = FALSE, all = TRUE) + if (!is.null(power_aov)) { + params <- merge(params, power_aov[c("Parameter", "Power")], sort = FALSE, all = TRUE) } params diff --git a/R/extract_random_parameters.R b/R/extract_random_parameters.R index c8dc8325d..6b5fbb03f 100644 --- a/R/extract_random_parameters.R +++ b/R/extract_random_parameters.R @@ -24,7 +24,7 @@ out$CI_high <- out$Coefficient + fac * out$SE ci_cols <- c("CI_low", "CI_high") } else { - ci_cols <- c() + ci_cols <- NULL for (i in ci) { fac <- stats::qnorm((1 + i) / 2) ci_low <- paste0("CI_low_", i) @@ -66,7 +66,10 @@ out <- switch(component, zi = , zero_inflated = out[out$Component == "zi", ], + cond = , conditional = out[out$Component == "cond", ], + disp = , + dispersion = out[out$Component == "disp", ], out ) @@ -79,6 +82,7 @@ # rename out$Component[out$Component == "zi"] <- "zero_inflated" out$Component[out$Component == "cond"] <- "conditional" + out$Component[out$Component == "disp"] <- "dispersion" if (length(ci) == 1) { fac <- stats::qnorm((1 + ci) / 2) @@ -86,7 +90,7 @@ out$CI_high <- out$Coefficient + fac * out$SE ci_cols <- c("CI_low", "CI_high") } else { - ci_cols <- c() + ci_cols <- NULL for (i in ci) { fac <- stats::qnorm((1 + i) / 2) ci_low <- paste0("CI_low_", i) @@ -104,7 +108,10 @@ out$df_error <- NA out$p <- NA - out <- out[c("Parameter", "Level", "Coefficient", "SE", ci_cols, stat_column, "df_error", "p", "Component", "Effects", "Group")] + out <- out[c( + "Parameter", "Level", "Coefficient", "SE", ci_cols, stat_column, + "df_error", "p", "Component", "Effects", "Group" + )] if (effects == "random") { out[c(stat_column, "df_error", "p")] <- NULL diff --git a/R/extract_random_variances.R b/R/extract_random_variances.R index 620aabfa0..9b042a79e 100644 --- a/R/extract_random_variances.R +++ b/R/extract_random_variances.R @@ -108,6 +108,42 @@ .extract_random_variances.MixMod <- .extract_random_variances.glmmTMB +# svy2lme ------------------------ + +.extract_random_variances.svy2lme <- function(model, ci = 0.95, effects = "random", ...) { + s <- sqrt(as.vector(model$s2)) + stdev <- matrix(s * sqrt(diag(model$L)), ncol = 1) + vcnames <- c(paste0("SD (", model$znames, ")"), "SD (Observations)") + grp_names <- names(model$znames) + if (is.null(grp_names)) { + grp_names <- model$znames + } + + out <- data.frame( + Parameter = vcnames, + Level = NA, + Coefficient = c(as.vector(stdev), s), + SE = NA, + CI_low = NA, + CI_high = NA, + t = NA, + df_error = NA, + p = NA, + Effects = "random", + Group = c(grp_names, "Residual"), + stringsAsFactors = FALSE + ) + + # fix intercept names + out$Parameter <- gsub("(Intercept)", "Intercept", out$Parameter, fixed = TRUE) + + if (effects == "random") { + out[c("t", "df_error", "p")] <- NULL + } + + rownames(out) <- NULL + out +} diff --git a/R/format.R b/R/format.R index 790489abf..857068863 100644 --- a/R/format.R +++ b/R/format.R @@ -1,7 +1,7 @@ # usual models --------------------------------- #' @inheritParams print.parameters_model -#' @rdname display.parameters_model +#' @rdname print.parameters_model #' @export format.parameters_model <- function(x, pretty_names = TRUE, @@ -240,6 +240,7 @@ format.parameters_brms_meta <- format.parameters_model # Compare parameters ---------------------- +#' @rdname print.compare_parameters #' @inheritParams print.parameters_model #' @export format.compare_parameters <- function(x, @@ -311,7 +312,7 @@ format.compare_parameters <- function(x, # since we merged all models together, and we only have model-specific # columns for estimates, CI etc. but not for Effects and Component, we # extract "valid" rows via non-NA values in the coefficient column - coef_column <- which(colnames(cols) %in% c(.all_coefficient_types(), "Coefficient")) + coef_column <- which(colnames(cols) %in% c(.all_coefficient_types, "Coefficient")) valid_rows <- which(!is.na(cols[[coef_column]])) # check if we have mixed models with random variance parameters # in such cases, we don't need the group-column, but we rather @@ -541,6 +542,7 @@ format.parameters_sem <- function(x, show_sigma = FALSE, show_formula = FALSE, show_r2 = FALSE, + show_rmse = FALSE, format = "text") { # prepare footer footer <- NULL @@ -548,6 +550,7 @@ format.parameters_sem <- function(x, sigma_value <- attributes(x)$sigma r2 <- attributes(x)$r2 + rmse <- attributes(x)$rmse residual_df <- attributes(x)$residual_df p_adjust <- attributes(x)$p_adjust model_formula <- attributes(x)$model_formula @@ -574,29 +577,35 @@ format.parameters_sem <- function(x, footer <- .add_footer_r2(footer, digits, r2, type) } + # footer: r-squared + if (isTRUE(show_rmse)) { + footer <- .add_footer_values(footer, digits, value = rmse, text = "RMSE ", type) + } + # footer: p-adjustment - if ("p" %in% colnames(x) && isTRUE(verbose)) { - footer <- .add_footer_padjust(footer, p_adjust, type) + if ("p" %in% colnames(x) && isTRUE(verbose) && !is.null(p_adjust) && p_adjust != "none") { + footer <- .add_footer_text(footer, text = paste("p-value adjustment method:", format_p_adjust(p_adjust))) } # footer: anova test if (!is.null(anova_test)) { - footer <- .add_footer_anova_test(footer, anova_test, type) + footer <- .add_footer_text(footer, text = sprintf("%s test statistic", anova_test)) } - # footer: anova test + # footer: anova type if (!is.null(anova_type)) { - footer <- .add_footer_anova_type(footer, anova_type, type) + footer <- .add_footer_text(footer, text = sprintf("Anova Table (Type %s tests)", anova_type)) } + # footer: marginaleffects::comparisons() if (!is.null(prediction_type)) { - footer <- .add_footer_prediction_type(footer, prediction_type, type) + footer <- .add_footer_text(footer, text = sprintf("Prediction type: %s", prediction_type)) } # footer: htest alternative if (!is.null(text_alternative)) { - footer <- .add_footer_alternative(footer, text_alternative, type) + footer <- .add_footer_text(footer, text = text_alternative) } # footer: generic text @@ -626,7 +635,7 @@ format.parameters_sem <- function(x, # footer: generic text .add_footer_text <- function(footer = NULL, text = NULL, type = "text", is_ggeffects = FALSE) { - if (!is.null(text)) { + if (!is.null(text) && length(text)) { if (type == "text" || type == "markdown") { if (is.null(footer)) { fill <- "\n" @@ -643,6 +652,29 @@ format.parameters_sem <- function(x, } +# footer: generic values +.add_footer_values <- function(footer = NULL, + digits = 3, + value = NULL, + text = NULL, + type = "text") { + if (!is.null(value) && !is.null(text)) { + string <- sprintf("%s: %s", text, insight::format_value(value, digits = digits)) + if (type == "text" || type == "markdown") { + if (is.null(footer)) { + fill <- "\n" + } else { + fill <- "" + } + footer <- paste0(footer, fill, string, "\n") + } else if (type == "html") { + footer <- c(footer, string) + } + } + footer +} + + # footer: residual standard deviation .add_footer_sigma <- function(footer = NULL, digits = 3, sigma = NULL, residual_df = NULL, type = "text") { if (!is.null(sigma)) { @@ -659,9 +691,9 @@ format.parameters_sem <- function(x, } else { fill <- "" } - footer <- paste0(footer, sprintf("%sResidual standard deviation: %.*f%s\n", fill, digits, sigma, res_df)) + footer <- paste0(footer, sprintf("%sSigma: %.*f%s\n", fill, digits, sigma, res_df)) } else if (type == "html") { - footer <- c(footer, insight::trim_ws(sprintf("Residual standard deviation: %.*f%s", digits, sigma, res_df))) + footer <- c(footer, insight::trim_ws(sprintf("Sigma: %.*f%s", digits, sigma, res_df))) } } footer @@ -671,7 +703,7 @@ format.parameters_sem <- function(x, # footer: r-squared .add_footer_r2 <- function(footer = NULL, digits = 3, r2 = NULL, type = "text") { if (!is.null(r2)) { - rsq <- .safe(paste0(unlist(lapply(r2, function(i) { + rsq <- .safe(paste(unlist(lapply(r2, function(i) { paste0(attributes(i)$names, ": ", insight::format_value(i, digits = digits)) })), collapse = "; ")) @@ -692,96 +724,6 @@ format.parameters_sem <- function(x, } -# footer: anova type -.add_footer_anova_type <- function(footer = NULL, aov_type = NULL, type = "text") { - if (!is.null(aov_type)) { - if (type == "text" || type == "markdown") { - if (is.null(footer)) { - fill <- "\n" - } else { - fill <- "" - } - footer <- paste0(footer, sprintf("%sAnova Table (Type %s tests)\n", fill, aov_type)) - } else if (type == "html") { - footer <- c(footer, sprintf("Anova Table (Type %s tests)", aov_type)) - } - } - footer -} - - -# footer: marginaleffects::comparisions() prediction_type -.add_footer_prediction_type <- function(footer = NULL, prediction_type = NULL, type = "text") { - if (!is.null(prediction_type)) { - if (type == "text" || type == "markdown") { - if (is.null(footer)) { - fill <- "\n" - } else { - fill <- "" - } - footer <- paste0(footer, sprintf("%sPrediction type: %s\n", fill, prediction_type)) - } else if (type == "html") { - footer <- c(footer, sprintf("Prediction type: %s", prediction_type)) - } - } - footer -} - - -# footer: anova test -.add_footer_anova_test <- function(footer = NULL, test = NULL, type = "text") { - if (!is.null(test)) { - if (type == "text" || type == "markdown") { - if (is.null(footer)) { - fill <- "\n" - } else { - fill <- "" - } - footer <- paste0(footer, sprintf("%s%s test statistic\n", fill, test)) - } else if (type == "html") { - footer <- c(footer, sprintf("%s test statistic", test)) - } - } - footer -} - - -# footer: htest alternative -.add_footer_alternative <- function(footer = NULL, text_alternative = NULL, type = "text") { - if (!is.null(text_alternative)) { - if (type == "text" || type == "markdown") { - if (is.null(footer)) { - fill <- "\n" - } else { - fill <- "" - } - footer <- paste0(footer, sprintf("%s%s\n", fill, text_alternative)) - } else if (type == "html") { - footer <- c(footer, text_alternative) - } - } - footer -} - - -# footer: p-adjustment -.add_footer_padjust <- function(footer = NULL, p_adjust = NULL, type = "text") { - if (!is.null(p_adjust) && p_adjust != "none") { - if (type == "text" || type == "markdown") { - if (is.null(footer)) { - fill <- "\n" - } else { - fill <- "" - } - footer <- paste0(footer, fill, "p-value adjustment method: ", format_p_adjust(p_adjust), "\n") - } else if (type == "html") { - footer <- c(footer, paste0("p-value adjustment method: ", format_p_adjust(p_adjust))) - } - } - footer -} - - # footer: model formula .add_footer_formula <- function(footer = NULL, model_formula = NULL, n_obs = NULL, type = "text") { if (!is.null(model_formula)) { @@ -918,11 +860,13 @@ format.parameters_sem <- function(x, .print_footer_exp <- function(x) { + # we need this to check whether we have extremely large cofficients if (isTRUE(getOption("parameters_exponentiate", TRUE))) { msg <- NULL - # we need this to check whether we have extremely large cofficients - if (all(c("Coefficient", "Parameter") %in% colnames(x))) { - spurious_coefficients <- abs(x$Coefficient[!.in_intercepts(x$Parameter)]) + # try to find out the name of the coefficient column + coef_column <- intersect(colnames(x), .all_coefficient_names) + if (length(coef_column) && "Parameter" %in% colnames(x)) { + spurious_coefficients <- abs(x[[coef_column[1]]][!.in_intercepts(x$Parameter)]) } else { spurious_coefficients <- NULL } @@ -930,8 +874,10 @@ format.parameters_sem <- function(x, if (!.is_valid_exponentiate_argument(exponentiate)) { if (isTRUE(.additional_arguments(x, "log_link", FALSE))) { msg <- "The model has a log- or logit-link. Consider using `exponentiate = TRUE` to interpret coefficients as ratios." # nolint - # we only check for exp(coef), so exp() here soince coefficients are on logit-scale - spurious_coefficients <- exp(spurious_coefficients) + # we only check for exp(coef), so exp() here since coefficients are on logit-scale + if (!is.null(spurious_coefficients)) { + spurious_coefficients <- exp(spurious_coefficients) + } } else if (isTRUE(.additional_arguments(x, "log_response", FALSE))) { msg <- "The model has a log-transformed response variable. Consider using `exponentiate = TRUE` to interpret coefficients as ratios." # nolint # don't show warning about complete separation diff --git a/R/format_parameters.R b/R/format_parameters.R index 818556416..c9f5851da 100644 --- a/R/format_parameters.R +++ b/R/format_parameters.R @@ -11,7 +11,7 @@ #' @section Interpretation of Interaction Terms: #' Note that the *interpretation* of interaction terms depends on many #' characteristics of the model. The number of parameters, and overall -#' performance of the model, can differ *or not* between `a * b` +#' performance of the model, can differ *or not* between `a * b`, #' `a : b`, and `a / b`, suggesting that sometimes interaction terms #' give different parameterizations of the same model, but other times it gives #' completely different models (depending on `a` or `b` being factors @@ -72,10 +72,10 @@ format_parameters.parameters_model <- function(model, ...) { # save some time, if model info is passed as argument dot_args <- list(...) - if (!is.null(dot_args$model_info)) { - info <- dot_args$model_info - } else { + if (is.null(dot_args$model_info)) { info <- insight::model_info(model, verbose = FALSE) + } else { + info <- dot_args$model_info } ## TODO remove is.list() when insight 0.8.3 on CRAN @@ -299,16 +299,16 @@ format_parameters.parameters_model <- function(model, ...) { if (type == "interaction") { components <- paste0( "(", - paste0(utils::head(components, -1), collapse = sep), + paste(utils::head(components, -1), collapse = sep), ")", sep, utils::tail(components, 1) ) } else { - components <- paste0(components, collapse = sep) + components <- paste(components, collapse = sep) } } else { - components <- paste0(components, collapse = sep) + components <- paste(components, collapse = sep) } components } @@ -378,6 +378,12 @@ format_parameters.parameters_model <- function(model, ...) { if (!is.null(model) && insight::is_regression_model(model) && !is.data.frame(model)) { # get data, but exclude response - we have no need for that label mf <- insight::get_data(model, source = "mf", verbose = FALSE) + # sanity check - any labels? + has_labels <- vapply(mf, function(i) !is.null(attr(i, "labels", exact = TRUE)), logical(1)) + # if we don't have labels, we try to get data from environment + if (!any(has_labels)) { + mf <- insight::get_data(model, source = "environment", verbose = FALSE) + } resp <- insight::find_response(model, combine = FALSE) mf <- mf[, setdiff(colnames(mf), resp), drop = FALSE] @@ -432,7 +438,7 @@ format_parameters.parameters_model <- function(model, ...) { # extract single coefficient names from interaction term out <- unlist(strsplit(i, ":", fixed = TRUE)) # combine labels - labs <- c(labs, paste0(sapply(out, function(l) pretty_labels[l]), collapse = " * ")) + labs <- c(labs, paste(sapply(out, function(l) pretty_labels[l]), collapse = " * ")) } # add interaction terms to labels string names(labs) <- names(interactions) @@ -461,10 +467,10 @@ format_parameters.parameters_model <- function(model, ...) { win_os <- tryCatch( { si <- Sys.info() - if (!is.null(si["sysname"])) { - si["sysname"] == "Windows" || startsWith(R.version$os, "mingw") - } else { + if (is.null(si["sysname"])) { FALSE + } else { + si["sysname"] == "Windows" || startsWith(R.version$os, "mingw") } }, error = function(e) { diff --git a/R/methods_BBMM.R b/R/methods_BBMM.R index 912b16b0c..15ae03155 100644 --- a/R/methods_BBMM.R +++ b/R/methods_BBMM.R @@ -64,18 +64,3 @@ p_value.BBreg <- function(model, ...) { p = as.data.frame(summary(model)$coefficients)$p.value ) } - - - -#' @export -degrees_of_freedom.BBmm <- function(model, method = "residual", ...) { - if (method %in% c("residual", "wald")) { - return(model$df) - } else { - return(degrees_of_freedom.default(model = model, method = method, ...)) - } -} - - -#' @export -degrees_of_freedom.BBreg <- degrees_of_freedom.BBmm diff --git a/R/methods_BayesFactor.R b/R/methods_BayesFactor.R index 99573ef62..cb8b85cd8 100644 --- a/R/methods_BayesFactor.R +++ b/R/methods_BayesFactor.R @@ -13,7 +13,6 @@ #' @inheritParams bayestestR::describe_posterior #' @inheritParams p_value #' @inheritParams model_parameters.htest -#' @param cohens_d,cramers_v Deprecated. Please use `effectsize_type`. #' #' @details #' The meaning of the extracted parameters: @@ -29,24 +28,26 @@ #' the *g* parameters; See the *Bayes Factors for ANOVAs* paper #' (\doi{10.1016/j.jmp.2012.08.001}). #' -#' @examples +#' @examplesIf require("BayesFactor") #' \donttest{ -#' if (require("BayesFactor")) { -#' # Bayesian t-test -#' model <- ttestBF(x = rnorm(100, 1, 1)) -#' model_parameters(model) -#' model_parameters(model, cohens_d = TRUE, ci = .9) +#' # Bayesian t-test +#' model <- BayesFactor::ttestBF(x = rnorm(100, 1, 1)) +#' model_parameters(model) +#' model_parameters(model, es_type = "cohens_d", ci = 0.9) #' -#' # Bayesian contingency table analysis -#' data(raceDolls) -#' bf <- contingencyTableBF(raceDolls, sampleType = "indepMulti", fixedMargin = "cols") -#' model_parameters(bf, -#' centrality = "mean", -#' dispersion = TRUE, -#' verbose = FALSE, -#' effectsize_type = "cramers_v" -#' ) -#' } +#' # Bayesian contingency table analysis +#' data(raceDolls) +#' bf <- BayesFactor::contingencyTableBF( +#' raceDolls, +#' sampleType = "indepMulti", +#' fixedMargin = "cols" +#' ) +#' model_parameters(bf, +#' centrality = "mean", +#' dispersion = TRUE, +#' verbose = FALSE, +#' es_type = "cramers_v" +#' ) #' } #' @return A data frame of indices related to the model's parameters. #' @export @@ -59,19 +60,12 @@ model_parameters.BFBayesFactor <- function(model, rope_range = "default", rope_ci = 0.95, priors = TRUE, - effectsize_type = NULL, + es_type = NULL, include_proportions = FALSE, verbose = TRUE, - cohens_d = NULL, - cramers_v = NULL, ...) { insight::check_if_installed("BayesFactor") - ## TODO: remove in a later update - # handle deprected arguments ------ - if (!is.null(cramers_v)) effectsize_type <- "cramers_v" - if (!is.null(cohens_d)) effectsize_type <- "cohens_d" - if (any(startsWith(names(model@numerator), "Null"))) { if (isTRUE(verbose)) { insight::format_alert( @@ -121,10 +115,10 @@ model_parameters.BFBayesFactor <- function(model, tryCatch( { bfm <- as.data.frame(bayestestR::bayesfactor_models(model)[-1, ]) - if (!is.null(bfm$log_BF)) { - out$BF <- exp(bfm$log_BF) - } else { + if (is.null(bfm$log_BF)) { out$BF <- bfm$BF + } else { + out$BF <- exp(bfm$log_BF) } }, error = function(e) { @@ -138,19 +132,19 @@ model_parameters.BFBayesFactor <- function(model, } # Effect size? - if (!is.null(effectsize_type)) { + if (!is.null(es_type)) { # needs {effectsize} to be installed insight::check_if_installed("effectsize") - ## TODO: add back ci-argument, once effectsize >= 0.7.1 is on CRAN. tryCatch( { effsize <- effectsize::effectsize(model, centrality = centrality, dispersion = dispersion, + ci = ci, ci_method = ci_method, rope_ci = rope_ci, - type = effectsize_type, + type = es_type, ... ) diff --git a/R/methods_DirichletReg.R b/R/methods_DirichletReg.R index eb97718f3..300a8c2a0 100644 --- a/R/methods_DirichletReg.R +++ b/R/methods_DirichletReg.R @@ -21,20 +21,22 @@ model_parameters.DirichletRegModel <- function(model, ## TODO check merge by - junk <- utils::capture.output(out <- .model_parameters_generic( # nolint - model = model, - ci = ci, - component = component, - bootstrap = bootstrap, - iterations = iterations, - merge_by = merge_by, - standardize = standardize, - exponentiate = exponentiate, - p_adjust = p_adjust, - keep_parameters = keep, - drop_parameters = drop, - ... - )) + junk <- utils::capture.output({ + out <- .model_parameters_generic( + model = model, + ci = ci, + component = component, + bootstrap = bootstrap, + iterations = iterations, + merge_by = merge_by, + standardize = standardize, + exponentiate = exponentiate, + p_adjust = p_adjust, + keep_parameters = keep, + drop_parameters = drop, + ... + ) + }) out$Response[is.na(out$Response)] <- "" attr(out, "object_name") <- insight::safe_deparse_symbol(substitute(model)) diff --git a/R/methods_aod.R b/R/methods_aod.R index fe98716ae..ef067d3e2 100644 --- a/R/methods_aod.R +++ b/R/methods_aod.R @@ -18,6 +18,7 @@ model_parameters.glimML <- function(model, exponentiate = FALSE, p_adjust = NULL, summary = getOption("parameters_summary", FALSE), + include_info = getOption("parameters_info", FALSE), keep = NULL, drop = NULL, verbose = TRUE, @@ -29,6 +30,12 @@ model_parameters.glimML <- function(model, merge_by <- "Parameter" } + ## TODO remove deprecated later + if (!missing(summary)) { + .deprecated_warning("summary", "include_info", verbose) + include_info <- summary + } + # dispersion is just an alias... if (component == "dispersion") { component <- "random" @@ -46,7 +53,7 @@ model_parameters.glimML <- function(model, p_adjust = p_adjust, keep_parameters = keep, drop_parameters = drop, - summary = summary, + include_info = include_info, verbose = verbose, ... ) diff --git a/R/methods_aov.R b/R/methods_aov.R index 61ca4cb36..0d13590c0 100644 --- a/R/methods_aov.R +++ b/R/methods_aov.R @@ -7,7 +7,7 @@ #' @param model Object of class [aov()], [anova()], #' `aovlist`, `Gam`, [manova()], `Anova.mlm`, #' `afex_aov` or `maov`. -#' @param effectsize_type The effect size of interest. Not that possibly not all +#' @param es_type The effect size of interest. Not that possibly not all #' effect sizes are applicable to the model object. See 'Details'. For Anova #' models, can also be a character vector with multiple effect size names. #' @param df_error Denominator degrees of freedom (or degrees of freedom of the @@ -18,7 +18,7 @@ #' ANOVA-tables using `car::Anova()` will be returned. (Ignored for #' `afex_aov`.) #' @param ci Confidence Interval (CI) level for effect sizes specified in -#' `effectsize_type`. The default, `NULL`, will compute no confidence +#' `es_type`. The default, `NULL`, will compute no confidence #' intervals. `ci` should be a scalar between 0 and 1. #' @param test String, indicating the type of test for `Anova.mlm` to be #' returned. If `"multivariate"` (or `NULL`), returns the summary of @@ -35,7 +35,6 @@ #' (e.g., `"g"`, `"l"`, `"two"`...). See section *One-Sided CIs* in #' the [effectsize_CIs vignette](https://easystats.github.io/effectsize/). #' @inheritParams model_parameters.default -#' @param omega_squared,eta_squared,epsilon_squared Deprecated. Please use `effectsize_type`. #' @param ... Arguments passed to [`effectsize::effectsize()`]. For example, #' to calculate _partial_ effect sizes types, use `partial = TRUE`. For objects #' of class `htest` or `BFBayesFactor`, `adjust = TRUE` can be used to return @@ -66,13 +65,13 @@ #' model <- aov(Sepal.Length ~ Sepal.Big, data = df) #' model_parameters(model) #' -#' model_parameters(model, effectsize_type = c("omega", "eta"), ci = 0.9) +#' model_parameters(model, es_type = c("omega", "eta"), ci = 0.9) #' #' model <- anova(lm(Sepal.Length ~ Sepal.Big, data = df)) #' model_parameters(model) #' model_parameters( #' model, -#' effectsize_type = c("omega", "eta", "epsilon"), +#' es_type = c("omega", "eta", "epsilon"), #' alternative = "greater" #' ) #' @@ -92,7 +91,7 @@ #' # parameters table including effect sizes #' model_parameters( #' model, -#' effectsize_type = "eta", +#' es_type = "eta", #' ci = 0.9, #' df_error = dof_satterthwaite(mm)[2:3] #' ) @@ -105,48 +104,21 @@ model_parameters.aov <- function(model, alternative = NULL, test = NULL, power = FALSE, - effectsize_type = NULL, + es_type = NULL, keep = NULL, drop = NULL, table_wide = FALSE, verbose = TRUE, - omega_squared = NULL, - eta_squared = NULL, - epsilon_squared = NULL, ...) { - ## TODO: remove in a later update - # handle deprected arguments ------ - if (!is.null(omega_squared)) { - insight::format_warning( - "Argument `omega_squared` is deprecated.", - "Please use `effectsize_type = \"omega\"` instead." - ) - effectsize_type <- "omega" - } - if (!is.null(eta_squared)) { - insight::format_warning( - "Argument `eta_squared` is deprecated.", - "Please use `effectsize_type = \"eta\"` instead." - ) - effectsize_type <- "eta" - } - if (!is.null(epsilon_squared)) { - insight::format_warning( - "Argument `epsilon_squared` is deprecated.", - "Please use `effectsize_type = \"epsilon\"` instead." - ) - effectsize_type <- "epsilon" - } - # save model object, for later checks original_model <- model object_name <- insight::safe_deparse_symbol(substitute(model)) if (inherits(model, "aov") && !is.null(type) && type > 1) { - if (!requireNamespace("car", quietly = TRUE)) { - insight::format_warning("Package {.pkg car} required for type-2 or type-3 Anova. Defaulting to type-1.") - } else { + if (requireNamespace("car", quietly = TRUE)) { model <- car::Anova(model, type = type) + } else { + insight::format_warning("Package {.pkg car} required for type-2 or type-3 Anova. Defaulting to type-1.") } } @@ -172,7 +144,7 @@ model_parameters.aov <- function(model, params <- .effectsizes_for_aov( model, params = params, - effectsize_type = effectsize_type, + es_type = es_type, df_error = df_error, ci = ci, alternative = alternative, @@ -278,7 +250,7 @@ model_parameters.aovlist <- model_parameters.aov #' @rdname model_parameters.aov #' @export model_parameters.afex_aov <- function(model, - effectsize_type = NULL, + es_type = NULL, df_error = NULL, type = NULL, keep = NULL, @@ -298,7 +270,7 @@ model_parameters.afex_aov <- function(model, out <- .effectsizes_for_aov( model, params = out, - effectsize_type = effectsize_type, + es_type = es_type, df_error = df_error, verbose = verbose, ... @@ -349,6 +321,7 @@ model_parameters.maov <- model_parameters.aov if (is.numeric(type)) { return(type) } + # nolint start switch(type, `1` = , `I` = 1, @@ -358,6 +331,7 @@ model_parameters.maov <- model_parameters.aov `III` = 3, 1 ) + # nolint end } # default to 1 @@ -430,28 +404,26 @@ model_parameters.maov <- model_parameters.aov predictors <- .safe(insight::get_predictors(model)) # if data available, check contrasts and mean centering - if (!is.null(predictors)) { + if (is.null(predictors)) { + treatment_contrasts_or_not_centered <- FALSE + } else { treatment_contrasts_or_not_centered <- vapply(predictors, function(i) { if (is.factor(i)) { cn <- stats::contrasts(i) if (is.null(cn) || (all(cn %in% c(0, 1)))) { return(TRUE) } - } else { - if (abs(mean(i, na.rm = TRUE)) > 1e-2) { - return(TRUE) - } + } else if (abs(mean(i, na.rm = TRUE)) > 1e-2) { + return(TRUE) } - return(FALSE) + FALSE }, TRUE) - } else { - treatment_contrasts_or_not_centered <- FALSE } # successfully checked predictors, or if not possible, at least found interactions? if (!is.null(interaction_terms) && (any(treatment_contrasts_or_not_centered) || is.null(predictors))) { insight::format_alert( - "Type 3 ANOVAs only give sensible and informative results when covariates are mean-centered and factors are coded with orthogonal contrasts (such as those produced by `contr.sum`, `contr.poly`, or `contr.helmert`, but *not* by the default `contr.treatment`)." + "Type 3 ANOVAs only give sensible and informative results when covariates are mean-centered and factors are coded with orthogonal contrasts (such as those produced by `contr.sum`, `contr.poly`, or `contr.helmert`, but *not* by the default `contr.treatment`)." # nolint ) } } @@ -460,19 +432,19 @@ model_parameters.maov <- model_parameters.aov .effectsizes_for_aov <- function(model, params, - effectsize_type = NULL, + es_type = NULL, df_error = NULL, ci = NULL, alternative = NULL, verbose = TRUE, ...) { # user actually does not want to compute effect sizes - if (is.null(effectsize_type)) { + if (is.null(es_type)) { return(params) } # is valid effect size? - if (!all(effectsize_type %in% c("eta", "omega", "epsilon", "f", "f2"))) { + if (!all(es_type %in% c("eta", "omega", "epsilon", "f", "f2"))) { return(params) } @@ -490,7 +462,7 @@ model_parameters.maov <- model_parameters.aov } # multiple effect sizes possible - for (es in effectsize_type) { + for (es in es_type) { fx <- effectsize::effectsize( model, type = es, diff --git a/R/methods_averaging.R b/R/methods_averaging.R index 5c3d9f690..f3c7e00a3 100644 --- a/R/methods_averaging.R +++ b/R/methods_averaging.R @@ -41,11 +41,19 @@ model_parameters.averaging <- function(model, exponentiate = FALSE, p_adjust = NULL, summary = getOption("parameters_summary", FALSE), + include_info = getOption("parameters_info", FALSE), keep = NULL, drop = NULL, verbose = TRUE, ...) { component <- match.arg(component) + + ## TODO remove deprecated later + if (!missing(summary)) { + .deprecated_warning("summary", "include_info", verbose) + include_info <- summary + } + out <- .model_parameters_generic( model = model, ci = ci, @@ -55,7 +63,7 @@ model_parameters.averaging <- function(model, p_adjust = p_adjust, keep_parameters = keep, drop_parameters = drop, - summary = summary, + include_info = include_info, ... ) diff --git a/R/methods_base.R b/R/methods_base.R index 955660264..08236bab4 100644 --- a/R/methods_base.R +++ b/R/methods_base.R @@ -1,9 +1,13 @@ #' @rdname model_parameters.stanreg #' @export -model_parameters.data.frame <- function(model, as_draws = FALSE, verbose = TRUE, ...) { +model_parameters.data.frame <- function(model, + as_draws = FALSE, + exponentiate = FALSE, + verbose = TRUE, + ...) { # treat data frame as bootstraps/posteriors? if (isTRUE(as_draws)) { - return(model_parameters.draws(model, verbose = verbose, ...)) + return(model_parameters.draws(model, exponentiate = exponentiate, verbose = verbose, ...)) } if (isTRUE(verbose)) { insight::format_warning( @@ -22,14 +26,13 @@ model_parameters.data.frame <- function(model, as_draws = FALSE, verbose = TRUE, #' @rdname standard_error #' @export standard_error.factor <- function(model, force = FALSE, verbose = TRUE, ...) { - if (force) { - standard_error(as.numeric(model), ...) - } else { + if (!force) { if (verbose) { insight::format_warning("Can't compute standard error of non-numeric variables.") } return(NA) } + standard_error(as.numeric(model), ...) } @@ -55,10 +58,8 @@ standard_error.list <- function(model, verbose = TRUE, ...) { model <- model$gam class(model) <- c("gam", "lm", "glm") standard_error(model) - } else { - if (isTRUE(verbose)) { - insight::print_color("\nCould not extract standard errors from model object.\n", "red") - } + } else if (isTRUE(verbose)) { + insight::print_color("\nCould not extract standard errors from model object.\n", "red") } } @@ -136,10 +137,10 @@ p_value.numeric <- function(model, null = 0, ...) { #' @export p_value.data.frame <- function(model, ...) { - data <- model[vapply(model, is.numeric, TRUE)] + model_data <- model[vapply(model, is.numeric, TRUE)] .data_frame( - Parameter = names(data), - p = vapply(data, p_value, 1) + Parameter = names(model_data), + p = vapply(model_data, p_value, 1) ) } @@ -150,9 +151,7 @@ p_value.list <- function(model, method = NULL, verbose = TRUE, ...) { model <- model$gam class(model) <- c("gam", "lm", "glm") p_value(model, method = method) - } else { - if (isTRUE(verbose)) { - insight::format_warning("Could not extract p-values from model object.") - } + } else if (isTRUE(verbose)) { + insight::format_warning("Could not extract p-values from model object.") } } diff --git a/R/methods_betareg.R b/R/methods_betareg.R index 4c4ce273b..37fbb8124 100644 --- a/R/methods_betareg.R +++ b/R/methods_betareg.R @@ -11,6 +11,7 @@ model_parameters.betareg <- function(model, exponentiate = FALSE, p_adjust = NULL, summary = getOption("parameters_summary", FALSE), + include_info = getOption("parameters_info", FALSE), keep = NULL, drop = NULL, verbose = TRUE, @@ -23,6 +24,12 @@ model_parameters.betareg <- function(model, verbose = verbose ) + ## TODO remove deprecated later + if (!missing(summary)) { + .deprecated_warning("summary", "include_info", verbose) + include_info <- summary + } + component <- match.arg(component) if (component == "all") { merge_by <- c("Parameter", "Component") @@ -44,7 +51,7 @@ model_parameters.betareg <- function(model, p_adjust = p_adjust, keep_parameters = keep, drop_parameters = drop, - summary = summary, + include_info = include_info, vcov = NULL, vcov_args = NULL ) diff --git a/R/methods_bfsl.R b/R/methods_bfsl.R index 5297e0632..69aa7c3f4 100644 --- a/R/methods_bfsl.R +++ b/R/methods_bfsl.R @@ -4,10 +4,17 @@ model_parameters.bfsl <- function(model, ci_method = "residual", p_adjust = NULL, summary = getOption("parameters_summary", FALSE), + include_info = getOption("parameters_info", FALSE), keep = NULL, drop = NULL, verbose = TRUE, ...) { + ## TODO remove deprecated later + if (!missing(summary)) { + .deprecated_warning("summary", "include_info", verbose) + include_info <- summary + } + out <- .model_parameters_generic( model = model, ci = ci, @@ -16,7 +23,7 @@ model_parameters.bfsl <- function(model, p_adjust = p_adjust, keep_parameters = keep, drop_parameters = drop, - summary = summary, + include_info = include_info, ... ) @@ -37,20 +44,3 @@ standard_error.bfsl <- function(model, ...) { ) insight::text_remove_backticks(params, verbose = FALSE) } - - - -#' @export -degrees_of_freedom.bfsl <- function(model, method = "residual", ...) { - if (is.null(method)) { - method <- "wald" - } - - method <- match.arg(tolower(method), choices = c("analytical", "any", "fit", "wald", "residual", "normal")) - - if (method %in% c("wald", "residual", "fit")) { - model$df.residual - } else { - degrees_of_freedom.default(model, method = method, ...) - } -} diff --git a/R/methods_biglm.R b/R/methods_biglm.R index 56454116a..ddb9e47a1 100644 --- a/R/methods_biglm.R +++ b/R/methods_biglm.R @@ -8,12 +8,3 @@ standard_error.biglm <- function(model, ...) { SE = as.vector(cs[, 4]) ) } - - -#' @export -degrees_of_freedom.biglm <- function(model, method = NULL, ...) { - .degrees_of_freedom_no_dfresid_method(model, method) -} - -#' @export -degrees_of_freedom.bigglm <- degrees_of_freedom.biglm diff --git a/R/methods_brglm2.R b/R/methods_brglm2.R index 2b9eb4ca9..acfd9a1c5 100644 --- a/R/methods_brglm2.R +++ b/R/methods_brglm2.R @@ -15,6 +15,7 @@ model_parameters.bracl <- function(model, exponentiate = FALSE, p_adjust = NULL, summary = getOption("parameters_summary", FALSE), + include_info = getOption("parameters_info", FALSE), keep = NULL, drop = NULL, verbose = TRUE, @@ -27,6 +28,12 @@ model_parameters.bracl <- function(model, verbose = verbose ) + ## TODO remove deprecated later + if (!missing(summary)) { + .deprecated_warning("summary", "include_info", verbose) + include_info <- summary + } + # detect number of levels of response resp <- insight::get_response(model) @@ -56,7 +63,7 @@ model_parameters.bracl <- function(model, p_adjust = p_adjust, keep_parameters = keep, drop_parameters = drop, - summary = summary, + include_info = include_info, vcov = NULL, vcov_args = NULL ) @@ -153,10 +160,17 @@ model_parameters.multinom <- function(model, exponentiate = FALSE, p_adjust = NULL, summary = getOption("parameters_summary", FALSE), + include_info = getOption("parameters_info", FALSE), keep = NULL, drop = NULL, verbose = TRUE, ...) { + ## TODO remove deprecated later + if (!missing(summary)) { + .deprecated_warning("summary", "include_info", verbose) + include_info <- summary + } + model_parameters.bracl( model, ci = ci, @@ -166,7 +180,7 @@ model_parameters.multinom <- function(model, standardize = standardize, exponentiate = exponentiate, p_adjust = p_adjust, - summary = summary, + include_info = include_info, keep = keep, drop = drop, verbose = verbose, @@ -181,19 +195,6 @@ ci.multinom <- function(x, ci = 0.95, method = "normal", verbose = TRUE, ...) { } -#' @export -degrees_of_freedom.multinom <- function(model, method = NULL, ...) { - if (is.null(method) || identical(method, "normal")) { - Inf - } else { - insight::n_obs(model) - model$edf - } -} - -#' @export -degrees_of_freedom.nnet <- degrees_of_freedom.multinom - - #' @export standard_error.multinom <- function(model, ...) { se <- tryCatch( diff --git a/R/methods_car.R b/R/methods_car.R index 0284cb283..3d2502cbc 100644 --- a/R/methods_car.R +++ b/R/methods_car.R @@ -46,7 +46,7 @@ model_parameters.deltaMethod <- function(model, p_adjust = NULL, verbose = TRUE, iterations = NULL, ci_method = "residual", p_adjust = p_adjust, - summary = FALSE, + include_info = FALSE, verbose = verbose ) fun_args <- c(fun_args, dots) diff --git a/R/methods_cgam.R b/R/methods_cgam.R index a70416cd2..0204efa0f 100644 --- a/R/methods_cgam.R +++ b/R/methods_cgam.R @@ -166,38 +166,3 @@ standard_error.cgam <- function(model, ...) { Component = params$Component ) } - - -#' @export -degrees_of_freedom.cgam <- function(model, method = "wald", ...) { - if (is.null(method)) { - method <- "wald" - } - method <- match.arg(tolower(method), choices = c("analytical", "any", "fit", "wald", "residual", "normal")) - - if (method %in% c("wald", "residual", "fit")) { - stats::df.residual(model) - } else { - degrees_of_freedom.default(model, method = method, ...) - } -} - - -#' @export -degrees_of_freedom.cgamm <- function(model, method = "wald", ...) { - if (is.null(method)) { - method <- "wald" - } - method <- match.arg(tolower(method), choices = c("analytical", "any", "fit", "wald", "residual", "normal")) - - if (method %in% c("wald", "residual", "fit")) { - dof <- model$resid_df_obs - if (is.null(dof)) { - dof <- degrees_of_freedom.default(model, method = method, ...) - } - } else { - dof <- degrees_of_freedom.default(model, method = method, ...) - } - - dof -} diff --git a/R/methods_coxme.R b/R/methods_coxme.R index 9bd652b47..ede50ca14 100644 --- a/R/methods_coxme.R +++ b/R/methods_coxme.R @@ -1,10 +1,10 @@ #' @export standard_error.coxme <- function(model, ...) { - beta <- model$coefficients + beta_coef <- model$coefficients - if (length(beta) > 0) { + if (length(beta_coef) > 0) { .data_frame( - Parameter = .remove_backticks_from_string(names(beta)), + Parameter = .remove_backticks_from_string(names(beta_coef)), SE = sqrt(diag(stats::vcov(model))) ) } diff --git a/R/methods_cplm.R b/R/methods_cplm.R index 3ba6bf0ee..ad8efa25f 100644 --- a/R/methods_cplm.R +++ b/R/methods_cplm.R @@ -36,9 +36,10 @@ model_parameters.zcpglm <- function(model, standardize = NULL, exponentiate = FALSE, p_adjust = NULL, + summary = getOption("parameters_summary", FALSE), + include_info = getOption("parameters_info", FALSE), keep = NULL, drop = NULL, - summary = getOption("parameters_summary", FALSE), verbose = TRUE, ...) { component <- match.arg(component) @@ -48,6 +49,11 @@ model_parameters.zcpglm <- function(model, component <- "conditional" } + ## TODO remove deprecated later + if (!missing(summary)) { + .deprecated_warning("summary", "include_info", verbose) + include_info <- summary + } # Processing if (bootstrap) { @@ -75,7 +81,7 @@ model_parameters.zcpglm <- function(model, ci, exponentiate, p_adjust = p_adjust, - summary = summary, + include_info = include_info, verbose = verbose, ... ) diff --git a/R/methods_effect_size.R b/R/methods_effect_size.R index 579477b25..06896670c 100644 --- a/R/methods_effect_size.R +++ b/R/methods_effect_size.R @@ -17,21 +17,21 @@ ci.parameters_standardized <- function(x, ci = 0.95, verbose = TRUE, ...) { # check if we have model. if so, use df from model model <- .get_object(x) if (!is.null(model)) { - df <- degrees_of_freedom(model, method = "any") - if (!is.null(df)) { - if (length(df) > 1 && length(df) != nrow(x)) { - df <- Inf + dof <- insight::get_df(model, type = "wald") + if (!is.null(dof)) { + if (length(dof) > 1 && length(dof) != nrow(x)) { + dof <- Inf } } else { - df <- Inf + dof <- Inf } } else { - df <- Inf + dof <- Inf } out <- lapply(ci, function(i) { alpha <- (1 + i) / 2 - fac <- stats::qt(alpha, df = df) + fac <- stats::qt(alpha, df = dof) data.frame( Parameter = x$Parameter, CI = i, diff --git a/R/methods_emmeans.R b/R/methods_emmeans.R index 0c5e1bb84..c8ed97188 100644 --- a/R/methods_emmeans.R +++ b/R/methods_emmeans.R @@ -27,23 +27,7 @@ model_parameters.emmGrid <- function(model, s <- summary(model, level = ci, adjust = "none") params <- as.data.frame(s) - # we assume frequentist here... - if (!.is_bayesian_emmeans(model)) { - # get statistic, se and p - statistic <- insight::get_statistic(model, ci = ci, adjust = "none") - SE <- standard_error(model) - p <- p_value(model, ci = ci, adjust = "none") - - params$Statistic <- statistic$Statistic - params$SE <- SE$SE - params$p <- p$p - - # ==== adjust p-values? - - if (!is.null(p_adjust)) { - params <- .p_adjust(params, p_adjust, model, verbose) - } - } else { + if (.is_bayesian_emmeans(model)) { # Bayesian models go here... params <- bayestestR::describe_posterior( model, @@ -60,8 +44,22 @@ model_parameters.emmGrid <- function(model, verbose = verbose, ... ) - statistic <- NULL + } else { + # we assume frequentist here... + statistic <- insight::get_statistic(model, ci = ci, adjust = "none") + SE <- standard_error(model) + p <- p_value(model, ci = ci, adjust = "none") + + params$Statistic <- statistic$Statistic + params$SE <- SE$SE + params$p <- p$p + + # ==== adjust p-values? + + if (!is.null(p_adjust)) { + params <- .p_adjust(params, p_adjust, model, verbose) + } } @@ -88,11 +86,11 @@ model_parameters.emmGrid <- function(model, if (!any(startsWith(colnames(params), "CI_"))) { df_column <- grep("(df|df_error)", colnames(params)) if (length(df_column) > 0) { - df <- params[[df_column[1]]] + dof <- params[[df_column[1]]] } else { - df <- Inf + dof <- Inf } - fac <- stats::qt((1 + ci) / 2, df = df) + fac <- stats::qt((1 + ci) / 2, df = dof) params$CI_low <- params$Estimate - fac * params$SE params$CI_high <- params$Estimate + fac * params$SE } @@ -105,12 +103,12 @@ model_parameters.emmGrid <- function(model, # Reorder estimate_pos <- which(colnames(s) == estName) parameter_names <- colnames(params)[seq_len(estimate_pos - 1)] - order <- c( + col_order <- c( parameter_names, "Estimate", "Median", "Mean", "SE", "SD", "MAD", "CI_low", "CI_high", "F", "t", "z", "df", "df_error", "p", "pd", "ROPE_CI", "ROPE_low", "ROPE_high", "ROPE_Percentage" ) - params <- params[order[order %in% names(params)]] + params <- params[col_order[col_order %in% names(params)]] # rename names(params) <- gsub("Estimate", "Coefficient", names(params), fixed = TRUE) @@ -174,7 +172,15 @@ model_parameters.emm_list <- function(model, # exponentiate coefficients and SE/CI, if requested params <- .exponentiate_parameters(params, model, exponentiate) - params <- .add_model_parameters_attributes(params, model, ci, exponentiate, p_adjust = p_adjust, verbose = verbose, ...) + params <- .add_model_parameters_attributes( + params, + model, + ci, + exponentiate, + p_adjust = p_adjust, + verbose = verbose, + ... + ) attr(params, "object_name") <- insight::safe_deparse_symbol(substitute(model)) class(params) <- c("parameters_model", "see_parameters_model", class(params)) @@ -210,12 +216,12 @@ model_parameters.summary_emm <- function(model, # Reorder estimate_pos <- which(colnames(model) == estName) parameter_names <- colnames(params)[seq_len(estimate_pos - 1)] - order <- c( + col_order <- c( parameter_names, "Estimate", "Median", "Mean", "SE", "SD", "MAD", "CI_low", "CI_high", "F", "t", "z", "df", "df_error", "p", "pd", "ROPE_CI", "ROPE_low", "ROPE_high", "ROPE_Percentage" ) - params <- params[order[order %in% names(params)]] + params <- params[col_order[col_order %in% names(params)]] # rename names(params) <- gsub("Estimate", "Coefficient", names(params), fixed = TRUE) @@ -315,42 +321,6 @@ boot_em_standard_error <- function(model) { - -# degrees of freedom -------------------- - - -#' @export -degrees_of_freedom.emmGrid <- function(model, ...) { - if (!is.null(model@misc$is_boot) && model@misc$is_boot) { - return(boot_em_df(model)) - } - - summary(model)$df -} - - -#' @export -degrees_of_freedom.emm_list <- function(model, ...) { - if (!is.null(model[[1]]@misc$is_boot) && model[[1]]@misc$is_boot) { - return(boot_em_df(model)) - } - - s <- summary(model) - unlist(lapply(s, function(i) { - if (is.null(i$df)) { - rep(Inf, nrow(i)) - } else { - i$df - } - }), use.names = FALSE) -} - -boot_em_df <- function(model) { - est <- insight::get_parameters(model, summary = FALSE) - rep(NA, ncol(est)) -} - - # p values ---------------------- @@ -361,21 +331,20 @@ p_value.emmGrid <- function(model, ci = 0.95, adjust = "none", ...) { return(boot_em_pval(model, adjust)) } - s <- summary(model, level = ci, adjust = adjust) estimate_pos <- which(colnames(s) == attr(s, "estName")) - if (length(estimate_pos)) { - stat <- insight::get_statistic(model, ci = ci, adjust = adjust) - p <- 2 * stats::pt(abs(stat$Statistic), df = s$df, lower.tail = FALSE) - - .data_frame( - Parameter = .pretty_emmeans_Parameter_names(model), - p = as.vector(p) - ) - } else { + if (!length(estimate_pos)) { return(NULL) } + + stat <- insight::get_statistic(model, ci = ci, adjust = adjust) + p <- 2 * stats::pt(abs(stat$Statistic), df = s$df, lower.tail = FALSE) + + .data_frame( + Parameter = .pretty_emmeans_Parameter_names(model), + p = as.vector(p) + ) } @@ -418,8 +387,8 @@ p_value.emm_list <- function(model, adjust = "none", ...) { # test statistic and p-values stat <- params$Estimate / se - df <- degrees_of_freedom(model) - p_val <- 2 * stats::pt(abs(stat), df = df, lower.tail = FALSE) + dof <- insight::get_df(model) + p_val <- 2 * stats::pt(abs(stat), df = dof, lower.tail = FALSE) out$p[is.na(out$p)] <- p_val[is.na(out$p)] } diff --git a/R/methods_fixest.R b/R/methods_fixest.R index bb2a04d17..7bfc9a945 100644 --- a/R/methods_fixest.R +++ b/R/methods_fixest.R @@ -9,12 +9,13 @@ model_parameters.fixest <- function(model, standardize = NULL, exponentiate = FALSE, p_adjust = NULL, + vcov = NULL, + vcov_args = NULL, summary = getOption("parameters_summary", FALSE), + include_info = getOption("parameters_info", FALSE), keep = NULL, drop = NULL, verbose = TRUE, - vcov = NULL, - vcov_args = NULL, ...) { # default ci-method, based on statistic if (is.null(ci_method)) { @@ -25,6 +26,12 @@ model_parameters.fixest <- function(model, } } + ## TODO remove deprecated later + if (!missing(summary)) { + .deprecated_warning("summary", "include_info", verbose) + include_info <- summary + } + # extract model parameters table, as data frame out <- tryCatch( { @@ -38,7 +45,7 @@ model_parameters.fixest <- function(model, standardize = standardize, exponentiate = exponentiate, p_adjust = p_adjust, - summary = summary, + include_info = include_info, keep_parameters = keep, drop_parameters = drop, vcov = vcov, @@ -65,14 +72,14 @@ model_parameters.fixest <- function(model, standard_error.fixest <- function(model, vcov = NULL, vcov_args = NULL, ...) { params <- insight::get_parameters(model) - if (!is.null(vcov)) { + if (is.null(vcov)) { + stats <- summary(model) + SE <- as.vector(stats$se) + } else { # we don't want to wrap this in a tryCatch because the `fixest` error is # informative when `vcov` is wrong. V <- insight::get_varcov(model, vcov = vcov, vcov_args = vcov_args) SE <- sqrt(diag(V)) - } else { - stats <- summary(model) - SE <- as.vector(stats$se) } .data_frame( @@ -82,34 +89,6 @@ standard_error.fixest <- function(model, vcov = NULL, vcov_args = NULL, ...) { } -#' @export -degrees_of_freedom.fixest <- function(model, method = "wald", ...) { - # fixest degrees of freedom can be tricky. best to use the function by the - # package. - insight::check_if_installed("fixest") - if (is.null(method)) { - method <- "wald" - } - method <- match.arg( - tolower(method), - choices = c("wald", "residual", "normal") - ) - - # we may have Inf DF, too - if (method == "normal") { - return(Inf) - } - - method <- switch(method, - wald = "t", - residual = "resid" - ) - fixest::degrees_freedom(model, type = method) -} - - - - # .feglm ----------------------- #' @export @@ -152,13 +131,20 @@ model_parameters.fixest_multi <- function(model, standardize = NULL, exponentiate = FALSE, p_adjust = NULL, + vcov = NULL, + vcov_args = NULL, summary = getOption("parameters_summary", FALSE), + include_info = getOption("parameters_info", FALSE), keep = NULL, drop = NULL, verbose = TRUE, - vcov = NULL, - vcov_args = NULL, ...) { + ## TODO remove deprecated later + if (!missing(summary)) { + .deprecated_warning("summary", "include_info", verbose) + include_info <- summary + } + # iterate over responses out <- lapply( model, @@ -170,7 +156,7 @@ model_parameters.fixest_multi <- function(model, standardize = standardize, exponentiate = exponentiate, p_adjust = p_adjust, - summary = summary, + include_info = include_info, keep = keep, drop = drop, verbose = verbose, @@ -226,22 +212,6 @@ standard_error.fixest_multi <- function(model, ...) { } -#' @export -degrees_of_freedom.fixest_multi <- function(model, ...) { - out <- do.call(rbind, lapply(model, degrees_of_freedom, ...)) - - # add response and group columns - id_columns <- .get_fixest_multi_columns(model) - - # add response column - out$Response <- id_columns$Response - out$Group <- id_columns$Group - - row.names(out) <- NULL - out -} - - #' @export p_value.fixest_multi <- function(model, ...) { out <- do.call(rbind, lapply(model, p_value, ...)) diff --git a/R/methods_flexsurvreg.R b/R/methods_flexsurvreg.R index 8cf8c9113..c213abec4 100644 --- a/R/methods_flexsurvreg.R +++ b/R/methods_flexsurvreg.R @@ -17,7 +17,7 @@ p_value.flexsurvreg <- function(model, ...) { params <- insight::get_parameters(model) est <- params$Estimate se <- standard_error(model)$SE - p <- 2 * stats::pt(abs(est / se), df = degrees_of_freedom(model, method = "any"), lower.tail = FALSE) + p <- 2 * stats::pt(abs(est / se), df = insight::get_df(x = model, type = "wald"), lower.tail = FALSE) .data_frame( Parameter = params$Parameter, p = as.vector(p) diff --git a/R/methods_gee.R b/R/methods_gee.R index cc0723edc..9dcaa3b65 100644 --- a/R/methods_gee.R +++ b/R/methods_gee.R @@ -26,13 +26,13 @@ p_value.gee <- function(model, method = NULL, ...) { if (isTRUE(list(...)$robust) || "vcov" %in% names(list(...))) { p <- 2 * stats::pt( abs(cs[, "Estimate"] / cs[, "Robust S.E."]), - df = degrees_of_freedom(model, method = method), + df = insight::get_df(x = model, type = method), lower.tail = FALSE ) } else { p <- 2 * stats::pt( abs(cs[, "Estimate"] / cs[, "Naive S.E."]), - df = degrees_of_freedom(model, method = method), + df = insight::get_df(x = model, type = method), lower.tail = FALSE ) } @@ -56,7 +56,7 @@ p_value.geeglm <- function(model, method = "wald", ...) { if (!is.null(stat)) { if (identical(method, "residual")) { - dof <- degrees_of_freedom(model, method = "residual") + dof <- insight::get_df(model, type = "residual") p <- as.vector(2 * stats::pt( sqrt(abs(stat$Statistic)), df = dof, diff --git a/R/methods_glmgee.R b/R/methods_glmgee.R new file mode 100644 index 000000000..82b8e5b58 --- /dev/null +++ b/R/methods_glmgee.R @@ -0,0 +1,68 @@ +#' @export +standard_error.glmgee <- function(model, + vcov = c("robust", "df-adjusted", "model", "bias-corrected", "jackknife"), + verbose = TRUE, + ...) { + vcov <- match.arg(vcov) + se <- NULL + + .vcov <- insight::get_varcov( + model, + vcov = vcov, + verbose = verbose, + ... + ) + se <- sqrt(diag(.vcov)) + .data_frame(Parameter = names(se), SE = as.vector(se)) +} + + +#' @export +p_value.glmgee <- function(model, + method = NULL, + vcov = c("robust", "df-adjusted", "model", "bias-corrected", "jackknife"), + ...) { + vcov <- match.arg(vcov) + est <- insight::get_parameters(model, component = "conditional") + se <- standard_error(model, vcov = vcov, verbose = FALSE) + + if (is.null(method)) { + method <- "wald" + } + + p <- 2 * stats::pt( + abs(est$Estimate / se$SE), + df = insight::get_df(x = model, type = method), + lower.tail = FALSE + ) + + .data_frame( + Parameter = est$Parameter, + p = as.vector(p) + ) +} + + +#' @export +ci.glmgee <- function(x, + ci = 0.95, + dof = NULL, + method = NULL, + vcov = c("robust", "df-adjusted", "model", "bias-corrected", "jackknife"), + verbose = TRUE, + ...) { + vcov <- match.arg(vcov) + out <- .ci_generic( + model = x, + ci = ci, + dof = dof, + method = method, + vcov = vcov, + vcov_args = NULL, + component = "conditional", + verbose = verbose + ) + # Return the CI bounds as a data frame. + row.names(out) <- NULL + out +} diff --git a/R/methods_glmmTMB.R b/R/methods_glmmTMB.R index 291a4ca7a..26ad72dd1 100644 --- a/R/methods_glmmTMB.R +++ b/R/methods_glmmTMB.R @@ -21,13 +21,20 @@ model_parameters.glmmTMB <- function(model, p_adjust = NULL, wb_component = TRUE, summary = getOption("parameters_mixed_summary", FALSE), + include_info = getOption("parameters_mixed_info", FALSE), + include_sigma = FALSE, keep = NULL, drop = NULL, verbose = TRUE, - include_sigma = FALSE, ...) { insight::check_if_installed("glmmTMB") + ## TODO remove deprecated later + if (!missing(summary)) { + .deprecated_warning("summary", "include_info", verbose) + include_info <- summary + } + # validation check, warn if unsupported argument is used. dot_args <- .check_dots( dots = list(...), @@ -98,7 +105,7 @@ model_parameters.glmmTMB <- function(model, keep_component_column = component != "conditional", include_sigma = include_sigma, wb_component = wb_component, - summary = summary + include_info = include_info ) fun_args <- c(fun_args, dot_args) params <- do.call(".extract_parameters_generic", fun_args) @@ -236,7 +243,7 @@ model_parameters.glmmTMB <- function(model, p_adjust = p_adjust, verbose = verbose, group_level = group_level, - summary = summary, + include_info = include_info, wb_component = wb_component, ... ) diff --git a/R/methods_hglm.R b/R/methods_hglm.R index 4f237e112..a8f27fea7 100644 --- a/R/methods_hglm.R +++ b/R/methods_hglm.R @@ -23,6 +23,7 @@ model_parameters.hglm <- function(model, component = "all", p_adjust = NULL, summary = getOption("parameters_summary", FALSE), + include_info = getOption("parameters_info", FALSE), keep = NULL, drop = NULL, verbose = TRUE, @@ -31,13 +32,19 @@ model_parameters.hglm <- function(model, effects <- match.arg(effects, choices = c("fixed", "random", "all")) component <- match.arg(component, choices = c("all", "conditional", "dispersion")) + ## TODO remove deprecated later + if (!missing(summary)) { + .deprecated_warning("summary", "include_info", verbose) + include_info <- summary + } + # fixed effects mp <- model_parameters.default( model, ci = ci, ci_method = ci_method, bootstrap = bootstrap, effects = "fixed", component = "conditional", iterations = iterations, - exponentiate = exponentiate, p_adjust = p_adjust, summary = summary, + exponentiate = exponentiate, p_adjust = p_adjust, include_info = include_info, keep = keep, drop = drop, verbose = verbose, ... ) @@ -154,15 +161,6 @@ standard_error.hglm <- function(model, } -#' @export -degrees_of_freedom.hglm <- function(model, method = "residual", ...) { - if (method == "any") { - method <- "residual" - } - insight::get_df(model, type = method, ...) -} - - #' @export ci.hglm <- function(x, ci = 0.95, diff --git a/R/methods_htest.R b/R/methods_htest.R index 4d4648025..4cf38ba3f 100644 --- a/R/methods_htest.R +++ b/R/methods_htest.R @@ -8,8 +8,6 @@ #' only applies to objects from `chisq.test()` or `oneway.test()`. #' @inheritParams model_parameters.default #' @inheritParams model_parameters.aov -#' @param cramers_v,phi,cohens_g,standardized_d,hedges_g,omega_squared,eta_squared,epsilon_squared,rank_biserial,rank_epsilon_squared,kendalls_w Deprecated. Please use `effectsize_type`. -#' #' @inherit effectsize::effectsize details #' #' @examples @@ -18,13 +16,13 @@ #' model_parameters(model) #' #' model <- t.test(iris$Sepal.Width, iris$Sepal.Length) -#' model_parameters(model, effectsize_type = "hedges_g") +#' model_parameters(model, es_type = "hedges_g") #' #' model <- t.test(mtcars$mpg ~ mtcars$vs) -#' model_parameters(model, effectsize_type = "hedges_g") +#' model_parameters(model, es_type = "hedges_g") #' #' model <- t.test(iris$Sepal.Width, mu = 1) -#' model_parameters(model, effectsize_type = "cohens_d") +#' model_parameters(model, es_type = "cohens_d") #' #' data(airquality) #' airquality$Month <- factor(airquality$Month, labels = month.abb[5:9]) @@ -37,7 +35,7 @@ #' model_parameters(model) #' #' model <- suppressWarnings(chisq.test(table(mtcars$am, mtcars$cyl))) -#' model_parameters(model, effectsize_type = "cramers_v") +#' model_parameters(model, es_type = "cramers_v") #' #' @return A data frame of indices related to the model's parameters. #' @@ -46,41 +44,15 @@ model_parameters.htest <- function(model, ci = 0.95, alternative = NULL, bootstrap = FALSE, - effectsize_type = NULL, + es_type = NULL, verbose = TRUE, - cramers_v = NULL, - phi = NULL, - standardized_d = NULL, - hedges_g = NULL, - omega_squared = NULL, - eta_squared = NULL, - epsilon_squared = NULL, - cohens_g = NULL, - rank_biserial = NULL, - rank_epsilon_squared = NULL, - kendalls_w = NULL, ...) { - ## TODO: remove in a later update - # handle deprected arguments ------ - if (!is.null(cramers_v)) effectsize_type <- "cramers_v" - if (!is.null(phi)) effectsize_type <- "phi" - if (!is.null(standardized_d)) effectsize_type <- "standardized_d" - if (!is.null(hedges_g)) effectsize_type <- "hedges_g" - if (!is.null(omega_squared)) effectsize_type <- "omega_squared" - if (!is.null(eta_squared)) effectsize_type <- "eta_squared" - if (!is.null(epsilon_squared)) effectsize_type <- "epsilon_squared" - if (!is.null(cohens_g)) effectsize_type <- "cohens_g" - if (!is.null(rank_biserial)) effectsize_type <- "rank_biserial" - if (!is.null(rank_epsilon_squared)) effectsize_type <- "rank_epsilon_squared" - if (!is.null(kendalls_w)) effectsize_type <- "rank_epsilon_squared" - - if (bootstrap) { insight::format_error("Bootstrapped h-tests are not yet implemented.") } else { parameters <- .extract_parameters_htest( model, - effectsize_type = effectsize_type, + es_type = es_type, ci = ci, alternative = alternative, verbose = verbose, @@ -149,14 +121,17 @@ model_parameters.svytable <- function(model, verbose = TRUE, ...) { #' @keywords internal .extract_parameters_htest <- function(model, - effectsize_type = NULL, + es_type = NULL, ci = 0.95, alternative = NULL, verbose = TRUE, ...) { m_info <- insight::model_info(model, verbose = FALSE) - if (m_info$is_correlation) { + if (!is.null(model$method) && startsWith(model$method, "Box-")) { + # Box-Pierce --------- + out <- .extract_htest_boxpierce(model) + } else if (m_info$is_correlation) { # correlation --------- out <- .extract_htest_correlation(model) } else if (.is_levenetest(model)) { @@ -189,7 +164,7 @@ model_parameters.svytable <- function(model, verbose = TRUE, ...) { out <- .add_effectsize_htest(model, out, - effectsize_type = effectsize_type, + es_type = es_type, ci = ci, alternative = alternative, verbose = verbose, @@ -203,14 +178,30 @@ model_parameters.svytable <- function(model, verbose = TRUE, ...) { +# extract htest Box-Pierce ---------------------- + +#' @keywords internal +.extract_htest_boxpierce <- function(model) { + data.frame( + Parameter = model$data.name, + Chi2 = model$statistic, + df_error = model$parameter, + p = model$p.value, + Method = model$method, + stringsAsFactors = FALSE + ) +} + + + # extract htest correlation ---------------------- #' @keywords internal .extract_htest_correlation <- function(model) { - names <- unlist(strsplit(model$data.name, " (and|by) ")) + data_names <- unlist(strsplit(model$data.name, " (and|by) ")) out <- data.frame( - Parameter1 = names[1], - Parameter2 = names[2], + Parameter1 = data_names[1], + Parameter2 = data_names[2], stringsAsFactors = FALSE ) @@ -258,10 +249,10 @@ model_parameters.svytable <- function(model, verbose = TRUE, ...) { .extract_htest_ranktest <- function(model) { # survey if (grepl("design-based", tolower(model$method), fixed = TRUE)) { - names <- gsub("~", "", unlist(strsplit(model$data.name, " + ", fixed = TRUE)), fixed = TRUE) + data_names <- gsub("~", "", unlist(strsplit(model$data.name, " + ", fixed = TRUE)), fixed = TRUE) out <- data.frame( - Parameter1 = names[1], - Parameter2 = names[2], + Parameter1 = data_names[1], + Parameter2 = data_names[2], Statistic = model$statistic[[1]], df_error = model$parameter[[1]], Method = model$method, @@ -272,10 +263,10 @@ model_parameters.svytable <- function(model, verbose = TRUE, ...) { colnames(out)[colnames(out) == "Statistic"] <- names(model$statistic)[1] } else { if (grepl(" (and|by) ", model$data.name)) { - names <- unlist(strsplit(model$data.name, " (and|by) ")) + data_names <- unlist(strsplit(model$data.name, " (and|by) ")) out <- data.frame( - Parameter1 = names[1], - Parameter2 = names[2], + Parameter1 = data_names[1], + Parameter2 = data_names[2], stringsAsFactors = FALSE ) } else { @@ -312,7 +303,7 @@ model_parameters.svytable <- function(model, verbose = TRUE, ...) { data.frame( df = model$Df[1], df_error = model$Df[2], - `F` = model$`F value`[1], + `F` = model$`F value`[1], # nolint p = model$`Pr(>F)`[1], Method = "Levene's Test for Homogeneity of Variance", stringsAsFactors = FALSE @@ -331,7 +322,7 @@ model_parameters.svytable <- function(model, verbose = TRUE, ...) { Estimate = model$estimate, df = model$parameter[1], df_error = model$parameter[2], - `F` = model$statistic, + `F` = model$statistic, # nolint CI_low = model$conf.int[1], CI_high = model$conf.int[2], p = model$p.value, @@ -349,10 +340,10 @@ model_parameters.svytable <- function(model, verbose = TRUE, ...) { .extract_htest_ttest <- function(model, standardized_d = NULL, hedges_g = NULL) { # survey if (grepl("design-based", tolower(model$method), fixed = TRUE)) { - names <- unlist(strsplit(model$data.name, " ~ ", fixed = TRUE)) + data_names <- unlist(strsplit(model$data.name, " ~ ", fixed = TRUE)) out <- data.frame( - Parameter1 = names[1], - Parameter2 = names[2], + Parameter1 = data_names[1], + Parameter2 = data_names[2], Difference = model$estimate[[1]], t = model$statistic[[1]], df_error = model$parameter[[1]], @@ -365,10 +356,10 @@ model_parameters.svytable <- function(model, verbose = TRUE, ...) { } else { paired_test <- startsWith(model$method, "Paired") && length(model$estimate) == 1 if (grepl(" and ", model$data.name, fixed = TRUE) && isFALSE(paired_test)) { - names <- unlist(strsplit(model$data.name, " and ", fixed = TRUE)) + data_names <- unlist(strsplit(model$data.name, " and ", fixed = TRUE)) out <- data.frame( - Parameter1 = names[1], - Parameter2 = names[2], + Parameter1 = data_names[1], + Parameter2 = data_names[2], Mean_Parameter1 = model$estimate[1], Mean_Parameter2 = model$estimate[2], Difference = model$estimate[1] - model$estimate[2], @@ -382,10 +373,10 @@ model_parameters.svytable <- function(model, verbose = TRUE, ...) { ) attr(out, "mean_group_values") <- gsub("mean in group ", "", names(model$estimate), fixed = TRUE) } else if (isTRUE(paired_test)) { - names <- unlist(strsplit(model$data.name, " (and|by) ")) + data_names <- unlist(strsplit(model$data.name, " (and|by) ")) out <- data.frame( - Parameter = names[1], - Group = names[2], + Parameter = data_names[1], + Group = data_names[2], Difference = model$estimate, t = model$statistic, df_error = model$parameter, @@ -397,10 +388,10 @@ model_parameters.svytable <- function(model, verbose = TRUE, ...) { ) } else if (grepl(" by ", model$data.name, fixed = TRUE)) { if (length(model$estimate) == 1) { - names <- unlist(strsplit(model$data.name, " by ", fixed = TRUE)) + data_names <- unlist(strsplit(model$data.name, " by ", fixed = TRUE)) out <- data.frame( - Parameter = names[1], - Group = names[2], + Parameter = data_names[1], + Group = data_names[2], Difference = model$estimate, CI = 0.95, CI_low = as.vector(model$conf.int[, 1]), @@ -412,10 +403,10 @@ model_parameters.svytable <- function(model, verbose = TRUE, ...) { stringsAsFactors = FALSE ) } else { - names <- unlist(strsplit(model$data.name, " by ", fixed = TRUE)) + data_names <- unlist(strsplit(model$data.name, " by ", fixed = TRUE)) out <- data.frame( - Parameter = names[1], - Group = names[2], + Parameter = data_names[1], + Group = data_names[2], Mean_Group1 = model$estimate[1], Mean_Group2 = model$estimate[2], Difference = model$estimate[1] - model$estimate[2], @@ -458,7 +449,7 @@ model_parameters.svytable <- function(model, verbose = TRUE, ...) { #' @keywords internal .extract_htest_oneway <- function(model) { data.frame( - `F` = model$statistic, + `F` = model$statistic, # nolint df = model$parameter[1], df_error = model$parameter[2], p = model$p.value, @@ -482,7 +473,7 @@ model_parameters.svytable <- function(model, verbose = TRUE, ...) { } if (names(model$statistic) == "F") { data.frame( - `F` = model$statistic, + `F` = model$statistic, # nolint df = model$parameter[1], df_error = model$parameter[2], p = model$p.value, @@ -498,27 +489,25 @@ model_parameters.svytable <- function(model, verbose = TRUE, ...) { stringsAsFactors = FALSE ) } + } else if (!is.null(model$estimate) && identical(names(model$estimate), "odds ratio")) { + data.frame( + `Odds Ratio` = model$estimate, + # CI = attributes(model$conf.int)$conf.level, + CI_low = model$conf.int[1], + CI_high = model$conf.int[2], + p = model$p.value, + Method = model$method, + stringsAsFactors = FALSE, + check.names = FALSE + ) } else { - if (!is.null(model$estimate) && identical(names(model$estimate), "odds ratio")) { - data.frame( - `Odds Ratio` = model$estimate, - # CI = attributes(model$conf.int)$conf.level, - CI_low = model$conf.int[1], - CI_high = model$conf.int[2], - p = model$p.value, - Method = model$method, - stringsAsFactors = FALSE, - check.names = FALSE - ) - } else { - data.frame( - Chi2 = model$statistic, - df = model$parameter, - p = model$p.value, - Method = model$method, - stringsAsFactors = FALSE - ) - } + data.frame( + Chi2 = model$statistic, + df = model$parameter, + p = model$p.value, + Method = model$method, + stringsAsFactors = FALSE + ) } } @@ -530,7 +519,7 @@ model_parameters.svytable <- function(model, verbose = TRUE, ...) { #' @keywords internal .extract_htest_prop <- function(model) { out <- data.frame( - Proportion = paste0(insight::format_value(model$estimate, as_percent = TRUE), collapse = " / "), + Proportion = paste(insight::format_value(model$estimate, as_percent = TRUE), collapse = " / "), stringsAsFactors = FALSE ) if (length(model$estimate) == 2) { @@ -579,13 +568,20 @@ model_parameters.svytable <- function(model, verbose = TRUE, ...) { .add_effectsize_htest <- function(model, out, - effectsize_type = NULL, + es_type = NULL, ci = 0.95, alternative = NULL, verbose = TRUE, ...) { # check if effect sizes are requested - if (!requireNamespace("effectsize", quietly = TRUE) || is.null(effectsize_type)) { + if (!requireNamespace("effectsize", quietly = TRUE) || is.null(es_type)) { + return(out) + } + + # return on invalid options. We may have partial matching with argument + # `effects` for `es_type`, and thus all "effects" options should be + # ignored. + if (es_type %in% c("fixed", "random", "all")) { return(out) } @@ -594,7 +590,7 @@ model_parameters.svytable <- function(model, verbose = TRUE, ...) { { effectsize::effectsize( model, - type = effectsize_type, + type = es_type, ci = ci, alternative = alternative, verbose = verbose, @@ -604,7 +600,7 @@ model_parameters.svytable <- function(model, verbose = TRUE, ...) { error = function(e) { if (verbose) { msg <- c( - paste0("Could not compute effectsize ", effectsize::get_effectsize_label(effectsize_type), "."), + paste0("Could not compute effectsize ", effectsize::get_effectsize_label(es_type), "."), paste0("Possible reason: ", e$message) ) insight::format_alert(msg) @@ -620,7 +616,7 @@ model_parameters.svytable <- function(model, verbose = TRUE, ...) { ## TODO: check if effectsize prefixes are correct @mattansb # Find prefix for CI-columns - prefix <- switch(effectsize_type, + prefix <- switch(es_type, cohens_g = "Cohens_", cramers_v = "Cramers_", phi = "phi_", @@ -667,24 +663,22 @@ model_parameters.svytable <- function(model, verbose = TRUE, ...) { if (!is.null(model$alternative)) { h1_text <- "Alternative hypothesis: " - if (!is.null(model$null.value)) { - if (length(model$null.value) == 1L) { - alt.char <- switch(model$alternative, - two.sided = "not equal to", - less = "less than", - greater = "greater than" - ) - h1_text <- paste0(h1_text, "true ", names(model$null.value), " is ", alt.char, " ", model$null.value) - } else { - h1_text <- paste0(h1_text, model$alternative) - } + if (is.null(model$null.value)) { + h1_text <- paste0(h1_text, model$alternative) + } else if (length(model$null.value) == 1L) { + alt.char <- switch(model$alternative, + two.sided = "not equal to", + less = "less than", + greater = "greater than" + ) + h1_text <- paste0(h1_text, "true ", names(model$null.value), " is ", alt.char, " ", model$null.value) } else { h1_text <- paste0(h1_text, model$alternative) } attr(params, "text_alternative") <- h1_text } - dot.arguments <- lapply(match.call(expand.dots = FALSE)$`...`, function(x) x) + dot.arguments <- lapply(match.call(expand.dots = FALSE)[["..."]], function(x) x) if ("digits" %in% names(dot.arguments)) { attr(params, "digits") <- eval(dot.arguments[["digits"]]) } else { @@ -731,7 +725,7 @@ model_parameters.svytable <- function(model, verbose = TRUE, ...) { p_adjust = NULL, verbose = TRUE, ...) { - dot.arguments <- lapply(match.call(expand.dots = FALSE)$`...`, function(x) x) + dot.arguments <- lapply(match.call(expand.dots = FALSE)[["..."]], function(x) x) attr(params, "p_adjust") <- p_adjust attr(params, "model_class") <- class(model) diff --git a/R/methods_ivfixed.R b/R/methods_ivfixed.R index 6c175646c..25cb92734 100644 --- a/R/methods_ivfixed.R +++ b/R/methods_ivfixed.R @@ -6,28 +6,17 @@ ci.ivFixed <- ci.default standard_error.ivFixed <- standard_error.coxr -#' @export -degrees_of_freedom.ivFixed <- function(model, method = "wald", ...) { - if (is.null(method)) { - method <- "wald" - } - method <- match.arg(tolower(method), choices = c("analytical", "any", "fit", "wald", "residual", "normal")) - - if (method %in% c("wald", "residual", "fit")) { - as.vector(model$df) - } else { - degrees_of_freedom.default(model, method = method, ...) - } -} - - #' @export p_value.ivFixed <- function(model, method = "wald", ...) { stat <- insight::get_statistic(model) if (!is.null(stat)) { .data_frame( Parameter = stat$Parameter, - p = as.vector(2 * stats::pt(abs(stat$Statistic), df = degrees_of_freedom(model, method = method), lower.tail = FALSE)) + p = as.vector(2 * stats::pt( + abs(stat$Statistic), + df = insight::get_df(model, type = method), + lower.tail = FALSE + )) ) } } diff --git a/R/methods_ivprobit.R b/R/methods_ivprobit.R index 826719b71..d2fe1cec4 100644 --- a/R/methods_ivprobit.R +++ b/R/methods_ivprobit.R @@ -2,11 +2,6 @@ ci.ivprobit <- ci.default - -#' @export -degrees_of_freedom.ivprobit <- degrees_of_freedom.ivFixed - - #' @export standard_error.ivprobit <- function(model, ...) { .data_frame( diff --git a/R/methods_kmeans.R b/R/methods_kmeans.R index 22b630f79..e28a7a11f 100644 --- a/R/methods_kmeans.R +++ b/R/methods_kmeans.R @@ -102,10 +102,12 @@ model_parameters.hkmeans <- model_parameters.kmeans #' @export print.parameters_clusters <- function(x, digits = 2, ...) { - title <- "# Clustering Solution" - if ("title" %in% attributes(x)) title <- attributes(x)$title + clusterHeading <- "# Clustering Solution" + if ("title" %in% attributes(x)) { + clusterHeading <- attributes(x)$title + } - insight::print_color(title, "blue") + insight::print_color(clusterHeading, "blue") cat("\n\n") insight::print_colour(.text_components_variance(x), "yellow") diff --git a/R/methods_lm.R b/R/methods_lm.R index 800776144..42c13e0d5 100644 --- a/R/methods_lm.R +++ b/R/methods_lm.R @@ -45,11 +45,5 @@ p_value.summary.lm <- function(model, ...) { #' @export ci.summary.lm <- function(x, ci = 0.95, method = "residual", ...) { - .ci_generic(model = x, ci = ci, method = method, dof = degrees_of_freedom(x), ...) -} - - -#' @export -degrees_of_freedom.summary.lm <- function(model, ...) { - model$fstatistic[3] + .ci_generic(model = x, ci = ci, method = method, dof = insight::get_df(x), ...) } diff --git a/R/methods_lme4.R b/R/methods_lme4.R index 854edd29a..4d55dac15 100644 --- a/R/methods_lme4.R +++ b/R/methods_lme4.R @@ -33,8 +33,20 @@ #' intervals will be included. Set explicitly to `TRUE` or `FALSE` to enforce #' or omit calculation of confidence intervals. #' @param ... Arguments passed to or from other methods. For instance, when -#' `bootstrap = TRUE`, arguments like `type` or `parallel` are -#' passed down to `bootstrap_model()`. +#' `bootstrap = TRUE`, arguments like `type` or `parallel` are passed down to +#' `bootstrap_model()`. Further non-documented arguments are `digits`, +#' `p_digits`, `ci_digits` and `footer_digits` to set the number of digits for +#' the output. If `s_value = TRUE`, the p-value will be replaced by the +#' S-value in the output (cf. _Rafi and Greenland 2020_). `pd` adds an +#' additional column with the _probability of direction_ (see +#' [`bayestestR::p_direction()`] for details). `groups` can be used to group +#' coefficients. It will be passed to the print-method, or can directly be +#' used in `print()`, see documentation in [`print.parameters_model()`]. +#' Furthermore, see 'Examples' in [`model_parameters.default()`]. For +#' developers, whose interest mainly is to get a "tidy" data frame of model +#' summaries, it is recommended to set `pretty_names = FALSE` to speed up +#' computation of the summary table. +#' #' @inheritParams model_parameters.default #' @inheritParams model_parameters.stanreg #' @@ -147,17 +159,24 @@ model_parameters.merMod <- function(model, group_level = FALSE, exponentiate = FALSE, p_adjust = NULL, + vcov = NULL, + vcov_args = NULL, wb_component = TRUE, summary = getOption("parameters_mixed_summary", FALSE), + include_info = getOption("parameters_mixed_info", FALSE), + include_sigma = FALSE, keep = NULL, drop = NULL, verbose = TRUE, - include_sigma = FALSE, - vcov = NULL, - vcov_args = NULL, ...) { dots <- list(...) + ## TODO remove deprecated later + if (!missing(summary)) { + .deprecated_warning("summary", "include_info", verbose) + include_info <- summary + } + # set default if (is.null(ci_method)) { if (isTRUE(bootstrap)) { @@ -236,7 +255,7 @@ model_parameters.merMod <- function(model, drop_parameters = drop, verbose = verbose, include_sigma = include_sigma, - summary = summary, + include_info = include_info, vcov = vcov, vcov_args = vcov_args ) @@ -301,7 +320,7 @@ model_parameters.merMod <- function(model, ci_method = ci_method, p_adjust = p_adjust, verbose = verbose, - summary = summary, + include_info = include_info, group_level = group_level, wb_component = wb_component, ... diff --git a/R/methods_lmtest.R b/R/methods_lmtest.R index c73d0a528..3809572e2 100644 --- a/R/methods_lmtest.R +++ b/R/methods_lmtest.R @@ -1,8 +1,3 @@ -#' @export -degrees_of_freedom.coeftest <- function(model, ...) { - attributes(model)$df -} - #' @export ci.coeftest <- ci.default diff --git a/R/methods_lqmm.R b/R/methods_lqmm.R index 5b3c8ecae..108af5274 100644 --- a/R/methods_lqmm.R +++ b/R/methods_lqmm.R @@ -67,17 +67,6 @@ standard_error.lqmm <- function(model, ...) { standard_error.lqm <- standard_error.lqmm -#' @export -degrees_of_freedom.lqmm <- function(model, ...) { - out <- model_parameters(model, ...) - out$df_error -} - - -#' @export -degrees_of_freedom.lqm <- degrees_of_freedom.lqmm - - #' @export p_value.lqmm <- function(model, ...) { out <- model_parameters(model, ...) diff --git a/R/methods_lrm.R b/R/methods_lrm.R index f919e0cb9..b5915fc4d 100644 --- a/R/methods_lrm.R +++ b/R/methods_lrm.R @@ -47,13 +47,13 @@ p_value.lrm <- function(model, ...) { # Issue: 697: typically the degrees of freedom are the same for every # observation, but the value is repeated. This poses problems in multiple # imputation models with Hmisc when we get more df values than parameters. - df <- degrees_of_freedom(model, method = "any") - dfu <- unique(df) + dof <- insight::get_df(model, type = "wald") + dfu <- unique(dof) if (length(dfu) == 1) { - df <- dfu + dof <- dfu } - p <- 2 * stats::pt(abs(stat$Statistic), df = df, lower.tail = FALSE) + p <- 2 * stats::pt(abs(stat$Statistic), df = dof, lower.tail = FALSE) .data_frame( Parameter = .remove_backticks_from_string(stat$Parameter), diff --git a/R/methods_marginaleffects.R b/R/methods_marginaleffects.R index 87a6eae3f..803970fa1 100644 --- a/R/methods_marginaleffects.R +++ b/R/methods_marginaleffects.R @@ -23,6 +23,9 @@ model_parameters.marginaleffects <- function(model, attr(out, "object_name") <- insight::safe_deparse_symbol(substitute(model)) + # do not print or report these columns + out <- out[, !colnames(out) %in% c("predicted_lo", "predicted_hi"), drop = FALSE] + if (inherits(model, "marginalmeans")) { attr(out, "coefficient_name") <- "Marginal Means" } else if (inherits(model, "comparisons")) { diff --git a/R/methods_mass.R b/R/methods_mass.R index 57804441d..7d1f54728 100644 --- a/R/methods_mass.R +++ b/R/methods_mass.R @@ -1,15 +1,3 @@ -# degrees of freedom ----------------- - -#' @export -degrees_of_freedom.rlm <- function(model, method = "residual", ...) { - .degrees_of_freedom_no_dfresid_method(model, method) -} - - - - - - # ci ----------------- #' @export @@ -49,9 +37,6 @@ ci.polr <- function(x, ci = 0.95, dof = NULL, method = "profile", ...) { - - - # SE ----------------- #' @export @@ -73,9 +58,6 @@ standard_error.polr <- function(model, method = NULL, ...) { - - - # p ----------------- #' @export @@ -85,7 +67,7 @@ p_value.negbin <- p_value.default #' @export p_value.rlm <- function(model, ...) { cs <- stats::coef(summary(model)) - p <- 2 * stats::pt(abs(cs[, 3]), df = degrees_of_freedom(model, method = "any"), lower.tail = FALSE) + p <- 2 * stats::pt(abs(cs[, 3]), df = insight::get_df(model, type = "wald"), lower.tail = FALSE) .data_frame( Parameter = .remove_backticks_from_string(names(p)), p = as.vector(p) @@ -102,7 +84,7 @@ p_value.polr <- function(model, method = NULL, ...) { smry <- suppressMessages(as.data.frame(stats::coef(summary(model)))) tstat <- smry[[3]] - p <- 2 * stats::pt(abs(tstat), df = degrees_of_freedom(model, method = "any"), lower.tail = FALSE) + p <- 2 * stats::pt(abs(tstat), df = insight::get_df(x = model, type = "wald"), lower.tail = FALSE) names(p) <- rownames(smry) .data_frame( @@ -113,8 +95,6 @@ p_value.polr <- function(model, method = NULL, ...) { - - # parameters ----------------- #' @rdname model_parameters.default diff --git a/R/methods_mclogit.R b/R/methods_mclogit.R index 7189da17b..802e851a3 100644 --- a/R/methods_mclogit.R +++ b/R/methods_mclogit.R @@ -7,10 +7,17 @@ model_parameters.mblogit <- function(model, exponentiate = FALSE, p_adjust = NULL, summary = getOption("parameters_summary", FALSE), + include_info = getOption("parameters_info", FALSE), keep = NULL, drop = NULL, verbose = TRUE, ...) { + ## TODO remove deprecated later + if (!missing(summary)) { + .deprecated_warning("summary", "include_info", verbose) + include_info <- summary + } + out <- .model_parameters_generic( model = model, ci = ci, @@ -22,7 +29,7 @@ model_parameters.mblogit <- function(model, p_adjust = p_adjust, keep_parameters = keep, drop_parameters = drop, - summary = summary, + include_info = include_info, ... ) @@ -53,3 +60,6 @@ p_value.mblogit <- function(model, ...) { row.names = NULL ) } + +#' @export +simulate_parameters.mblogit <- simulate_parameters.multinom diff --git a/R/methods_mediate.R b/R/methods_mediate.R index ef907a9ca..a728ecd6d 100644 --- a/R/methods_mediate.R +++ b/R/methods_mediate.R @@ -95,12 +95,6 @@ standard_error.mediate <- function(model, ...) { } -#' @export -degrees_of_freedom.mediate <- function(model, ...) { - NULL -} - - #' @export p_value.mediate <- function(model, ...) { info <- insight::model_info(model$model.y, verbose = FALSE) diff --git a/R/methods_merTools.R b/R/methods_merTools.R index c5f5ff060..4276c5a91 100644 --- a/R/methods_merTools.R +++ b/R/methods_merTools.R @@ -43,13 +43,6 @@ standard_error.merModList <- function(model, ...) { } -#' @export -degrees_of_freedom.merModList <- function(model, ...) { - s <- suppressWarnings(summary(model)) - s$fe$df -} - - #' @export format_parameters.merModList <- function(model, brackets = c("[", "]"), ...) { .format_parameter_default(model[[1]], brackets = brackets) diff --git a/R/methods_mfx.R b/R/methods_mfx.R index 7709fb31d..847eb79a7 100644 --- a/R/methods_mfx.R +++ b/R/methods_mfx.R @@ -296,50 +296,6 @@ standard_error.betamfx <- function(model, - -# degrees of freedom ------------------ - - -#' @export -degrees_of_freedom.logitor <- function(model, ...) { - degrees_of_freedom.default(model$fit, ...) -} - - -#' @export -degrees_of_freedom.poissonirr <- degrees_of_freedom.logitor - - -#' @export -degrees_of_freedom.negbinirr <- degrees_of_freedom.logitor - - -#' @export -degrees_of_freedom.poissonmfx <- degrees_of_freedom.logitor - - -#' @export -degrees_of_freedom.logitmfx <- degrees_of_freedom.logitor - - -#' @export -degrees_of_freedom.negbinmfx <- degrees_of_freedom.logitor - - -#' @export -degrees_of_freedom.probitmfx <- degrees_of_freedom.logitor - - -#' @export -degrees_of_freedom.betaor <- degrees_of_freedom.logitor - - -#' @export -degrees_of_freedom.betamfx <- degrees_of_freedom.logitor - - - - # p values ------------------ diff --git a/R/methods_mhurdle.R b/R/methods_mhurdle.R index a28befd11..47775b8c2 100644 --- a/R/methods_mhurdle.R +++ b/R/methods_mhurdle.R @@ -61,12 +61,6 @@ ci.mhurdle <- function(x, ci = 0.95, ...) { } -#' @export -degrees_of_freedom.mhurdle <- function(model, method = NULL, ...) { - .degrees_of_freedom_no_dfresid_method(model, method) -} - - #' @export standard_error.mhurdle <- function(model, component = c("all", "conditional", "zi", "zero_inflated", "infrequent_purchase", "ip", "auxiliary"), ...) { component <- match.arg(component) diff --git a/R/methods_mice.R b/R/methods_mice.R index cdf326399..ecadff56c 100644 --- a/R/methods_mice.R +++ b/R/methods_mice.R @@ -11,21 +11,6 @@ ci.mira <- function(x, ci = 0.95, ...) { } -# degrees of freedom ---------------------------- - -#' @export -degrees_of_freedom.mira <- function(model, ...) { - insight::check_if_installed("mice") - degrees_of_freedom(mice::pool(model), ...) -} - - -#' @export -degrees_of_freedom.mipo <- function(model, ...) { - as.vector(summary(model)$df) -} - - # p values --------------------------------------- #' @export @@ -140,41 +125,33 @@ model_parameters.mipo <- function(model, #' similar to `summary(mice::pool())`, i.e. it generates the pooled summary #' of multiple imputed repeated regression analyses. #' -#' @examples +#' @examplesIf require("mice", quietly = TRUE) && require("gee", quietly = TRUE) #' library(parameters) -#' if (require("mice", quietly = TRUE)) { -#' data(nhanes2) -#' imp <- mice(nhanes2) -#' fit <- with(data = imp, exp = lm(bmi ~ age + hyp + chl)) -#' model_parameters(fit) -#' } +#' data(nhanes2, package = "mice") +#' imp <- mice::mice(nhanes2) +#' fit <- with(data = imp, exp = lm(bmi ~ age + hyp + chl)) +#' model_parameters(fit) #' \donttest{ #' # model_parameters() also works for models that have no "tidy"-method in mice -#' if (require("mice", quietly = TRUE) && require("gee", quietly = TRUE)) { -#' data(warpbreaks) -#' set.seed(1234) -#' warpbreaks$tension[sample(1:nrow(warpbreaks), size = 10)] <- NA -#' imp <- mice(warpbreaks) -#' fit <- with(data = imp, expr = gee(breaks ~ tension, id = wool)) +#' data(warpbreaks) +#' set.seed(1234) +#' warpbreaks$tension[sample(1:nrow(warpbreaks), size = 10)] <- NA +#' imp <- mice::mice(warpbreaks) +#' fit <- with(data = imp, expr = gee::gee(breaks ~ tension, id = wool)) #' -#' # does not work: -#' # summary(pool(fit)) +#' # does not work: +#' # summary(mice::pool(fit)) #' -#' model_parameters(fit) -#' } +#' model_parameters(fit) #' } #' -#' -#' #' # and it works with pooled results -#' if (require("mice")) { -#' data("nhanes2") -#' imp <- mice(nhanes2) -#' fit <- with(data = imp, exp = lm(bmi ~ age + hyp + chl)) -#' pooled <- pool(fit) +#' data("nhanes2", package = "mice") +#' imp <- mice::mice(nhanes2) +#' fit <- with(data = imp, exp = lm(bmi ~ age + hyp + chl)) +#' pooled <- mice::pool(fit) #' -#' model_parameters(pooled) -#' } +#' model_parameters(pooled) #' @export model_parameters.mira <- function(model, ci = 0.95, diff --git a/R/methods_mmrm.R b/R/methods_mmrm.R index b97598df5..d786dca5d 100644 --- a/R/methods_mmrm.R +++ b/R/methods_mmrm.R @@ -10,6 +10,7 @@ model_parameters.mmrm <- function(model, exponentiate = FALSE, p_adjust = NULL, summary = getOption("parameters_summary", FALSE), + include_info = getOption("parameters_info", FALSE), keep = NULL, drop = NULL, verbose = TRUE, @@ -19,6 +20,12 @@ model_parameters.mmrm <- function(model, "kenward" ) + ## TODO remove deprecated later + if (!missing(summary)) { + .deprecated_warning("summary", "include_info", verbose) + include_info <- summary + } + # extract model parameters table, as data frame out <- tryCatch( .model_parameters_generic( @@ -31,7 +38,7 @@ model_parameters.mmrm <- function(model, standardize = standardize, exponentiate = exponentiate, p_adjust = p_adjust, - summary = summary, + include_info = include_info, keep_parameters = keep, drop_parameters = drop, vcov = NULL, @@ -126,18 +133,3 @@ standard_error.mmrm_fit <- standard_error.mmrm #' @export standard_error.mmrm_tmb <- standard_error.mmrm - - -# degrees of freedom ------------------ - -#' @export -degrees_of_freedom.mmrm <- function(model, ...) { - summary_table <- stats::coef(summary(model)) - unname(summary_table[, "df"]) -} - -#' @export -degrees_of_freedom.mmrm_fit <- degrees_of_freedom.mmrm - -#' @export -degrees_of_freedom.mmrm_tmb <- degrees_of_freedom.mmrm diff --git a/R/methods_model_fit.R b/R/methods_model_fit.R index 1f02b2032..306a305a8 100644 --- a/R/methods_model_fit.R +++ b/R/methods_model_fit.R @@ -54,16 +54,6 @@ standard_error.model_fit <- function(model, ...) { -# degrees of freedom ------------------ - - -#' @export -degrees_of_freedom.model_fit <- function(model, ...) { - degrees_of_freedom(model$fit, ...) -} - - - # p values ------------------ diff --git a/R/methods_multcomp.R b/R/methods_multcomp.R index f906c1560..963cc85d1 100644 --- a/R/methods_multcomp.R +++ b/R/methods_multcomp.R @@ -103,12 +103,6 @@ standard_error.glht <- function(model, ...) { } -#' @export -degrees_of_freedom.glht <- function(model, ...) { - model$df -} - - #' @export p_value.glht <- function(model, ...) { s <- summary(model) diff --git a/R/methods_mvord.R b/R/methods_mvord.R index 563a03e8a..43ec187f1 100644 --- a/R/methods_mvord.R +++ b/R/methods_mvord.R @@ -12,11 +12,19 @@ model_parameters.mvord <- function(model, exponentiate = FALSE, p_adjust = NULL, summary = getOption("parameters_summary", FALSE), + include_info = getOption("parameters_info", FALSE), keep = NULL, drop = NULL, verbose = TRUE, ...) { component <- match.arg(component) + + ## TODO remove deprecated later + if (!missing(summary)) { + .deprecated_warning("summary", "include_info", verbose) + include_info <- summary + } + out <- .model_parameters_generic( model = model, ci = ci, @@ -29,7 +37,7 @@ model_parameters.mvord <- function(model, p_adjust = p_adjust, keep_parameters = keep, drop_parameters = drop, - summary = summary, + include_info = include_info, ... ) attr(out, "object_name") <- insight::safe_deparse_symbol(substitute(model)) diff --git a/R/methods_nestedLogit.R b/R/methods_nestedLogit.R index 90bc86169..bec97e33a 100644 --- a/R/methods_nestedLogit.R +++ b/R/methods_nestedLogit.R @@ -8,15 +8,22 @@ model_parameters.nestedLogit <- function(model, standardize = NULL, exponentiate = FALSE, p_adjust = NULL, + vcov = NULL, + vcov_args = NULL, summary = getOption("parameters_summary", FALSE), + include_info = getOption("parameters_info", FALSE), keep = NULL, drop = NULL, - vcov = NULL, - vcov_args = NULL, verbose = TRUE, ...) { dots <- list(...) + ## TODO remove deprecated later + if (!missing(summary)) { + .deprecated_warning("summary", "include_info", verbose) + include_info <- summary + } + # set default if (is.null(ci_method)) { if (isTRUE(bootstrap)) { @@ -61,7 +68,7 @@ model_parameters.nestedLogit <- function(model, standardize = standardize, exponentiate = exponentiate, p_adjust = p_adjust, - summary = summary, + include_info = include_info, keep_parameters = keep, drop_parameters = drop, vcov = vcov, @@ -75,40 +82,6 @@ model_parameters.nestedLogit <- function(model, } -#' @export -degrees_of_freedom.nestedLogit <- function(model, - method = NULL, - component = "all", - verbose = TRUE, - ...) { - if (is.null(method)) { - method <- "wald" - } - if (tolower(method) == "residual") { - cf <- as.data.frame(stats::coef(model)) - dof <- rep(vapply(model$models, stats::df.residual, numeric(1)), each = nrow(cf)) - if (!is.null(component) && !identical(component, "all")) { - comp <- intersect(names(dof), component) - if (length(comp)) { - dof <- dof[comp] - } else { - if (verbose) { - insight::format_alert(paste0( - "No matching model found. Possible values for `component` are ", - toString(paste0("'", names(model$models), "'")), - "." - )) - } - dof <- Inf - } - } - } else { - dof <- Inf - } - dof -} - - #' @export standard_error.nestedLogit <- function(model, component = "all", diff --git a/R/methods_nlme.R b/R/methods_nlme.R index 9b589b32e..ecd99429d 100644 --- a/R/methods_nlme.R +++ b/R/methods_nlme.R @@ -70,8 +70,8 @@ p_value.lme <- function(model, se <- standard_error(model, vcov = vcov, vcov_args = vcov_args, ...) tstat <- b$Estimate / se$SE # residuals are defined like this in `nlme:::summary.lme` - df <- model$fixDF[["X"]] - p <- 2 * stats::pt(-abs(tstat), df = df) + dof <- model$fixDF[["X"]] + p <- 2 * stats::pt(-abs(tstat), df = dof) param <- se$Parameter } @@ -97,9 +97,3 @@ standard_error.gls <- standard_error.default #' @export p_value.gls <- p_value.default - - -#' @export -degrees_of_freedom.gls <- function(model, method = NULL, ...) { - .degrees_of_freedom_no_dfresid_method(model, method) -} diff --git a/R/methods_ordinal.R b/R/methods_ordinal.R index aab826e99..09ada5454 100644 --- a/R/methods_ordinal.R +++ b/R/methods_ordinal.R @@ -12,6 +12,7 @@ model_parameters.clm2 <- function(model, exponentiate = FALSE, p_adjust = NULL, summary = getOption("parameters_summary", FALSE), + include_info = getOption("parameters_info", FALSE), keep = NULL, drop = NULL, verbose = TRUE, @@ -23,6 +24,12 @@ model_parameters.clm2 <- function(model, merge_by <- "Parameter" } + ## TODO remove deprecated later + if (!missing(summary)) { + .deprecated_warning("summary", "include_info", verbose) + include_info <- summary + } + ## TODO check merge by out <- .model_parameters_generic( @@ -37,7 +44,7 @@ model_parameters.clm2 <- function(model, p_adjust = p_adjust, keep_parameters = keep, drop_parameters = drop, - summary = summary, + include_info = include_info, ... ) diff --git a/R/methods_other.R b/R/methods_other.R index f1afb42e1..1da9fccef 100644 --- a/R/methods_other.R +++ b/R/methods_other.R @@ -20,13 +20,6 @@ p_value.complmrob <- p_value.default ci.complmrob <- ci.default -#' @export -degrees_of_freedom.complmrob <- function(model, method = "wald", ...) { - .degrees_of_freedom_no_dfresid_method(model, method) -} - - - ############# .Gam -------------- @@ -36,7 +29,7 @@ degrees_of_freedom.complmrob <- function(model, method = "wald", ...) { #' @inheritParams model_parameters.aov #' @export model_parameters.Gam <- function(model, - effectsize_type = NULL, + es_type = NULL, df_error = NULL, type = NULL, table_wide = FALSE, @@ -44,7 +37,7 @@ model_parameters.Gam <- function(model, ...) { model_parameters( summary(model)$parametric.anova, - effectsize_type = effectsize_type, + es_type = es_type, df_error = df_error, type = type, table_wide = table_wide, diff --git a/R/methods_plm.R b/R/methods_plm.R index 00a120df9..271c9ee93 100644 --- a/R/methods_plm.R +++ b/R/methods_plm.R @@ -4,16 +4,6 @@ # plm --------------------------- -#' @export -degrees_of_freedom.plm <- function(model, method = "wald", ...) { - if (identical(method, "normal")) { - return(Inf) - } else { - model$df.residual - } -} - - #' @export standard_error.plm <- function(model, vcov = NULL, vcov_args = NULL, verbose = TRUE, ...) { dots <- list(...) diff --git a/R/methods_posterior.R b/R/methods_posterior.R index 3b58b59bf..a79e9bb08 100644 --- a/R/methods_posterior.R +++ b/R/methods_posterior.R @@ -8,6 +8,7 @@ model_parameters.draws <- function(model, test = "pd", rope_range = "default", rope_ci = 0.95, + exponentiate = FALSE, keep = NULL, drop = NULL, verbose = TRUE, @@ -33,6 +34,9 @@ model_parameters.draws <- function(model, ... ) + # exponentiate coefficients and SE/CI, if requested + params <- .exponentiate_parameters(params, exponentiate = exponentiate) + attr(params, "ci") <- ci attr(params, "object_name") <- insight::safe_deparse_symbol(substitute(model)) class(params) <- c("parameters_model", "see_parameters_model", class(params)) diff --git a/R/methods_quantreg.R b/R/methods_quantreg.R index 9e61e68f7..bed08b33e 100644 --- a/R/methods_quantreg.R +++ b/R/methods_quantreg.R @@ -323,36 +323,3 @@ p_value.rqss <- function(model, p } - - - - -# degrees of freedom --------------------- - - -#' @export -degrees_of_freedom.rqs <- function(model, ...) { - tryCatch( - { - s <- suppressWarnings(summary(model, covariance = TRUE)) - cs <- lapply(s, function(i) i$rdf) - unique(unlist(cs)) - }, - error = function(e) { - NULL - } - ) -} - - - -#' @export -degrees_of_freedom.rqss <- degrees_of_freedom.multinom - - -#' @export -degrees_of_freedom.rq <- degrees_of_freedom.rqs - - -#' @export -degrees_of_freedom.nlrq <- degrees_of_freedom.mhurdle diff --git a/R/methods_rstanarm.R b/R/methods_rstanarm.R index f7a40353a..625e2b68b 100644 --- a/R/methods_rstanarm.R +++ b/R/methods_rstanarm.R @@ -101,7 +101,7 @@ model_parameters.stanreg <- function(model, if (effects != "fixed") { random_effect_levels <- which( - params$Effects %in% "random" & !startsWith(params$Parameter, "Sigma[") + params$Effects == "random" & !startsWith(params$Parameter, "Sigma[") ) if (length(random_effect_levels) && isFALSE(group_level)) { params <- params[-random_effect_levels, , drop = FALSE] diff --git a/R/methods_selection.R b/R/methods_selection.R index 81582060b..728adba85 100644 --- a/R/methods_selection.R +++ b/R/methods_selection.R @@ -9,11 +9,19 @@ model_parameters.selection <- function(model, exponentiate = FALSE, p_adjust = NULL, summary = getOption("parameters_summary", FALSE), + include_info = getOption("parameters_info", FALSE), keep = NULL, drop = NULL, verbose = TRUE, ...) { component <- match.arg(component) + + ## TODO remove deprecated later + if (!missing(summary)) { + .deprecated_warning("summary", "include_info", verbose) + include_info <- summary + } + out <- .model_parameters_generic( model = model, ci = ci, @@ -25,7 +33,7 @@ model_parameters.selection <- function(model, exponentiate = exponentiate, keep_parameters = keep, drop_parameters = drop, - summary = summary, + include_info = include_info, p_adjust = p_adjust, ... ) @@ -83,7 +91,6 @@ standard_error.selection <- function(model, component = c("all", "selection", "o } - #' @export simulate_model.selection <- function(model, iterations = 1000, @@ -100,10 +107,3 @@ simulate_model.selection <- function(model, #' @export ci.selection <- ci.default - - -#' @export -degrees_of_freedom.selection <- function(model, ...) { - s <- summary(model) - s$param$df -} diff --git a/R/methods_serp.R b/R/methods_serp.R deleted file mode 100644 index c4f0fff71..000000000 --- a/R/methods_serp.R +++ /dev/null @@ -1,14 +0,0 @@ -#' @export -degrees_of_freedom.serp <- function(model, method = "normal", ...) { - if (is.null(method)) { - method <- "wald" - } - - method <- match.arg(tolower(method), choices = c("analytical", "any", "fit", "wald", "residual", "normal")) - - if (method %in% c("residual", "fit")) { - model$rdf - } else { - degrees_of_freedom.default(model, method = method, ...) - } -} diff --git a/R/methods_survey.R b/R/methods_survey.R index 04674bf8f..7112b822b 100644 --- a/R/methods_survey.R +++ b/R/methods_survey.R @@ -8,6 +8,7 @@ model_parameters.svyglm <- function(model, exponentiate = FALSE, p_adjust = NULL, summary = getOption("parameters_summary", FALSE), + include_info = getOption("parameters_info", FALSE), keep = NULL, drop = NULL, verbose = TRUE, @@ -18,6 +19,12 @@ model_parameters.svyglm <- function(model, ) } + ## TODO remove deprecated later + if (!missing(summary)) { + .deprecated_warning("summary", "include_info", verbose) + include_info <- summary + } + # validation check, warn if unsupported argument is used. dot_args <- .check_dots( dots = list(...), @@ -35,7 +42,7 @@ model_parameters.svyglm <- function(model, p_adjust = p_adjust, keep_parameters = keep, drop_parameters = drop, - summary = summary, + include_info = include_info, verbose = verbose ) fun_args <- c(fun_args, dot_args) @@ -141,7 +148,7 @@ p_value.svyglm.nb <- function(model, ...) { est <- stats::coef(model) se <- sqrt(diag(stats::vcov(model, stderr = "robust"))) - p <- 2 * stats::pt(abs(est / se), df = degrees_of_freedom(model, method = "any"), lower.tail = FALSE) + p <- 2 * stats::pt(abs(est / se), df = insight::get_df(model, type = "wald"), lower.tail = FALSE) .data_frame( Parameter = .remove_backticks_from_string(names(p)), diff --git a/R/methods_svy2lme.R b/R/methods_svy2lme.R new file mode 100644 index 000000000..cc7e9f83a --- /dev/null +++ b/R/methods_svy2lme.R @@ -0,0 +1,107 @@ +#' @export +model_parameters.svy2lme <- function(model, + ci = 0.95, + effects = "all", + include_sigma = FALSE, + keep = NULL, + drop = NULL, + verbose = TRUE, + ...) { + dots <- list(...) + # which component to return? + effects <- match.arg(effects, choices = c("fixed", "random", "all")) + params <- params_variance <- NULL + + if (effects %in% c("fixed", "all")) { + # Processing + fun_args <- list( + model, + ci = ci, + ci_method = "wald", + standardize = NULL, + p_adjust = NULL, + wb_component = FALSE, + keep_parameters = keep, + drop_parameters = drop, + verbose = verbose, + include_sigma = include_sigma, + summary = FALSE, + vcov = NULL, + vcov_args = NULL + ) + fun_args <- c(fun_args, dots) + params <- do.call(".extract_parameters_mixed", fun_args) + + params$Effects <- "fixed" + } + + att <- attributes(params) + + if (effects %in% c("random", "all")) { + params_variance <- .extract_random_variances( + model, + ci = ci, + effects = effects + ) + } + + # merge random and fixed effects, if necessary + if (!is.null(params) && !is.null(params_variance)) { + params$Level <- NA + params$Group <- "" + params <- params[match(colnames(params_variance), colnames(params))] + } + + params <- rbind(params, params_variance) + # remove empty column + if (!is.null(params$Level) && all(is.na(params$Level))) { + params$Level <- NULL + } + + # due to rbind(), we lose attributes from "extract_parameters()", + # so we add those attributes back here... + if (!is.null(att)) { + attributes(params) <- utils::modifyList(att, attributes(params)) + } + + params <- .add_model_parameters_attributes( + params, + model, + ci = ci, + exponentiate = FALSE, + bootstrap = FALSE, + iterations = 1000, + ci_method = "wald", + p_adjust = NULL, + verbose = verbose, + summary = FALSE, + group_level = FALSE, + wb_component = FALSE, + ... + ) + + attr(params, "object_name") <- insight::safe_deparse_symbol(substitute(model)) + class(params) <- c("parameters_model", "see_parameters_model", class(params)) + + params +} + + +#' @export +standard_error.svy2lme <- function(model, ...) { + .data_frame( + Parameter = .remove_backticks_from_string(colnames(model$Vbeta)), + SE = as.vector(sqrt(diag(model$Vbeta))) + ) +} + + +#' @export +p_value.svy2lme <- function(model, ...) { + stat <- insight::get_statistic(model) + p <- 2 * stats::pnorm(abs(stat$Statistic), lower.tail = FALSE) + .data_frame( + Parameter = stat$Parameter, + p = as.vector(p) + ) +} diff --git a/R/methods_systemfit.R b/R/methods_systemfit.R index 7e087d77b..4df115737 100644 --- a/R/methods_systemfit.R +++ b/R/methods_systemfit.R @@ -8,10 +8,17 @@ model_parameters.systemfit <- function(model, exponentiate = FALSE, p_adjust = NULL, summary = FALSE, + include_info = getOption("parameters_info", FALSE), keep = NULL, drop = NULL, verbose = TRUE, ...) { + ## TODO remove deprecated later + if (!missing(summary)) { + .deprecated_warning("summary", "include_info", verbose) + include_info <- summary + } + out <- .model_parameters_generic( model = model, ci = ci, @@ -24,7 +31,7 @@ model_parameters.systemfit <- function(model, p_adjust = p_adjust, keep_parameters = keep, drop_parameters = drop, - summary = summary, + include_info = include_info, ... ) @@ -33,7 +40,6 @@ model_parameters.systemfit <- function(model, } - #' @export standard_error.systemfit <- function(model, ...) { cf <- stats::coef(summary(model)) @@ -57,7 +63,6 @@ standard_error.systemfit <- function(model, ...) { } - #' @export p_value.systemfit <- function(model, ...) { cf <- stats::coef(summary(model)) @@ -81,25 +86,5 @@ p_value.systemfit <- function(model, ...) { } - -#' @export -degrees_of_freedom.systemfit <- function(model, ...) { - df <- NULL - s <- summary(model)$eq - params <- insight::find_parameters(model) - f <- insight::find_formula(model) - system_names <- names(f) - - for (i in seq_along(system_names)) { - dfs <- rep(s[[i]]$df[2], length(params[[i]])) - df_names <- rep(names(params[i]), length(params[[i]])) - df <- c(df, stats::setNames(dfs, df_names)) - } - - df -} - - - #' @export ci.systemfit <- ci.lm diff --git a/R/methods_truncreg.R b/R/methods_truncreg.R index dd260b243..ca04cd950 100644 --- a/R/methods_truncreg.R +++ b/R/methods_truncreg.R @@ -7,7 +7,3 @@ standard_error.truncreg <- standard_error.default #' @export p_value.truncreg <- p_value.default - - -#' @export -degrees_of_freedom.truncreg <- degrees_of_freedom.mhurdle diff --git a/R/methods_tseries.R b/R/methods_tseries.R deleted file mode 100644 index eefb3256d..000000000 --- a/R/methods_tseries.R +++ /dev/null @@ -1,4 +0,0 @@ -# classes: .garch - -#' @export -degrees_of_freedom.garch <- degrees_of_freedom.mhurdle diff --git a/R/methods_vgam.R b/R/methods_vgam.R index 750189fac..a0018afdb 100644 --- a/R/methods_vgam.R +++ b/R/methods_vgam.R @@ -22,19 +22,10 @@ standard_error.vgam <- function(model, ...) { } -#' @export -degrees_of_freedom.vgam <- function(model, ...) { - params <- insight::get_parameters(model) - out <- stats::setNames(rep(NA, nrow(params)), params$Parameter) - out[names(model@nl.df)] <- model@nl.df - out -} - - #' @export p_value.vgam <- function(model, ...) { stat <- insight::get_statistic(model) - stat$p <- as.vector(stats::pchisq(stat$Statistic, df = degrees_of_freedom(model), lower.tail = FALSE)) + stat$p <- as.vector(stats::pchisq(stat$Statistic, df = insight::get_df(model), lower.tail = FALSE)) stat[c("Parameter", "p", "Component")] } diff --git a/R/methods_weightit.R b/R/methods_weightit.R new file mode 100644 index 000000000..440323d9b --- /dev/null +++ b/R/methods_weightit.R @@ -0,0 +1,31 @@ +# model parameters ------------------- + +#' @export +model_parameters.ordinal_weightit <- model_parameters.clm2 + +#' @export +model_parameters.multinom_weightit <- model_parameters.bracl + +# CI --------------------- + +#' @export +ci.ordinal_weightit <- ci.clm2 + +#' @export +ci.multinom_weightit <- ci.bracl + +# standard errors ----------------- + +#' @export +standard_error.ordinal_weightit <- standard_error.clm2 + +#' @export +standard_error.multinom_weightit <- standard_error.bracl + +# p values ---------------- + +#' @export +p_value.ordinal_weightit <- p_value.clm2 + +#' @export +p_value.multinom_weightit <- p_value.bracl diff --git a/R/n_clusters_easystats.R b/R/n_clusters_easystats.R index f069e0d6a..486d1c4c9 100644 --- a/R/n_clusters_easystats.R +++ b/R/n_clusters_easystats.R @@ -26,9 +26,9 @@ n_clusters_elbow <- function(x, names(out) <- c("n_Clusters", "WSS") gradient <- c(0, diff(out$WSS)) - optim <- out$n_Clusters[which.min(gradient)] + optimal <- out$n_Clusters[which.min(gradient)] - attr(out, "n") <- optim + attr(out, "n") <- optimal attr(out, "gradient") <- gradient attr(out, "duration") <- as.numeric(difftime(Sys.time(), t0, units = "secs")) class(out) <- c("n_clusters_elbow", class(out)) @@ -75,9 +75,9 @@ n_clusters_gap <- function(x, out <- rez[c("clusters", "gap", "SE.sim")] names(out) <- c("n_Clusters", "Gap", "SE") - optim <- cluster::maxSE(f = out$Gap, SE.f = out$SE, method = gap_method) + optimal <- cluster::maxSE(f = out$Gap, SE.f = out$SE, method = gap_method) - attr(out, "n") <- optim + attr(out, "n") <- optimal attr(out, "ymin") <- rez$ymin attr(out, "ymax") <- rez$ymax attr(out, "duration") <- as.numeric(difftime(Sys.time(), t0, units = "secs")) @@ -118,9 +118,9 @@ n_clusters_silhouette <- function(x, ) names(out) <- c("n_Clusters", "Silhouette") - optim <- which.max(out$Silhouette) + optimal <- which.max(out$Silhouette) - attr(out, "n") <- optim + attr(out, "n") <- optimal attr(out, "duration") <- as.numeric(difftime(Sys.time(), t0, units = "secs")) class(out) <- c("n_clusters_silhouette", class(out)) out @@ -149,7 +149,14 @@ n_clusters_silhouette <- function(x, #' } #' } #' @export -n_clusters_dbscan <- function(x, standardize = TRUE, include_factors = FALSE, method = c("kNN", "SS"), min_size = 0.1, eps_n = 50, eps_range = c(0.1, 3), ...) { +n_clusters_dbscan <- function(x, + standardize = TRUE, + include_factors = FALSE, + method = c("kNN", "SS"), + min_size = 0.1, + eps_n = 50, + eps_range = c(0.1, 3), + ...) { method <- match.arg(method) t0 <- Sys.time() x <- .prepare_data_clustering(x, include_factors = include_factors, standardize = standardize, ...) @@ -250,7 +257,13 @@ n_clusters_hclust <- function(x, #' @keywords internal -.n_clusters_factoextra <- function(x, method = "wss", standardize = TRUE, include_factors = FALSE, clustering_function = stats::kmeans, n_max = 10, ...) { +.n_clusters_factoextra <- function(x, + method = "wss", + standardize = TRUE, + include_factors = FALSE, + clustering_function = stats::kmeans, + n_max = 10, + ...) { x <- .prepare_data_clustering(x, include_factors = include_factors, standardize = standardize, ...) insight::check_if_installed("factoextra") @@ -265,31 +278,31 @@ n_clusters_hclust <- function(x, #' @export print.n_clusters_elbow <- function(x, ...) { - insight::print_color(paste0("The Elbow method, that aims at minimizing the total intra-cluster variation (i.e., the total within-cluster sum of square), suggests that the optimal number of clusters is ", attributes(x)$n, "."), "green") + insight::print_color(paste0("The Elbow method, that aims at minimizing the total intra-cluster variation (i.e., the total within-cluster sum of square), suggests that the optimal number of clusters is ", attributes(x)$n, "."), "green") # nolint invisible(x) } #' @export print.n_clusters_gap <- function(x, ...) { - insight::print_color(paste0("The Gap method, that compares the total intracluster variation of k clusters with their expected values under null reference distribution of the data, suggests that the optimal number of clusters is ", attributes(x)$n, "."), "green") + insight::print_color(paste0("The Gap method, that compares the total intracluster variation of k clusters with their expected values under null reference distribution of the data, suggests that the optimal number of clusters is ", attributes(x)$n, "."), "green") # nolint invisible(x) } #' @export print.n_clusters_silhouette <- function(x, ...) { - insight::print_color(paste0("The Silhouette method, based on the average quality of clustering, suggests that the optimal number of clusters is ", attributes(x)$n, "."), "green") + insight::print_color(paste0("The Silhouette method, based on the average quality of clustering, suggests that the optimal number of clusters is ", attributes(x)$n, "."), "green") # nolint invisible(x) } #' @export print.n_clusters_dbscan <- function(x, ...) { - insight::print_color(paste0("The DBSCAN method, based on the total clusters sum of squares, suggests that the optimal eps = ", attributes(x)$eps, " (with min. cluster size set to ", attributes(x)$min_size, "), which corresponds to ", attributes(x)$n, " clusters."), "green") + insight::print_color(paste0("The DBSCAN method, based on the total clusters sum of squares, suggests that the optimal eps = ", attributes(x)$eps, " (with min. cluster size set to ", attributes(x)$min_size, "), which corresponds to ", attributes(x)$n, " clusters."), "green") # nolint invisible(x) } #' @export print.n_clusters_hclust <- function(x, ...) { - insight::print_color(paste0("The bootstrap analysis of hierachical clustering highlighted ", attributes(x)$n, " significant clusters."), "green") + insight::print_color(paste0("The bootstrap analysis of hierachical clustering highlighted ", attributes(x)$n, " significant clusters."), "green") # nolint invisible(x) } @@ -297,25 +310,28 @@ print.n_clusters_hclust <- function(x, ...) { #' @export visualisation_recipe.n_clusters_elbow <- function(x, ...) { - data <- as.data.frame(x) - data$Gradient <- datawizard::rescale(attributes(x)$gradient, c(min(data$WSS, max(data$WSS)))) + input_df <- as.data.frame(x) + input_df$Gradient <- datawizard::rescale( + attributes(x)$gradient, + min(input_df$WSS, max(input_df$WSS)) + ) layers <- list() # Layers ----------------------- layers[["l1"]] <- list( geom = "line", - data = data, + data = input_df, aes = list(x = "n_Clusters", y = "WSS", group = 1), size = 1 ) layers[["l2"]] <- list( geom = "point", - data = data, + data = input_df, aes = list(x = "n_Clusters", y = "WSS") ) layers[["l3"]] <- list( geom = "line", - data = data, + data = input_df, aes = list(x = "n_Clusters", y = "Gradient", group = 1), size = 0.5, color = "red", @@ -323,7 +339,7 @@ visualisation_recipe.n_clusters_elbow <- function(x, ...) { ) layers[["l4"]] <- list( geom = "vline", - data = data, + data = input_df, xintercept = attributes(x)$n, linetype = "dotted" ) @@ -336,32 +352,32 @@ visualisation_recipe.n_clusters_elbow <- function(x, ...) { # Out class(layers) <- c("visualisation_recipe", "see_visualisation_recipe", class(layers)) - attr(layers, "data") <- data + attr(layers, "data") <- input_df layers } #' @export visualisation_recipe.n_clusters_gap <- function(x, ...) { - data <- as.data.frame(x) - data$ymin <- attributes(x)$ymin - data$ymax <- attributes(x)$ymax + dataset <- as.data.frame(x) + dataset$ymin <- attributes(x)$ymin + dataset$ymax <- attributes(x)$ymax layers <- list() # Layers ----------------------- layers[["l1"]] <- list( geom = "line", - data = data, + data = dataset, aes = list(x = "n_Clusters", y = "Gap", group = 1) ) layers[["l2"]] <- list( geom = "pointrange", - data = data, + data = dataset, aes = list(x = "n_Clusters", y = "Gap", ymin = "ymin", ymax = "ymax") ) layers[["l4"]] <- list( geom = "vline", - data = data, + data = dataset, xintercept = attributes(x)$n, linetype = "dotted" ) @@ -374,30 +390,30 @@ visualisation_recipe.n_clusters_gap <- function(x, ...) { # Out class(layers) <- c("visualisation_recipe", "see_visualisation_recipe", class(layers)) - attr(layers, "data") <- data + attr(layers, "data") <- dataset layers } #' @export visualisation_recipe.n_clusters_silhouette <- function(x, ...) { - data <- as.data.frame(x) + dataset <- as.data.frame(x) layers <- list() # Layers ----------------------- layers[["l1"]] <- list( geom = "line", - data = data, + data = dataset, aes = list(x = "n_Clusters", y = "Silhouette", group = 1) ) layers[["l2"]] <- list( geom = "point", - data = data, + data = dataset, aes = list(x = "n_Clusters", y = "Silhouette") ) layers[["l4"]] <- list( geom = "vline", - data = data, + data = dataset, xintercept = attributes(x)$n, linetype = "dotted" ) @@ -410,38 +426,41 @@ visualisation_recipe.n_clusters_silhouette <- function(x, ...) { # Out class(layers) <- c("visualisation_recipe", "see_visualisation_recipe", class(layers)) - attr(layers, "data") <- data + attr(layers, "data") <- dataset layers } #' @export visualisation_recipe.n_clusters_dbscan <- function(x, ...) { - data <- as.data.frame(x) + dataset <- as.data.frame(x) layers <- list() # Layers ----------------------- if ("gradient" %in% names(attributes(x))) { - data$gradient <- datawizard::rescale(attributes(x)$gradient, c(min(data$eps), max(data$eps))) + dataset$gradient <- datawizard::rescale( + attributes(x)$gradient, + c(min(dataset$eps), max(dataset$eps)) + ) layers[["l1"]] <- list( geom = "line", - data = data, + data = dataset, aes = list(x = "n_Obs", y = "eps"), size = 1 ) layers[["l2"]] <- list( geom = "line", - data = data, + data = dataset, aes = list(x = "n_Obs", y = "gradient"), color = "red", linetype = "dashed" ) layers[["l3"]] <- list( geom = "hline", - data = data, + data = dataset, yintercept = attributes(x)$eps, linetype = "dotted" ) @@ -452,24 +471,27 @@ visualisation_recipe.n_clusters_dbscan <- function(x, ...) { title = "DBSCAN Method" ) } else { - data$y <- datawizard::rescale(data$total_SS, c(min(data$n_Clusters), max(data$n_Clusters))) + dataset$y <- datawizard::rescale( + dataset$total_SS, + c(min(dataset$n_Clusters), max(dataset$n_Clusters)) + ) layers[["l1"]] <- list( geom = "line", - data = data, + data = dataset, aes = list(x = "eps", y = "n_Clusters"), size = 1 ) layers[["l2"]] <- list( geom = "line", - data = data, + data = dataset, aes = list(x = "eps", y = "y"), color = "red", linetype = "dashed" ) layers[["l3"]] <- list( geom = "vline", - data = data, + data = dataset, xintercept = attributes(x)$eps, linetype = "dotted" ) @@ -483,7 +505,7 @@ visualisation_recipe.n_clusters_dbscan <- function(x, ...) { # Out class(layers) <- c("visualisation_recipe", "see_visualisation_recipe", class(layers)) - attr(layers, "data") <- data + attr(layers, "data") <- dataset layers } @@ -505,6 +527,6 @@ plot.n_clusters_dbscan <- plot.n_clusters_elbow #' @export plot.n_clusters_hclust <- function(x, ...) { insight::check_if_installed("pvclust") - graphics::plot(attributes(x)$model) - pvclust::pvrect(attributes(x)$model, alpha = attributes(x)$ci, pv = "si") + graphics::plot(attributes(x)[["model"]]) + pvclust::pvrect(attributes(x)[["model"]], alpha = attributes(x)$ci, pv = "si") } diff --git a/R/p_direction.R b/R/p_direction.R new file mode 100644 index 000000000..313051669 --- /dev/null +++ b/R/p_direction.R @@ -0,0 +1,178 @@ +#' @importFrom bayestestR p_direction +#' @export +bayestestR::p_direction + + +#' @title Probability of Direction (pd) +#' @name p_direction.lm +#' +#' @description Compute the **Probability of Direction** (*pd*, also known as +#' the Maximum Probability of Effect - *MPE*). This can be interpreted as the +#' probability that a parameter (described by its full confidence, or +#' "compatibility" interval) is strictly positive or negative (whichever is the +#' most probable). Although differently expressed, this index is fairly similar +#' (i.e., is strongly correlated) to the frequentist *p-value* (see 'Details'). +#' +#' @param x A statistical model. +#' @inheritParams bayestestR::p_direction +#' @inheritParams model_parameters.default +#' @param ... Arguments passed to other methods, e.g. `ci()`. Arguments like +#' `vcov` or `vcov_args` can be used to compute confidence intervals using a +#' specific variance-covariance matrix for the standard errors. +#' +#' @seealso See also [`equivalence_test()`], [`p_function()`] and +#' [`p_significance()`] for functions related to checking effect existence and +#' significance. +#' +#' @inheritSection bayestestR::p_direction What is the *pd*? +#' +#' @inheritSection bayestestR::p_direction Relationship with the p-value +#' +#' @inheritSection bayestestR::p_direction Possible Range of Values +#' +#' @inheritSection model_parameters Statistical inference - how to quantify evidence +#' +#' @references +#' +#' - Amrhein, V., Korner-Nievergelt, F., and Roth, T. (2017). The earth is +#' flat (p > 0.05): Significance thresholds and the crisis of unreplicable +#' research. PeerJ, 5, e3544. \doi{10.7717/peerj.3544} +#' +#' - Greenland S, Rafi Z, Matthews R, Higgs M. To Aid Scientific Inference, +#' Emphasize Unconditional Compatibility Descriptions of Statistics. (2022) +#' https://arxiv.org/abs/1909.08583v7 (Accessed November 10, 2022) +#' +#' - Lakens, D. (2024). Improving Your Statistical Inferences (Version v1.5.1). +#' Retrieved from https://lakens.github.io/statistical_inferences/. +#' \doi{10.5281/ZENODO.6409077} +#' +#' - Lakens, D., Scheel, A. M., and Isager, P. M. (2018). Equivalence Testing +#' for Psychological Research: A Tutorial. Advances in Methods and Practices +#' in Psychological Science, 1(2), 259–269. \doi{10.1177/2515245918770963} +#' +#' - Makowski, D., Ben-Shachar, M. S., Chen, S. H. A., and Lüdecke, D. (2019). +#' Indices of Effect Existence and Significance in the Bayesian Framework. +#' Frontiers in Psychology, 10, 2767. \doi{10.3389/fpsyg.2019.02767} +#' +#' - Rafi Z, Greenland S. Semantic and cognitive tools to aid statistical +#' science: replace confidence and significance by compatibility and surprise. +#' BMC Medical Research Methodology (2020) 20:244. +#' +#' - Schweder T. Confidence is epistemic probability for empirical science. +#' Journal of Statistical Planning and Inference (2018) 195:116–125. +#' \doi{10.1016/j.jspi.2017.09.016} +#' +#' - Schweder T, Hjort NL. Frequentist analogues of priors and posteriors. +#' In Stigum, B. (ed.), Econometrics and the Philosophy of Economics: Theory +#' Data Confrontation in Economics, pp. 285-217. Princeton University Press, +#' Princeton, NJ, 2003 +#' +#' - Vos P, Holbert D. Frequentist statistical inference without repeated sampling. +#' Synthese 200, 89 (2022). \doi{10.1007/s11229-022-03560-x} +#' +#' @return A data frame. +#' +#' @examplesIf requireNamespace("bayestestR") && require("see", quietly = TRUE) && requireNamespace("sandwich") +#' data(qol_cancer) +#' model <- lm(QoL ~ time + age + education, data = qol_cancer) +#' p_direction(model) +#' +#' # based on heteroscedasticity-robust standard errors +#' p_direction(model, vcov = "HC3") +#' +#' result <- p_direction(model) +#' plot(result) +#' @export +p_direction.lm <- function(x, + ci = 0.95, + method = "direct", + null = 0, + vcov = NULL, + vcov_args = NULL, + ...) { + # generate normal distribution based on CI range + result <- .posterior_ci(x, ci, vcov = vcov, vcov_args = vcov_args, ...) + + # copy + out <- result$out + posterior <- result$posterior + + # add pd + out$pd <- as.numeric(bayestestR::p_direction( + posterior, + method = method, + null = null, + ... + )) + + # reorder + out <- out[intersect(c("Parameter", "CI", "CI_low", "CI_high", "pd", "Effects", "Component"), colnames(out))] + + attr(out, "data") <- posterior + attr(out, "null") <- null + class(out) <- c("p_direction_lm", "p_direction", "see_p_direction", "data.frame") + out +} + + +# methods --------------------------------------------------------------------- + +#' @export +print.p_direction_lm <- function(x, digits = 2, p_digits = 3, ...) { + null <- attributes(x)$null + caption <- sprintf( + "Probability of Direction (null: %s)", + insight::format_value(null, digits = digits, protect_integer = TRUE) + ) + + x <- insight::format_table(x, digits = digits, p_digits = p_digits) + cat(insight::export_table(x, title = caption, ...)) +} + + +# other classes -------------------------------------------------------------- + +#' @export +p_direction.glm <- p_direction.lm + +#' @export +p_direction.coxph <- p_direction.lm + +#' @export +p_direction.svyglm <- p_direction.lm + +#' @export +p_direction.glmmTMB <- p_direction.lm + +#' @export +p_direction.merMod <- p_direction.lm + +#' @export +p_direction.wbm <- p_direction.lm + +#' @export +p_direction.lme <- p_direction.lm + +#' @export +p_direction.gee <- p_direction.lm + +#' @export +p_direction.gls <- p_direction.lm + +#' @export +p_direction.feis <- p_direction.lm + +#' @export +p_direction.felm <- p_direction.lm + +#' @export +p_direction.mixed <- p_direction.lm + +#' @export +p_direction.hurdle <- p_direction.lm + +#' @export +p_direction.zeroinfl <- p_direction.lm + +#' @export +p_direction.rma <- p_direction.lm diff --git a/R/p_function.R b/R/p_function.R index d60afed34..14ee7c94a 100644 --- a/R/p_function.R +++ b/R/p_function.R @@ -18,12 +18,16 @@ #' @inheritParams model_parameters #' @inheritParams model_parameters.default #' @inheritParams model_parameters.glmmTMB +#' @inheritParams standard_error #' #' @note #' Curently, `p_function()` computes intervals based on Wald t- or z-statistic. #' For certain models (like mixed models), profiled intervals may be more #' accurate, however, this is currently not supported. #' +#' @seealso See also [`equivalence_test()`] and [`p_significance()`] for +#' functions related to checking effect existence and significance. +#' #' @details #' ## Compatibility intervals and continuous _p_-values for different estimate values #' @@ -75,7 +79,7 @@ #' _p_<0.05 can arise from assumption violations even if the effect under #' study is null" (_Gelman/Greenland 2019_). #' -#' ## Probabilistic interpretation of compatibility intervals +#' ## Probabilistic interpretation of p-values and compatibility intervals #' #' Schweder (2018) resp. Schweder and Hjort (2016) (and others) argue that #' confidence curves (as produced by `p_function()`) have a valid probabilistic @@ -106,21 +110,55 @@ #' "The realized confidence distribution is clearly an epistemic probability #' distribution" (_Schweder 2018_). In Bayesian words, compatibility intervals #' (or confidence distributons, or consonance curves) are "posteriors without -#' priors" (_Schweder, Hjort, 2003_). In this regard, interpretation of _p_-values -#' might be guided using [`bayestestR::p_to_pd()`]. -#' -#' ## Compatibility intervals - is their interpretation conditional or not? -#' -#' The fact that the term "conditional" is used in different meanings, is -#' confusing and unfortunate. Thus, we would summarize the probabilistic -#' interpretation of compatibility intervals as follows: The intervals are built -#' from the data _and_ our modeling assumptions. The accuracy of the intervals -#' depends on our model assumptions. If a value is outside the interval, that -#' might be because (1) that parameter value isn't supported by the data, or -#' (2) the modeling assumptions are a poor fit for the situation. When we make -#' bad assumptions, the compatibility interval might be too wide or (more -#' commonly and seriously) too narrow, making us think we know more about the -#' parameter than is warranted. +#' priors" (_Schweder, Hjort, 2003_). +#' +#' The _p_-value indicates the degree of compatibility of the endpoints of the +#' interval at a given confidence level with (1) the observed data and (2) model +#' assumptions. The observed point estimate (_p_-value = 1) is the value +#' estimated to be _most compatible_ with the data and model assumptions, +#' whereas values values far from the observed point estimate (where _p_ +#' approaches 0) are least compatible with the data and model assumptions +#' (_Schweder and Hjort 2016, pp. 60-61; Amrhein and Greenland 2022_). In this +#' regards, _p_-values are statements about _confidence_ or _compatibility_: +#' The p-value is not an absolute measure of evidence for a model (such as the +#' null/alternative model), it is a continuous measure of the compatibility of +#' the observed data with the model used to compute it (_Greenland et al. 2016_, +#' _Greenland 2023_). Going one step further, and following _Schweder_, p-values +#' can be considered as _epistemic probability_ - "not necessarily of the +#' hypothesis being true, but of it _possibly_ being true" (_Schweder 2018_). +#' Hence, the interpretation of _p_-values might be guided using +#' [`bayestestR::p_to_pd()`]. +#' +#' ## Probability or compatibility? +#' +#' We here presented the discussion of p-values and confidence intervals from the +#' perspective of two paradigms, one saying that probability statements can be +#' made, one saying that interpretation is guided in terms of "compatibility". +#' Cox and Hinkley say, "interval estimates cannot be taken as probability +#' statements" (_Cox and Hinkley 1979: 208_), which conflicts with the Schweder +#' and Hjort confidence distribution school. However, if you view interval +#' estimates as being intervals of values being consistent with the data, +#' this comes close to the idea of (epistemic) probability. We do not believe that +#' these two paradigms contradict or exclude each other. Rather, the aim is to +#' emphasize one point of view or the other, i.e. to place the linguistic +#' nuances either on 'compatibility' or 'probability'. +#' +#' The main take-away is *not* to interpret p-values as dichotomous decisions +#' that distinguish between "we found an effect" (statistically significant)" vs. +#' "we found no effect" (statistically not significant) (_Altman and Bland 1995_). +#' +#' ## Compatibility intervals - is their interpretation "conditional" or not? +#' +#' The fact that the term "conditional" is used in different meanings in +#' statistics, is confusing and unfortunate. Thus, we would summarize the +#' (probabilistic) interpretation of compatibility intervals as follows: The +#' intervals are built from the data _and_ our modeling assumptions. The +#' accuracy of the intervals depends on our model assumptions. If a value is +#' outside the interval, that might be because (1) that parameter value isn't +#' supported by the data, or (2) the modeling assumptions are a poor fit for the +#' situation. When we make bad assumptions, the compatibility interval might be +#' too wide or (more commonly and seriously) too narrow, making us think we know +#' more about the parameter than is warranted. #' #' When we say "there is a 95% chance the true value is in the interval", that is #' a statement of _epistemic probability_ (i.e. description of uncertainty related @@ -130,14 +168,42 @@ #' probability properties, from which we can draw _epistemic_ probabilistic #' statements of uncertainty (_Schweder and Hjort 2016_). #' +#' ## Functions in the parameters package to check for effect existence and significance +#' +#' The **parameters** package provides several options or functions to aid +#' statistical inference. Beyond `p_function()`, there are, for example: +#' - [`equivalence_test()`][equivalence_test.lm], to compute the (conditional) +#' equivalence test for frequentist models +#' - [`p_significance()`][p_significance.lm], to compute the probability of +#' *practical significance*, which can be conceptualized as a unidirectional +#' equivalence test +#' - the `pd` argument (setting `pd = TRUE`) in `model_parameters()` includes +#' a column with the *probability of direction*, i.e. the probability that a +#' parameter is strictly positive or negative. See [`bayestestR::p_direction()`] +#' for details. If plotting is desired, the [`p_direction()`][p_direction.lm] +#' function can be used, together with `plot()`. +#' - the `s_value` argument (setting `s_value = TRUE`) in `model_parameters()` +#' replaces the p-values with their related _S_-values (*Rafi and Greenland 2020*) +#' - finally, it is possible to generate distributions of model coefficients by +#' generating bootstrap-samples (setting `bootstrap = TRUE`) or simulating +#' draws from model coefficients using [`simulate_model()`]. These samples +#' can then be treated as "posterior samples" and used in many functions from +#' the **bayestestR** package. +#' #' @return A data frame with p-values and compatibility intervals. #' #' @references +#' - Altman DG, Bland JM. Absence of evidence is not evidence of absence. BMJ. +#' 1995;311(7003):485. \doi{10.1136/bmj.311.7003.485} +#' #' - Amrhein V, Greenland S. Discuss practical importance of results based on #' interval estimates and p-value functions, not only on point estimates and #' null p-values. Journal of Information Technology 2022;37:316–20. #' \doi{10.1177/02683962221105904} #' +#' - Cox DR, Hinkley DV. 1979. Theoretical Statistics. 6th edition. +#' Chapman and Hall/CRC +#' #' - Fraser DAS. The P-value function and statistical inference. The American #' Statistician. 2019;73(sup1):135-147. \doi{10.1080/00031305.2018.1556735} #' @@ -148,6 +214,16 @@ #' Emphasize Unconditional Compatibility Descriptions of Statistics. (2022) #' https://arxiv.org/abs/1909.08583v7 (Accessed November 10, 2022) #' +#' - Greenland S, Senn SJ, Rothman KJ, Carlin JB, Poole C, Goodman SN, et al. +#' (2016). Statistical tests, P values, confidence intervals, and power: A +#' guide to misinterpretations. European Journal of Epidemiology. 31:337-350. +#' \doi{10.1007/s10654-016-0149-3} +#' +#' - Greenland S (2023). Divergence versus decision P-values: A distinction +#' worth making in theory and keeping in practice: Or, how divergence P-values +#' measure evidence even when decision P-values do not. Scand J Statist, 50(1), +#' 54-88. \doi{doi.org/10.1111/sjos.12625} +#' #' - Rafi Z, Greenland S. Semantic and cognitive tools to aid statistical #' science: Replace confidence and significance by compatibility and surprise. #' BMC Medical Research Methodology. 2020;20(1):244. \doi{10.1186/s12874-020-01105-9} @@ -188,6 +264,8 @@ p_function <- function(model, exponentiate = FALSE, effects = "fixed", component = "all", + vcov = NULL, + vcov_args = NULL, keep = NULL, drop = NULL, verbose = TRUE, @@ -199,7 +277,9 @@ p_function <- function(model, se <- standard_error( model, effects = effects, - component = component + component = component, + vcov = vcov, + vcov_args = vcov_args )$SE if (is.null(dof) || length(dof) == 0 || .is_chi2_model(model, dof)) { diff --git a/R/p_significance.R b/R/p_significance.R new file mode 100644 index 000000000..c8f8eeb33 --- /dev/null +++ b/R/p_significance.R @@ -0,0 +1,337 @@ +#' @importFrom bayestestR p_significance +#' @export +bayestestR::p_significance + + + +#' @title Practical Significance (ps) +#' +#' @description Compute the probability of **Practical Significance** (*ps*), +#' which can be conceptualized as a unidirectional equivalence test. It returns +#' the probability that an effect is above a given threshold corresponding to a +#' negligible effect in the median's direction, considering a parameter's _full_ +#' confidence interval. In other words, it returns the probability of a clear +#' direction of an effect, which is larger than the smallest effect size of +#' interest (e.g., a minimal important difference). Its theoretical range is +#' from zero to one, but the *ps* is typically larger than 0.5 (to indicate +#' practical significance). +#' +#' In comparison the the [`equivalence_test()`] function, where the *SGPV* +#' (second generation p-value) describes the proportion of the _full_ confidence +#' interval that is _inside_ the ROPE, the value returned by `p_significance()` +#' describes the _larger_ proportion of the _full_ confidence interval that is +#' _outside_ the ROPE. This makes `p_significance()` comparable to +#' [`bayestestR::p_direction()`], however, while `p_direction()` compares to a +#' point-null by default, `p_significance()` compares to a range-null. +#' +#' @param x A statistical model. +#' @inheritParams bayestestR::p_significance +#' @inheritParams model_parameters.default +#' @param verbose Toggle warnings and messages. +#' @param ... Arguments passed to other methods. +#' +#' @seealso For more details, see [`bayestestR::p_significance()`]. See also +#' [`equivalence_test()`], [`p_function()`] and [`bayestestR::p_direction()`] +#' for functions related to checking effect existence and significance. +#' +#' @details `p_significance()` returns the proportion of the _full_ confidence +#' interval range (assuming a normally or t-distributed, equal-tailed interval, +#' based on the model) that is outside a certain range (the negligible effect, +#' or ROPE, see argument `threshold`). If there are values of the distribution +#' both below and above the ROPE, `p_significance()` returns the higher +#' probability of a value being outside the ROPE. Typically, this value should +#' be larger than 0.5 to indicate practical significance. However, if the range +#' of the negligible effect is rather large compared to the range of the +#' confidence interval, `p_significance()` will be less than 0.5, which +#' indicates no clear practical significance. +#' +#' Note that the assumed interval, which is used to calculate the practical +#' significance, is an estimation of the _full interval_ based on the chosen +#' confidence level. For example, if the 95% confidence interval of a +#' coefficient ranges from -1 to 1, the underlying _full (normally or +#' t-distributed) interval_ approximately ranges from -1.9 to 1.9, see also +#' following code: +#' +#' ``` +#' # simulate full normal distribution +#' out <- bayestestR::distribution_normal(10000, 0, 0.5) +#' # range of "full" distribution +#' range(out) +#' # range of 95% CI +#' round(quantile(out, probs = c(0.025, 0.975)), 2) +#' ``` +#' +#' This ensures that the practical significance always refers to the general +#' compatible parameter space of coefficients. Therefore, the _full interval_ is +#' similar to a Bayesian posterior distribution of an equivalent Bayesian model, +#' see following code: +#' +#' ``` +#' library(bayestestR) +#' library(brms) +#' m <- lm(mpg ~ gear + wt + cyl + hp, data = mtcars) +#' m2 <- brm(mpg ~ gear + wt + cyl + hp, data = mtcars) +#' # probability of significance (ps) for frequentist model +#' p_significance(m) +#' # similar to ps of Bayesian models +#' p_significance(m2) +#' # similar to ps of simulated draws / bootstrap samples +#' p_significance(simulate_model(m)) +#' ``` +#' +#' @note There is also a [`plot()`-method](https://easystats.github.io/see/articles/bayestestR.html) +#' implemented in the [**see**-package](https://easystats.github.io/see/). +#' +#' @inheritSection model_parameters Statistical inference - how to quantify evidence +#' +#' @references +#' +#' - Amrhein, V., Korner-Nievergelt, F., and Roth, T. (2017). The earth is +#' flat (p > 0.05): Significance thresholds and the crisis of unreplicable +#' research. PeerJ, 5, e3544. \doi{10.7717/peerj.3544} +#' +#' - Greenland S, Rafi Z, Matthews R, Higgs M. To Aid Scientific Inference, +#' Emphasize Unconditional Compatibility Descriptions of Statistics. (2022) +#' https://arxiv.org/abs/1909.08583v7 (Accessed November 10, 2022) +#' +#' - Lakens, D. (2024). Improving Your Statistical Inferences (Version v1.5.1). +#' Retrieved from https://lakens.github.io/statistical_inferences/. +#' \doi{10.5281/ZENODO.6409077} +#' +#' - Lakens, D., Scheel, A. M., and Isager, P. M. (2018). Equivalence Testing +#' for Psychological Research: A Tutorial. Advances in Methods and Practices +#' in Psychological Science, 1(2), 259–269. \doi{10.1177/2515245918770963} +#' +#' - Makowski, D., Ben-Shachar, M. S., Chen, S. H. A., and Lüdecke, D. (2019). +#' Indices of Effect Existence and Significance in the Bayesian Framework. +#' Frontiers in Psychology, 10, 2767. \doi{10.3389/fpsyg.2019.02767} +#' +#' - Rafi Z, Greenland S. Semantic and cognitive tools to aid statistical +#' science: replace confidence and significance by compatibility and surprise. +#' BMC Medical Research Methodology (2020) 20:244. +#' +#' - Schweder T. Confidence is epistemic probability for empirical science. +#' Journal of Statistical Planning and Inference (2018) 195:116–125. +#' \doi{10.1016/j.jspi.2017.09.016} +#' +#' - Schweder T, Hjort NL. Frequentist analogues of priors and posteriors. +#' In Stigum, B. (ed.), Econometrics and the Philosophy of Economics: Theory +#' Data Confrontation in Economics, pp. 285-217. Princeton University Press, +#' Princeton, NJ, 2003 +#' +#' - Vos P, Holbert D. Frequentist statistical inference without repeated sampling. +#' Synthese 200, 89 (2022). \doi{10.1007/s11229-022-03560-x} +#' +#' @return A data frame with columns for the parameter names, the confidence +#' intervals and the values for practical significance. Higher values indicate +#' more practical significance (upper bound is one). +#' +#' @examplesIf requireNamespace("bayestestR") && packageVersion("bayestestR") > "0.14.0" && requireNamespace("sandwich") +#' data(qol_cancer) +#' model <- lm(QoL ~ time + age + education, data = qol_cancer) +#' +#' p_significance(model) +#' p_significance(model, threshold = c(-0.5, 1.5)) +#' +#' # based on heteroscedasticity-robust standard errors +#' p_significance(model, vcov = "HC3") +#' +#' if (require("see", quietly = TRUE)) { +#' result <- p_significance(model) +#' plot(result) +#' } +#' @export +p_significance.lm <- function(x, + threshold = "default", + ci = 0.95, + vcov = NULL, + vcov_args = NULL, + verbose = TRUE, + ...) { + # generate normal distribution based on CI range + result <- .posterior_ci(x, ci, vcov = vcov, vcov_args = vcov_args, ...) + + # copy + out <- result$out + posterior <- result$posterior + + # calculate the ROPE range - for multiple thresholds, we have to check + # each list element for "default", to replace it with the appropriate range + if (is.list(threshold)) { + threshold <- lapply(threshold, function(i) { + if (all(i == "default")) { + i <- bayestestR::rope_range(x, verbose = verbose) + } + i + }) + } else if (all(threshold == "default")) { + threshold <- bayestestR::rope_range(x, verbose = verbose) + } + + # add ps + result_ps <- bayestestR::p_significance( + posterior, + threshold = threshold, + verbose = verbose + ) + out$ps <- as.numeric(result_ps) + + # for list-thresholds, we have the list as attribute and need to save it as + # data.frame + if (is.list(threshold)) { + # save for later + threshold_data <- stats::setNames( + as.data.frame(do.call(rbind, attributes(result_ps)$threshold)), + c("ROPE_low", "ROPE_high") + ) + out <- cbind(out, threshold_data) + keep <- c("Parameter", "CI", "CI_low", "CI_high", "ROPE_low", "ROPE_high", "ps", "Effects", "Component") + } else { + keep <- c("Parameter", "CI", "CI_low", "CI_high", "ps", "Effects", "Component") + } + + # for plot, we need to have it numeric + if (!is.numeric(threshold) && !is.list(threshold)) { + threshold <- 0.1 + } + + # Reorder columns of 'out' to keep only the relevant ones + out <- out[intersect(keep, colnames(out))] + + attr(out, "data") <- posterior + attr(out, "threshold") <- threshold + class(out) <- c("p_significance_lm", "p_significance", "see_p_significance", "data.frame") + out +} + + +# helper ---------------------------------------------------------------------- + +.posterior_ci <- function(x, ci, vcov = NULL, vcov_args = NULL, ...) { + # first, we need CIs + if (inherits(x, "parameters_model")) { + # for model_parameters objects, directly extract CIs + out <- as.data.frame(x)[intersect( + c("Parameter", "CI_low", "CI_high", "Component", "Effects"), + colnames(x) + )] + ci <- attributes(x)$ci + # and extract degrees of freedom + df_column <- grep("(df|df_error)", colnames(x)) + if (length(df_column) > 0) { + dof <- unique(x[[df_column]]) + if (length(dof) > 1) { + dof <- Inf + } + } else { + dof <- Inf + } + } else { + out <- ci(x, ci = ci, vcov = vcov, vcov_args = vcov_args, ...) + dof <- .safe(insight::get_df(x, type = "wald"), Inf) + } + # we now iterate all confidence intervals and create an approximate normal + # distribution that covers the CI-range. + posterior <- as.data.frame(lapply(seq_len(nrow(out)), function(i) { + ci_range <- as.numeric(out[i, c("CI_low", "CI_high")]) + .generate_posterior_from_ci(ci, ci_range, dof = dof) + })) + colnames(posterior) <- out$Parameter + + # deal with Effects and Component columns + if ("Effects" %in% colnames(out) && insight::n_unique(out$Effects) == 1) { + out$Effects <- NULL + } + if ("Component" %in% colnames(out) && insight::n_unique(out$Component) == 1) { + out$Component <- NULL + } + + # check we don't have duplicated columns in "posterior" we need this for + # plotting + if (anyDuplicated(colnames(posterior)) > 0 && !is.null(out$Component)) { + comps <- .rename_values(out$Component, "zero_inflated", "zi") + comps <- .rename_values(comps, "conditional", "cond") + colnames(posterior) <- paste0(out$Parameter, "_", comps) + out$Parameter <- paste0(out$Parameter, "_", comps) + } + list(out = out, posterior = posterior) +} + + +# methods --------------------------------------------------------------------- + +#' @export +print.p_significance_lm <- function(x, digits = 2, ...) { + threshold <- attributes(x)$threshold + # Check if threshold is a list, which indicates multiple thresholds + if (is.list(threshold)) { + caption <- "Practical Significance" + } else { + # make sure it's numeric + if (!is.numeric(threshold)) { + threshold <- 0.1 + } + # make sure we have both bounds for the range + if (length(threshold) == 1) { + threshold <- c(threshold * -1, threshold) + } + caption <- sprintf( + "Practical Significance (threshold: %s)", + toString(insight::format_value(threshold, digits = 2)) + ) + } + x$ps <- insight::format_pd(x$ps, name = NULL) + x <- insight::format_table(x, digits = digits) + cat(insight::export_table(x, title = caption, ...)) +} + + +# other classes -------------------------------------------------------------- + +#' @export +p_significance.glm <- p_significance.lm + +#' @export +p_significance.coxph <- p_significance.lm + +#' @export +p_significance.svyglm <- p_significance.lm + +#' @export +p_significance.glmmTMB <- p_significance.lm + +#' @export +p_significance.merMod <- p_significance.lm + +#' @export +p_significance.wbm <- p_significance.lm + +#' @export +p_significance.lme <- p_significance.lm + +#' @export +p_significance.gee <- p_significance.lm + +#' @export +p_significance.gls <- p_significance.lm + +#' @export +p_significance.feis <- p_significance.lm + +#' @export +p_significance.felm <- p_significance.lm + +#' @export +p_significance.mixed <- p_significance.lm + +#' @export +p_significance.hurdle <- p_significance.lm + +#' @export +p_significance.zeroinfl <- p_significance.lm + +#' @export +p_significance.rma <- p_significance.lm + +#' @export +p_significance.parameters_model <- p_significance.lm diff --git a/R/pool_parameters.R b/R/pool_parameters.R index f985a84af..8693641af 100644 --- a/R/pool_parameters.R +++ b/R/pool_parameters.R @@ -17,12 +17,10 @@ #' #' @note #' Models with multiple components, (for instance, models with zero-inflation, -#' where predictors appear in the count and zero-inflation part) may fail in -#' case of identical names for coefficients in the different model components, -#' since the coefficient table is grouped by coefficient names for pooling. In -#' such cases, coefficients of count and zero-inflation model parts would be -#' combined. Therefore, the `component` argument defaults to -#' `"conditional"` to avoid this. +#' where predictors appear in the count and zero-inflation part, or models with +#' dispersion component) may fail in rare situations. In this case, compute +#' the pooled parameters for components separately, using the `component` +#' argument. #' #' Some model objects do not return standard errors (e.g. objects of class #' `htest`). For these models, no pooled confidence intervals nor p-values @@ -68,7 +66,7 @@ pool_parameters <- function(x, exponentiate = FALSE, effects = "fixed", - component = "conditional", + component = "all", verbose = TRUE, ...) { # check input, save original model ----- @@ -163,75 +161,92 @@ pool_parameters <- function(x, params <- params[params$Effects != "random", ] parameter_values <- x[[1]]$Parameter[x[[1]]$Effects != "random"] } - estimates <- split(params, factor(params$Parameter, levels = unique(parameter_values))) + # split by component + if (!is.null(params$Component) && insight::n_unique(params$Component) > 1) { + component_values <- x[[1]]$Component + estimates <- split( + params, + list( + factor(params$Parameter, levels = unique(parameter_values)), + factor(params$Component, levels = unique(component_values)) + ) + ) + } else { + component_values <- NULL + estimates <- split( + params, + factor(params$Parameter, levels = unique(parameter_values)) + ) + } # pool estimates etc. ----- pooled_params <- do.call(rbind, lapply(estimates, function(i) { - # pooled estimate - pooled_estimate <- mean(i$Coefficient) + # if we split by "component", some of the data frames might be empty + # in this case, just skip... + if (nrow(i) > 0) { + # pooled estimate + pooled_estimate <- mean(i$Coefficient) + + # special models that have no standard errors (like "htest" objects) + if (is.null(i$SE) || all(is.na(i$SE))) { + out <- data.frame( + Coefficient = pooled_estimate, + SE = NA, + CI_low = NA, + CI_high = NA, + Statistic = NA, + df_error = NA, + p = NA, + stringsAsFactors = FALSE + ) + + if (verbose) { + insight::format_alert("Model objects had no standard errors. Cannot compute pooled confidence intervals and p-values.") + } - # special models that have no standard errors (like "htest" objects) - if (is.null(i$SE) || all(is.na(i$SE))) { - out <- data.frame( - Coefficient = pooled_estimate, - SE = NA, - CI_low = NA, - CI_high = NA, - Statistic = NA, - df_error = NA, - p = NA, - stringsAsFactors = FALSE - ) + # regular models that have coefficients and standard errors + } else { + # pooled standard error + ubar <- mean(i$SE^2) + tmp <- ubar + (1 + 1 / len) * stats::var(i$Coefficient) + pooled_se <- sqrt(tmp) + + # pooled degrees of freedom, Barnard-Rubin adjustment for small samples + df_column <- grep("(\\bdf\\b|\\bdf_error\\b)", colnames(i), value = TRUE)[1] + if (length(df_column)) { + pooled_df <- .barnad_rubin(m = nrow(i), b = stats::var(i$Coefficient), t = tmp, dfcom = unique(i[[df_column]])) + # validation check length + if (length(pooled_df) > 1 && length(pooled_se) == 1) { + pooled_df <- round(mean(pooled_df, na.rm = TRUE)) + } + } else { + pooled_df <- Inf + } - if (verbose) { - insight::format_alert("Model objects had no standard errors. Cannot compute pooled confidence intervals and p-values.") + # pooled statistic + pooled_statistic <- pooled_estimate / pooled_se + + # confidence intervals + alpha <- (1 + ci) / 2 + fac <- suppressWarnings(stats::qt(alpha, df = pooled_df)) + + out <- data.frame( + Coefficient = pooled_estimate, + SE = pooled_se, + CI_low = pooled_estimate - pooled_se * fac, + CI_high = pooled_estimate + pooled_se * fac, + Statistic = pooled_statistic, + df_error = pooled_df, + p = 2 * stats::pt(abs(pooled_statistic), df = pooled_df, lower.tail = FALSE), + stringsAsFactors = FALSE + ) } - - # regular models that have coefficients and standard errors + out } else { - # pooled standard error - ubar <- mean(i$SE^2) - tmp <- ubar + (1 + 1 / len) * stats::var(i$Coefficient) - pooled_se <- sqrt(tmp) - - # pooled degrees of freedom, Barnard-Rubin adjustment for small samples - df_column <- grep("(\\bdf\\b|\\bdf_error\\b)", colnames(i), value = TRUE)[1] - if (length(df_column)) { - pooled_df <- .barnad_rubin(m = nrow(i), b = stats::var(i$Coefficient), t = tmp, dfcom = unique(i[[df_column]])) - # validation check length - if (length(pooled_df) > 1 && length(pooled_se) == 1) { - pooled_df <- round(mean(pooled_df, na.rm = TRUE)) - } - } else { - pooled_df <- Inf - } - - # pooled statistic - pooled_statistic <- pooled_estimate / pooled_se - - # confidence intervals - alpha <- (1 + ci) / 2 - fac <- suppressWarnings(stats::qt(alpha, df = pooled_df)) - - out <- data.frame( - Coefficient = pooled_estimate, - SE = pooled_se, - CI_low = pooled_estimate - pooled_se * fac, - CI_high = pooled_estimate + pooled_se * fac, - Statistic = pooled_statistic, - df_error = pooled_df, - p = 2 * stats::pt(abs(pooled_statistic), df = pooled_df, lower.tail = FALSE), - stringsAsFactors = FALSE - ) - } - - # add component, when pooling for all components - if (identical(component, "all") && "Component" %in% colnames(i)) { - out$Component <- i$Component[1] + NULL } - out })) @@ -249,13 +264,13 @@ pool_parameters <- function(x, stringsAsFactors = FALSE ) })) + pooled_params$Effects <- "fixed" } - # reorder ------ pooled_params$Parameter <- parameter_values - columns <- c("Parameter", "Coefficient", "SE", "CI_low", "CI_high", "Statistic", "df_error", "p", "Component") + columns <- c("Parameter", "Coefficient", "SE", "CI_low", "CI_high", "Statistic", "df_error", "p", "Effects", "Component") pooled_params <- pooled_params[intersect(columns, colnames(pooled_params))] @@ -268,6 +283,11 @@ pool_parameters <- function(x, pooled_params <- merge(pooled_params, pooled_random, all = TRUE, sort = FALSE) } + # add back component column + if (!is.null(component_values)) { + pooled_params$Component <- component_values + } + # this needs to be done extra here, cannot call ".add_model_parameters_attributes()" pooled_params <- .add_pooled_params_attributes( pooled_params, diff --git a/R/principal_components.R b/R/principal_components.R index 2166507eb..9f3e74f8e 100644 --- a/R/principal_components.R +++ b/R/principal_components.R @@ -42,7 +42,10 @@ #' predicted data and original data is equal. #' @param ... Arguments passed to or from other methods. #' @param pca_results The output of the `principal_components()` function. -#' @param digits,labels Arguments for `print()`. +#' @param digits Argument for `print()`, indicates the number of digits +#' (rounding) to be used. +#' @param labels Argument for `print()`, character vector of same length as +#' columns in `x`. If provided, adds an additional column with the labels. #' @param verbose Toggle warnings. #' @inheritParams n_factors #' @@ -140,6 +143,17 @@ #' # Automated number of components #' principal_components(mtcars[, 1:4], n = "auto") #' +#' # labels can be useful if variable names are not self-explanatory +#' print( +#' principal_components(mtcars[, 1:4], n = "auto"), +#' labels = c( +#' "Miles/(US) gallon", +#' "Number of cylinders", +#' "Displacement (cu.in.)", +#' "Gross horsepower" +#' ) +#' ) +#' #' # Sparse PCA #' principal_components(mtcars[, 1:7], n = 4, sparse = TRUE) #' principal_components(mtcars[, 1:7], n = 4, sparse = "robust") @@ -214,24 +228,26 @@ rotated_data <- function(pca_results, verbose = TRUE) { rotated_matrix <- insight::get_predicted(attributes(pca_results)$model) out <- NULL - if (!is.null(original_data) && !is.null(rotated_matrix)) { - compl_cases <- attributes(pca_results)$complete_cases - if (is.null(compl_cases) && nrow(original_data) != nrow(rotated_matrix)) { - if (verbose) { - insight::format_warning("Could not retrieve information about missing data.") - } - return(NULL) - } - original_data$.parameters_merge_id <- seq_len(nrow(original_data)) - rotated_matrix$.parameters_merge_id <- (seq_len(nrow(original_data)))[compl_cases] - out <- merge(original_data, rotated_matrix, by = ".parameters_merge_id", all = TRUE, sort = FALSE) - out$.parameters_merge_id <- NULL - } else { + if (is.null(original_data) || is.null(rotated_matrix)) { if (verbose) { insight::format_warning("Either the original or the rotated data could not be retrieved.") } return(NULL) } + + compl_cases <- attributes(pca_results)$complete_cases + if (is.null(compl_cases) && nrow(original_data) != nrow(rotated_matrix)) { + if (verbose) { + insight::format_warning("Could not retrieve information about missing data.") + } + return(NULL) + } + + original_data$.parameters_merge_id <- seq_len(nrow(original_data)) + rotated_matrix$.parameters_merge_id <- (seq_len(nrow(original_data)))[compl_cases] + out <- merge(original_data, rotated_matrix, by = ".parameters_merge_id", all = TRUE, sort = FALSE) + out$.parameters_merge_id <- NULL + out } @@ -267,7 +283,7 @@ principal_components.data.frame <- function(x, insight::format_error("Sparse PCA is currently incompatible with rotation. Use either `sparse=TRUE` or `rotation`.") } - loadings <- .pca_rotate( + pca_loadings <- .pca_rotate( x, n, rotation = rotation, @@ -277,8 +293,8 @@ principal_components.data.frame <- function(x, ... ) - attr(loadings, "data") <- data_name - return(loadings) + attr(pca_loadings, "data") <- data_name + return(pca_loadings) } # Compute PCA @@ -350,60 +366,62 @@ principal_components.data.frame <- function(x, # Compute loadings if (length(model$sdev) > 1) { - loadings <- as.data.frame(model$rotation %*% diag(model$sdev)) + pca_loadings <- as.data.frame(model$rotation %*% diag(model$sdev)) } else { - loadings <- as.data.frame(model$rotation %*% model$sdev) + pca_loadings <- as.data.frame(model$rotation %*% model$sdev) } - names(loadings) <- data_summary$Component + names(pca_loadings) <- data_summary$Component # Format - loadings <- cbind(data.frame(Variable = row.names(loadings)), loadings) - row.names(loadings) <- NULL + pca_loadings <- cbind(data.frame(Variable = row.names(pca_loadings)), pca_loadings) + row.names(pca_loadings) <- NULL # Add information loading_cols <- 2:(n + 1) - loadings$Complexity <- (apply(loadings[, loading_cols, drop = FALSE], 1, function(x) sum(x^2)))^2 / - apply(loadings[, loading_cols, drop = FALSE], 1, function(x) sum(x^4)) + pca_loadings$Complexity <- (apply(pca_loadings[, loading_cols, drop = FALSE], 1, function(x) sum(x^2)))^2 / + apply(pca_loadings[, loading_cols, drop = FALSE], 1, function(x) sum(x^4)) # Add attributes - attr(loadings, "summary") <- data_summary - attr(loadings, "model") <- model - attr(loadings, "rotation") <- "none" - attr(loadings, "scores") <- model$x - attr(loadings, "standardize") <- standardize - attr(loadings, "additional_arguments") <- list(...) - attr(loadings, "n") <- n - attr(loadings, "type") <- "prcomp" - attr(loadings, "loadings_columns") <- loading_cols - attr(loadings, "complete_cases") <- stats::complete.cases(original_data) + attr(pca_loadings, "summary") <- data_summary + attr(pca_loadings, "model") <- model + attr(pca_loadings, "rotation") <- "none" + attr(pca_loadings, "scores") <- model$x + attr(pca_loadings, "standardize") <- standardize + attr(pca_loadings, "additional_arguments") <- list(...) + attr(pca_loadings, "n") <- n + attr(pca_loadings, "type") <- "prcomp" + attr(pca_loadings, "loadings_columns") <- loading_cols + attr(pca_loadings, "complete_cases") <- stats::complete.cases(original_data) # Sorting if (isTRUE(sort)) { - loadings <- .sort_loadings(loadings) + pca_loadings <- .sort_loadings(pca_loadings) } # Replace by NA all cells below threshold if (!is.null(threshold)) { - loadings <- .filter_loadings(loadings, threshold = threshold) + pca_loadings <- .filter_loadings(pca_loadings, threshold = threshold) } # Add some more attributes - attr(loadings, "loadings_long") <- .long_loadings(loadings, threshold = threshold) + attr(pca_loadings, "loadings_long") <- .long_loadings(pca_loadings, threshold = threshold) # here we match the original columns in the data set with the assigned components # for each variable, so we know which column in the original data set belongs # to which extracted component... - attr(loadings, "closest_component") <- - .closest_component(loadings, loadings_columns = loading_cols, variable_names = colnames(x)) - attr(loadings, "data") <- data_name - - attr(loadings, "dataset") <- original_data + attr(pca_loadings, "closest_component") <- .closest_component( + pca_loadings, + loadings_columns = loading_cols, + variable_names = colnames(x) + ) + attr(pca_loadings, "data") <- data_name + attr(pca_loadings, "dataset") <- original_data # add class-attribute for printing - class(loadings) <- unique(c("parameters_pca", "see_parameters_pca", class(loadings))) + class(pca_loadings) <- unique(c("parameters_pca", "see_parameters_pca", class(pca_loadings))) - loadings + pca_loadings } diff --git a/R/print.compare_parameters.R b/R/print.compare_parameters.R index 8845d0701..7d058267f 100644 --- a/R/print.compare_parameters.R +++ b/R/print.compare_parameters.R @@ -1,3 +1,35 @@ +#' @title Print comparisons of model parameters +#' @name print.compare_parameters +#' +#' @description A `print()`-method for objects from [`compare_parameters()`]. +#' +#' @param x An object returned by [`compare_parameters()`]. +#' @param engine Character string, naming the package or engine to be used for +#' printing into HTML or markdown format. Currently supported `"gt"` (or +#' `"default"`) to use the *gt* package to print to HTML and the default easystats +#' engine to create markdown tables. If `engine = "tt"`, the *tinytable* package +#' is used for printing to HTML or markdown. Not all `print()` methods support +#' the `"tt"` engine yet. If a specific `print()` method has no `engine` argument, +#' `insight::export_table()` is used, which uses *gt* for HTML printing. +#' @inheritParams print.parameters_model +#' @inheritSection print.parameters_model Global Options to Customize Messages and Tables when Printing +#' +#' @return Invisibly returns the original input object. +#' +#' @examplesIf require("gt", quietly = TRUE) +#' \donttest{ +#' data(iris) +#' lm1 <- lm(Sepal.Length ~ Species, data = iris) +#' lm2 <- lm(Sepal.Length ~ Species + Petal.Length, data = iris) +#' +#' # custom style +#' result <- compare_parameters(lm1, lm2, select = "{estimate}{stars} ({se})") +#' print(result) +#' +#' # custom style, in HTML +#' result <- compare_parameters(lm1, lm2, select = "{estimate}
({se})|{p}") +#' print_html(result) +#' } #' @export print.compare_parameters <- function(x, split_components = TRUE, @@ -46,7 +78,8 @@ print.compare_parameters <- function(x, ci_brackets = ci_brackets, format = "text", groups = groups, - zap_small = zap_small + zap_small = zap_small, + ... ) # if we have multiple components, we can align colum width across components here diff --git a/R/print.parameters_model.R b/R/print.parameters_model.R index 422791258..e8f6d1206 100644 --- a/R/print.parameters_model.R +++ b/R/print.parameters_model.R @@ -92,8 +92,11 @@ #' categorical predictors. The coefficient for the reference level is always #' `0` (except when `exponentiate = TRUE`, then the coefficient will be `1`), #' so this is just for completeness. +#' @param ... Arguments passed down to [`format.parameters_model()`], +#' [`insight::format_table()`] and [`insight::export_table()`] #' @inheritParams insight::format_table #' @inheritParams compare_parameters +#' @inheritParams display.parameters_model #' #' @inheritSection format_parameters Interpretation of Interaction Terms #' @inheritSection model_parameters Labeling the Degrees of Freedom @@ -104,13 +107,13 @@ #' some messages providing additional information can be displayed or suppressed #' using `options()`: #' -#' - `parameters_summary`: `options(parameters_summary = TRUE)` will override the -#' `summary` argument in `model_parameters()` and always show the model summary -#' for non-mixed models. +#' - `parameters_info`: `options(parameters_info = TRUE)` will override the +#' `include_info` argument in `model_parameters()` and always show the model +#' summary for non-mixed models. #' -#' - `parameters_mixed_summary`: `options(parameters_mixed_summary = TRUE)` will -#' override the `summary` argument in `model_parameters()` for mixed models, and -#' will then always show the model summary. +#' - `parameters_mixed_info`: `options(parameters_mixed_info = TRUE)` will +#' override the `include_info` argument in `model_parameters()` for mixed +#' models, and will then always show the model summary. #' #' - `parameters_cimethod`: `options(parameters_cimethod = TRUE)` will show the #' additional information about the approximation method used to calculate @@ -141,14 +144,16 @@ #' the default HTML engine for tables to `gt`, i.e. the _gt_ package is used to #' create HTML tables. If set to `tt`, the _tinytable_ package is used. #' +#' - `insight_use_symbols`: `options(insight_use_symbols = TRUE)` will try to +#' print unicode-chars for symbols as column names, wherever possible (e.g., +#' \ifelse{html}{\out{ω}}{\eqn{\omega}} instead of `Omega`). +#' #' @details `summary()` is a convenient shortcut for -#' `print(object, select = "minimal", show_sigma = TRUE, show_formula = TRUE)`. +#' `print(object, select = "minimal", show_sigma = TRUE, show_formula = TRUE)`. #' #' @return Invisibly returns the original input object. #' -#' @seealso There is a dedicated method to use inside rmarkdown files, -#' [`print_md()`][print_md.parameters_model]. See also -#' [`display()`][display.parameters_model]. +#' @seealso See also [`display()`][display.parameters_model]. #' #' @examplesIf require("gt", quietly = TRUE) && require("glmmTMB", quietly = TRUE) #' \donttest{ @@ -386,7 +391,7 @@ print.parameters_random <- function(x, digits = 2, ...) { ci_width = "auto", ci_brackets = TRUE, format = "text", - group = NULL, + groups = NULL, include_reference = FALSE, ...) { format( @@ -401,7 +406,7 @@ print.parameters_random <- function(x, digits = 2, ...) { ci_brackets = ci_brackets, zap_small = zap_small, format = format, - group = group, + groups = groups, include_reference = include_reference, ... ) @@ -425,6 +430,7 @@ print.parameters_random <- function(x, digits = 2, ...) { show_sigma <- ifelse(show_summary, TRUE, show_sigma) show_formula <- ifelse(show_summary, TRUE, show_formula) show_r2 <- .additional_arguments(x, "show_summary", FALSE) + show_rmse <- .additional_arguments(x, "show_summary", FALSE) # set defaults, if necessary if (is.null(model_sigma)) { @@ -438,6 +444,7 @@ print.parameters_random <- function(x, digits = 2, ...) { show_sigma = show_sigma, show_formula = show_formula, show_r2 = show_r2, + show_rmse = show_rmse, format = format ) } diff --git a/R/print_html.R b/R/print_html.R index d71aa194b..5c37b831e 100644 --- a/R/print_html.R +++ b/R/print_html.R @@ -1,6 +1,6 @@ # normal print ---------------------------- -#' @rdname display.parameters_model +#' @rdname print.parameters_model #' @export print_html.parameters_model <- function(x, pretty_names = TRUE, @@ -138,6 +138,7 @@ print_html.parameters_simulate <- print_html.parameters_model #' @export print_html.parameters_sem <- print_html.parameters_model +#' @rdname print.compare_parameters #' @export print_html.compare_parameters <- function(x, caption = NULL, diff --git a/R/print_md.R b/R/print_md.R index 5a4990f54..f7bc40e64 100644 --- a/R/print_md.R +++ b/R/print_md.R @@ -1,6 +1,6 @@ # normal print ---------------------------- -#' @rdname display.parameters_model +#' @rdname print.parameters_model #' @export print_md.parameters_model <- function(x, pretty_names = TRUE, @@ -123,6 +123,7 @@ print_md.parameters_simulate <- print_md.parameters_model # compare parameters ------------------------- +#' @rdname print.compare_parameters #' @export print_md.compare_parameters <- function(x, digits = 2, @@ -251,9 +252,9 @@ print_md.parameters_efa_summary <- function(x, digits = 3, ...) { table_caption <- "(Explained) Variance of Components" if ("Parameter" %in% names(x)) { - x$Parameter <- c("Eigenvalues", "Variance Explained", "Variance Explained (Cumulative)", "Variance Explained (Proportion)") + x$Parameter <- c("Eigenvalues", "Variance Explained", "Variance Explained (Cumulative)", "Variance Explained (Proportion)") # nolint } else if ("Component" %in% names(x)) { - names(x) <- c("Component", "Eigenvalues", "Variance Explained", "Variance Explained (Cumulative)", "Variance Explained (Proportion)") + names(x) <- c("Component", "Eigenvalues", "Variance Explained", "Variance Explained (Cumulative)", "Variance Explained (Proportion)") # nolint } insight::export_table(x, digits = digits, format = "markdown", caption = table_caption, align = "firstleft") } @@ -326,7 +327,7 @@ print_md.equivalence_test_lm <- function(x, digits = 2, ci_brackets = c("(", ")" } if (!is.null(rope)) { - names(formatted_table)[names(formatted_table) == "% in ROPE"] <- sprintf("%% in ROPE (%.*f, %.*f)", digits, rope[1], digits, rope[2]) + names(formatted_table)[names(formatted_table) == "% in ROPE"] <- sprintf("%% in ROPE (%.*f, %.*f)", digits, rope[1], digits, rope[2]) # nolint } insight::export_table(formatted_table, format = "markdown", caption = table_caption, align = "firstleft") diff --git a/R/reduce_parameters.R b/R/reduce_parameters.R index 8e12c852c..92bdb0aa5 100644 --- a/R/reduce_parameters.R +++ b/R/reduce_parameters.R @@ -86,7 +86,7 @@ reduce_data <- function(x, method = "PCA", n = "max", distance = "euclidean", .. #' @export reduce_parameters.data.frame <- function(x, method = "PCA", n = "max", distance = "euclidean", ...) { - x <- datawizard::to_numeric(x) + x <- datawizard::to_numeric(x, dummy_factors = TRUE) # N factors if (n == "max") { @@ -144,7 +144,7 @@ reduce_parameters.data.frame <- function(x, method = "PCA", n = "max", distance #' @export reduce_parameters.lm <- function(x, method = "PCA", n = "max", distance = "euclidean", ...) { model_data <- reduce_parameters( - datawizard::to_numeric(insight::get_predictors(x, ...), ...), + datawizard::to_numeric(insight::get_predictors(x, ...), ..., dummy_factors = TRUE), method = method, n = n, distance = distance diff --git a/R/select_parameters.R b/R/select_parameters.R index 3588d74e4..93c697017 100644 --- a/R/select_parameters.R +++ b/R/select_parameters.R @@ -6,21 +6,17 @@ #' @param model A statistical model (of class `lm`, `glm`, or `merMod`). #' @param ... Arguments passed to or from other methods. #' -#' @details -#' \subsection{Classical lm and glm}{ -#' For frequentist GLMs, `select_parameters()` performs an AIC-based -#' stepwise selection. -#' } +#' @section Classical lm and glm: +#' For frequentist GLMs, `select_parameters()` performs an AIC-based stepwise +#' selection. #' -#' \subsection{Mixed models}{ -#' For mixed-effects models of class `merMod`, stepwise selection is -#' based on [cAIC4::stepcAIC()]. This step function -#' only searches the "best" model based on the random-effects structure, -#' i.e. `select_parameters()` adds or excludes random-effects until -#' the cAIC can't be improved further. -#' } +#' @section Mixed models: +#' For mixed-effects models of class `merMod`, stepwise selection is based on +#' [`cAIC4::stepcAIC()`]. This step function only searches the "best" model +#' based on the random-effects structure, i.e. `select_parameters()` adds or +#' excludes random-effects until the cAIC can't be improved further. #' -#' @examples +#' @examplesIf requireNamespace("lme4") #' model <- lm(mpg ~ ., data = mtcars) #' select_parameters(model) #' @@ -28,13 +24,11 @@ #' select_parameters(model) #' \donttest{ #' # lme4 ------------------------------------------- -#' if (require("lme4")) { -#' model <- lmer( -#' Sepal.Width ~ Sepal.Length * Petal.Width * Petal.Length + (1 | Species), -#' data = iris -#' ) -#' select_parameters(model) -#' } +#' model <- lme4::lmer( +#' Sepal.Width ~ Sepal.Length * Petal.Width * Petal.Length + (1 | Species), +#' data = iris +#' ) +#' select_parameters(model) #' } #' #' @return The model refitted with optimal number of parameters. @@ -45,6 +39,9 @@ select_parameters <- function(model, ...) { #' @rdname select_parameters +#' @param k The multiple of the number of degrees of freedom used for the penalty. +#' Only `k = 2` gives the genuine AIC: `k = log(n)` is sometimes referred to as +#' BIC or SBC. #' @inheritParams stats::step #' @export select_parameters.lm <- function(model, @@ -108,10 +105,15 @@ select_parameters.merMod <- function(model, ) - # Using MuMIn's dredge(): works nicely BUT throws unnecessary warnings and requires to set global options for na.action even tho no NaNs. + # Using MuMIn's dredge(): works nicely BUT throws unnecessary warnings and + # requires to set global options for na.action even tho no NaNs. # The code is here: https://github.com/cran/MuMIn/blob/master/R/dredge.R Maybe it could be reimplemented? # insight::check_if_installed("MuMIn") - # model <- lmer(Sepal.Width ~ Sepal.Length * Petal.Width * Petal.Length + (1 | Species), data = iris, na.action = na.fail) + # model <- lmer( + # Sepal.Width ~ Sepal.Length * Petal.Width * Petal.Length + (1 | Species), + # data = iris, + # na.action = na.fail + # ) # summary(MuMIn::get.models(MuMIn::dredge(model), 1)[[1]]) best diff --git a/R/standardize_info.R b/R/standardize_info.R index 0d6fe5b9f..dfb300b77 100644 --- a/R/standardize_info.R +++ b/R/standardize_info.R @@ -17,7 +17,7 @@ #' #' @family standardize #' -#' @examples +#' @examplesIf insight::check_if_installed("datawizard", minimum_version = "0.12.0", quietly = TRUE) #' model <- lm(mpg ~ ., data = mtcars) #' standardize_info(model) #' standardize_info(model, robust = TRUE) @@ -52,8 +52,8 @@ standardize_info.default <- function(model, types <- parameters_type(model) # model_matrix <- as.data.frame(stats::model.matrix(model)) model_matrix <- as.data.frame(insight::get_modelmatrix(model)) - data <- insight::get_data(model, source = "mf", verbose = FALSE) - wgts <- insight::get_weights(model, na_rm = TRUE) + model_data <- insight::get_data(model, source = "mf", verbose = FALSE) + wgts <- insight::get_weights(model, remove_na = TRUE) # validation check for ZI if (mi$is_zero_inflated && verbose) { @@ -94,7 +94,7 @@ standardize_info.default <- function(model, # Response - Smart out <- merge( out, - .std_info_response_smart(model, mi, data, model_matrix, types, robust = robust, w = wgts), + .std_info_response_smart(model, mi, data = model_data, model_matrix, types, robust = robust, w = wgts), by = "Parameter", all = TRUE ) @@ -109,7 +109,7 @@ standardize_info.default <- function(model, out <- merge( out, .std_info_predictors_smart(model, - data, + data = model_data, params, types, robust = robust, @@ -134,7 +134,7 @@ standardize_info.default <- function(model, model, mi, params, model_matrix, - data, + data = model_data, types = types$Type, robust = robust, two_sd = two_sd, @@ -181,11 +181,11 @@ standardize_info.default <- function(model, # Get deviations for all parameters means <- deviations <- rep(NA_real_, times = length(params)) for (i in seq_along(params)) { - var <- params[i] + variable <- params[i] info <- .std_info_predictor_smart( data = data, - variable = types[types$Parameter == var, "Variable"], - type = types[types$Parameter == var, "Type"], + variable = types[types$Parameter == variable, "Variable"], + type = types[types$Parameter == variable, "Type"], robust = robust, two_sd = two_sd, weights = w @@ -213,7 +213,7 @@ standardize_info.default <- function(model, two_sd = FALSE, weights = NULL, ...) { - if (type == "intercept") { + if (type == "intercept") { # nolint info <- list(sd = 0, mean = 0) } else if (type == "numeric") { info <- .compute_std_info( @@ -272,12 +272,12 @@ standardize_info.default <- function(model, # Get deviations for all parameters means <- deviations <- rep(NA_real_, length = length(names(model_matrix))) for (i in seq_along(names(model_matrix))) { - var <- names(model_matrix)[i] + variable <- names(model_matrix)[i] if (types[i, "Type"] == "intercept") { means[i] <- deviations[i] <- 0 } else { std_info <- .compute_std_info( - data = model_matrix, variable = var, + data = model_matrix, variable = variable, robust = robust, two_sd = two_sd, weights = w ) deviations[i] <- std_info$sd @@ -337,9 +337,9 @@ standardize_info.default <- function(model, } means <- deviations <- rep(NA_real_, length = length(names(model_matrix))) for (i in seq_along(names(model_matrix))) { - var <- names(model_matrix)[i] - if (any(types$Parameter == var) && types$Link[types$Parameter == var] == "Difference") { - parent_var <- types$Variable[types$Parameter == var] + variable <- names(model_matrix)[i] + if (any(types$Parameter == variable) && types$Link[types$Parameter == variable] == "Difference") { + parent_var <- types$Variable[types$Parameter == variable] intercept <- unique(data[[parent_var]])[1] response_at_intercept <- response[data[[parent_var]] == intercept] weights_at_intercept <- if (length(w)) w[data[[parent_var]] == intercept] else NULL @@ -422,18 +422,19 @@ standardize_info.default <- function(model, } insight::check_if_installed("performance") + insight::check_if_installed("datawizard", minimum_version = "0.12.0") f <- if (two_sd) 2 else 1 within_vars <- unclass(performance::check_heterogeneity_bias(model)) id <- insight::get_random(model)[[1]] - w <- insight::get_weights(model, na_rm = TRUE) + w <- insight::get_weights(model, remove_na = TRUE) ## Find which parameters vary on level 1 ("within") is_within <- logical(length = length(params)) is_within[] <- NA for (i in seq_along(params)) { - if (types[i] == "intercept") { + if (types[i] == "intercept") { # nolint is_within[i] <- FALSE } else if (types[i] == "numeric") { is_within[i] <- insight::clean_names(params[i]) %in% within_vars @@ -459,7 +460,7 @@ standardize_info.default <- function(model, dm <- datawizard::demean(cbind(id, temp_d), select = colnames(temp_d), - group = "id" + by = "id" ) dm <- dm[, paste0(colnames(temp_d), "_between"), drop = FALSE] diff --git a/R/standardize_parameters.R b/R/standardize_parameters.R index 1c3885271..8a2d2b3fc 100644 --- a/R/standardize_parameters.R +++ b/R/standardize_parameters.R @@ -13,7 +13,7 @@ #' @inheritParams datawizard::standardize.default #' @inheritParams effectsize::chisq_to_phi #' @param ... For `standardize_parameters()`, arguments passed to -#' [model_parameters()], such as: +#' [`model_parameters()`], such as: #' - `ci_method`, `centrality` for Mixed models and Bayesian models... #' - `exponentiate`, ... #' - etc. @@ -30,7 +30,7 @@ #' include interactions or transformations (e.g., polynomial or spline terms). #' The `robust` (default to `FALSE`) argument enables a robust standardization #' of data, i.e., based on the `median` and `MAD` instead of the `mean` and -#' `SD`. **See [standardize()] for more details.** +#' `SD`. **See [`datawizard::standardize()`] for more details.** #' - **Note** that `standardize_parameters(method = "refit")` may not return #' the same results as fitting a model on data that has been standardized with #' `standardize()`; `standardize_parameters()` used the data used by the model @@ -52,7 +52,7 @@ #' deviation of model's matrix' parameter of factors levels (transformed to #' integers) or binary predictors. Although being inappropriate for these cases, #' this method is the one implemented by default in other software packages, -#' such as [lm.beta::lm.beta()]. +#' such as [`lm.beta::lm.beta()`]. #' - **smart** (Standardization of Model's parameters with Adjustment, #' Reconnaissance and Transformation - *experimental*): Similar to `method = #' "posthoc"` in that it does not involve model refitting. The difference is @@ -64,9 +64,9 @@ #' delta. #' - **pseudo** (*for 2-level (G)LMMs only*): In this (post-hoc) method, the #' response and the predictor are standardized based on the level of prediction -#' (levels are detected with [performance::check_heterogeneity_bias()]): Predictors +#' (levels are detected with [`performance::check_heterogeneity_bias()`]): Predictors #' are standardized based on their SD at level of prediction (see also -#' [datawizard::demean()]); The outcome (in linear LMMs) is standardized based +#' [`datawizard::demean()`]); The outcome (in linear LMMs) is standardized based #' on a fitted random-intercept-model, where `sqrt(random-intercept-variance)` #' is used for level 2 predictors, and `sqrt(residual-variance)` is used for #' level 1 predictors (Hoffman 2015, page 342). A warning is given when a @@ -91,9 +91,9 @@ #' equivalent to `exp(scale(X))`), the `"basic"` method standardizes the #' transformed data (e.g. equivalent to `scale(exp(X))`). #' \cr\cr -#' See the *Transformed Variables* section in [standardize.default()] for more -#' details on how different transformations are dealt with when `method = -#' "refit"`. +#' See the *Transformed Variables* section in [`datawizard::standardize.default()`] +#' for more details on how different transformations are dealt with when +#' `method = "refit"`. #' #' ## Confidence Intervals #' The returned confidence intervals are re-scaled versions of the @@ -225,6 +225,8 @@ standardize_parameters.default <- function(model, class(model) <- class(model)[class(model) != "aov"] } pars <- model_parameters(model, ci = ci, standardize = NULL, effects = "fixed", as_draws = TRUE, ...) + # save attributes for later, these are lost in between + att <- attributes(pars) # should post hoc exponentiate? exponentiate <- isTRUE(eval(match.call()[["exponentiate"]], envir = parent.frame())) @@ -267,6 +269,11 @@ standardize_parameters.default <- function(model, pars$SE <- NULL } + # add those attributes back here... + if (!is.null(att)) { + attributes(pars) <- utils::modifyList(att, attributes(pars)) + } + ## attributes attr(pars, "std_method") <- method attr(pars, "two_sd") <- two_sd diff --git a/R/standardize_posteriors.R b/R/standardize_posteriors.R index cccab54ca..27a9f5baf 100644 --- a/R/standardize_posteriors.R +++ b/R/standardize_posteriors.R @@ -72,7 +72,7 @@ standardise_posteriors <- standardize_posteriors i <- match(deviations$Parameter, colnames(pars)) pars <- pars[, i] - if (method == "basic") { + if (method == "basic") { # nolint col_dev_resp <- "Deviation_Response_Basic" col_dev_pred <- "Deviation_Basic" } else if (method == "posthoc") { diff --git a/R/utils.R b/R/utils.R index 0e5e3c186..4725b710e 100644 --- a/R/utils.R +++ b/R/utils.R @@ -1,6 +1,6 @@ # small wrapper around this commonly used try-catch .safe <- function(code, on_error = NULL) { - if (getOption("easystats_erros", FALSE) && is.null(on_error)) { + if (isTRUE(getOption("easystats_errors", FALSE)) && is.null(on_error)) { code } else { tryCatch(code, error = function(e) on_error) @@ -219,3 +219,14 @@ } ifnotfound } + +.deprecated_warning <- function(old, new, verbose = TRUE) { + if (verbose) { + insight::format_warning(paste0( + "Argument `", old, + "` is deprecated and will be removed in the future. Please use `", + new, + "` instead." + )) + } +} diff --git a/R/utils_format.R b/R/utils_format.R index 2b7e6c513..4b2a58d73 100644 --- a/R/utils_format.R +++ b/R/utils_format.R @@ -295,15 +295,15 @@ } # fix coefficient column name for random effects - if (!is.null(x$Effects) && all(x$Effects == "random") && any(colnames(x) %in% .all_coefficient_types())) { - colnames(x)[colnames(x) %in% .all_coefficient_types()] <- "Coefficient" + if (!is.null(x$Effects) && all(x$Effects == "random") && any(colnames(x) %in% .all_coefficient_types)) { + colnames(x)[colnames(x) %in% .all_coefficient_types] <- "Coefficient" } # fix coefficient column name for mixed count and zi pars if (!is.null(x$Component) && sum(c("conditional", "zero_inflated", "dispersion") %in% x$Component) >= 2 && - any(colnames(x) %in% .all_coefficient_types())) { - colnames(x)[colnames(x) %in% .all_coefficient_types()] <- "Coefficient" + any(colnames(x) %in% .all_coefficient_types)) { + colnames(x)[colnames(x) %in% .all_coefficient_types] <- "Coefficient" } # random pars with level? combine into parameter column @@ -476,13 +476,14 @@ # components into different tables, we change the column name for those "tables" # that contain the random effects or zero-inflation parameters -.all_coefficient_types <- function() { - c( - "Odds Ratio", "Risk Ratio", "Prevalence Ratio", "IRR", "Log-Odds", - "Log-Mean", "Log-Ratio", "Log-Prevalence", "Probability", "Marginal Means", - "Estimated Counts", "Ratio" - ) -} +.all_coefficient_types <- c( + "Odds Ratio", "Risk Ratio", "Prevalence Ratio", "IRR", "Log-Odds", + "Log-Mean", "Log-Ratio", "Log-Prevalence", "Probability", "Marginal Means", + "Estimated Counts", "Ratio" +) + + +.all_coefficient_names <- c("Coefficient", "Std_Coefficient", "Estimate", "Median", "Mean", "MAP") .format_stan_parameters <- function(out) { @@ -962,16 +963,16 @@ } # fix column output - if (inherits(attributes(x)$model, c("lavaan", "blavaan")) && "Label" %in% colnames(x)) { + if (inherits(attributes(x)[["model"]], c("lavaan", "blavaan")) && "Label" %in% colnames(x)) { x$From <- ifelse(!nzchar(as.character(x$Label), keepNA = TRUE) | x$Label == x$To, x$From, paste0(x$From, " (", x$Label, ")")) # nolint x$Label <- NULL } - if (inherits(attributes(x)$model, c("lavaan", "blavaan")) && !"Parameter" %in% colnames(x)) { + if (inherits(attributes(x)[["model"]], c("lavaan", "blavaan")) && !"Parameter" %in% colnames(x)) { parameter_column <- colnames(x)[1] } - if (inherits(attributes(x)$model, c("lavaan", "blavaan")) && "Defined" %in% x$Component) { + if (inherits(attributes(x)[["model"]], c("lavaan", "blavaan")) && "Defined" %in% x$Component) { x$From[x$Component == "Defined"] <- "" x$Operator[x$Component == "Defined"] <- "" x$To <- ifelse(x$Component == "Defined", paste0("(", x$To, ")"), x$To) @@ -1095,8 +1096,8 @@ } # rename columns for random part - if (grepl("random", type, fixed = TRUE) && any(colnames(tables[[type]]) %in% .all_coefficient_types())) { - colnames(tables[[type]])[colnames(tables[[type]]) %in% .all_coefficient_types()] <- "Coefficient" + if (grepl("random", type, fixed = TRUE) && any(colnames(tables[[type]]) %in% .all_coefficient_types)) { + colnames(tables[[type]])[colnames(tables[[type]]) %in% .all_coefficient_types] <- "Coefficient" } if (grepl("random", type, fixed = TRUE) && isTRUE(ran_pars)) { @@ -1183,7 +1184,7 @@ # fix non-equal length of columns final_table <- .fix_nonmatching_columns( final_table, - is_lavaan = inherits(attributes(x)$model, c("lavaan", "blavaan")) + is_lavaan = inherits(attributes(x)[["model"]], c("lavaan", "blavaan")) ) do.call(rbind, final_table) } else { diff --git a/R/utils_model_parameters.R b/R/utils_model_parameters.R index 07037d0dc..eaa1373ec 100644 --- a/R/utils_model_parameters.R +++ b/R/utils_model_parameters.R @@ -10,7 +10,7 @@ iterations = 1000, ci_method = NULL, p_adjust = NULL, - summary = FALSE, + include_info = FALSE, verbose = TRUE, group_level = FALSE, wb_component = FALSE, @@ -54,7 +54,7 @@ attr(params, "robust_vcov") <- isTRUE(list(...)$robust) || "vcov" %in% names(list(...)) attr(params, "ignore_group") <- isFALSE(group_level) attr(params, "ran_pars") <- isFALSE(group_level) - attr(params, "show_summary") <- isTRUE(summary) + attr(params, "show_summary") <- isTRUE(include_info) attr(params, "log_link") <- isTRUE(grepl("log", info$link_function, fixed = TRUE)) attr(params, "logit_link") <- isTRUE(identical(info$link_function, "logit")) @@ -77,10 +77,12 @@ } - # for summaries, add R2 - if (isTRUE(summary) && requireNamespace("performance", quietly = TRUE)) { + # for additional infos, add R2, RMSE + if (isTRUE(include_info) && requireNamespace("performance", quietly = TRUE)) { rsq <- .safe(suppressWarnings(performance::r2(model))) attr(params, "r2") <- rsq + rmse <- .safe(performance::performance_rmse(model)) + attr(params, "rmse") <- rmse } @@ -98,7 +100,7 @@ # weighted nobs weighted_nobs <- .safe({ - w <- insight::get_weights(model, na_rm = TRUE, null_as_ones = TRUE) + w <- insight::get_weights(model, remove_na = TRUE, null_as_ones = TRUE) round(sum(w)) }) attr(params, "weighted_nobs") <- weighted_nobs diff --git a/R/utils_pca_efa.R b/R/utils_pca_efa.R index 440f74939..68eed7452 100644 --- a/R/utils_pca_efa.R +++ b/R/utils_pca_efa.R @@ -178,7 +178,7 @@ predict.parameters_efa <- function(object, out <- as.matrix(newdata) %*% as.matrix(attri$model$loadings) out <- stats::setNames(as.data.frame(out), paste0("Component", seq_len(ncol(out)))) } else if (inherits(attri$model, c("psych", "fa", "principal"))) { - out <- as.data.frame(stats::predict(attri$model, data = newdata, ...)) + out <- as.data.frame(stats::predict(attri$model, data = newdata[rownames(attri$model$weights)], ...)) } else { out <- as.data.frame(stats::predict(attri$model, newdata = newdata, ...)) } @@ -352,13 +352,20 @@ print.parameters_omega_summary <- function(x, ...) { footer <- c(.text_components_variance(x, sep = ifelse(format == "markdown", "", "\n")), "yellow") } + # alignment? + if (is.null(labels)) { + alignment <- NULL + } else { + alignment <- paste(c("ll", rep("r", ncol(x) - 2)), collapse = "") + } + insight::export_table( x, digits = digits, format = format, caption = table_caption, footer = footer, - align = "firstleft", + align = alignment, ... ) } diff --git a/README.Rmd b/README.Rmd index 29b32bebb..6cde9fb81 100644 --- a/README.Rmd +++ b/README.Rmd @@ -1,5 +1,7 @@ --- output: github_document +bibliography: paper/paper.bib +csl: paper/apa.csl --- ```{r, warning=FALSE, message=FALSE, echo = FALSE} @@ -21,8 +23,7 @@ library(parameters) [![DOI](https://joss.theoj.org/papers/10.21105/joss.02445/status.svg)](https://doi.org/10.21105/joss.02445) [![downloads](https://cranlogs.r-pkg.org/badges/parameters)](https://cran.r-project.org/package=parameters) -[![total](https://cranlogs.r-pkg.org/badges/grand-total/parameters)](https://cranlogs.r-pkg.org/) -[![status](https://tinyverse.netlify.com/badge/parameters)](https://CRAN.R-project.org/package=parameters) +[![total](https://cranlogs.r-pkg.org/badges/grand-total/parameters)](https://cranlogs.r-pkg.org/) ***Describe and understand your model's parameters!*** @@ -50,7 +51,7 @@ Development | GitHub | `remotes::install_github("easystats/parameters")` [![Documentation](https://img.shields.io/badge/documentation-parameters-orange.svg?colorB=E91E63)](https://easystats.github.io/parameters/) [![Blog](https://img.shields.io/badge/blog-easystats-orange.svg?colorB=FF9800)](https://easystats.github.io/blog/posts/) -[![Features](https://img.shields.io/badge/features-parameters-orange.svg?colorB=2196F3)](https://easystats.github.io/parameters/reference/index.html) +[![Features](https://img.shields.io/badge/features-parameters-orange.svg?colorB=2196F3)](https://easystats.github.io/parameters/reference/index.html) Click on the buttons above to access the package [documentation](https://easystats.github.io/parameters/) and the [easystats blog](https://easystats.github.io/blog/posts/), and check-out these vignettes: @@ -70,14 +71,14 @@ In case you want to file an issue or contribute in another way to the package, p # Features - + ## Model's parameters description ```{r echo=FALSE, fig.align='center', dpi=96} knitr::include_graphics("man/figures/figure1.png") ``` -The [`model_parameters()`](https://easystats.github.io/parameters/articles/model_parameters.html) function (that can be accessed via the `parameters()` shortcut) allows you to extract the parameters and their characteristics from various models in a consistent way. It can be considered as a lightweight alternative to [`broom::tidy()`](https://github.com/tidymodels/broom), with some notable differences: +The [`model_parameters()`](https://easystats.github.io/parameters/articles/model_parameters.html) function (that can be accessed via the `parameters()` shortcut) allows you to extract the parameters and their characteristics from various models in a consistent way. It can be considered as a lightweight alternative to [`broom::tidy()`](https://github.com/tidymodels/broom), with some notable differences: - The column names of the returned data frame are *specific* to their content. For instance, the column containing the statistic is named following the statistic name, i.e., *t*, *z*, etc., instead of a generic name such as *statistic* (however, you can get standardized (generic) column names using [`standardize_names()`](https://easystats.github.io/insight/reference/standardize_names.html)). - It is able to compute or extract indices not available by default, such as *p-values*, *CIs*, etc. @@ -139,6 +140,23 @@ lm(disp ~ ., data = mtcars) |> model_parameters() ``` + +## Statistical inference - how to quantify evidence +There is no standardized approach to drawing conclusions based on the available data and statistical models. A frequently chosen but also much criticized approach is to evaluate results based on their statistical significance [@amrhein_earth_2017]. + +A more sophisticated way would be to test whether estimated effects exceed the "smallest effect size of interest", to avoid even the smallest effects being considered relevant simply because they are statistically significant, but clinically or practically irrelevant [@lakens2020equivalence;@lakens_improving_2022]. A rather unconventional approach, which is nevertheless advocated by various authors, is to interpret results from classical regression models in terms of probabilities, similar to the usual approach in Bayesian statistics [@greenland_aid_2022;@rafi_semantic_2020;@schweder_confidence_2018;@schweder_frequentist_2003;@vos_frequentist_2022]. + +The _parameters_ package provides several options or functions to aid statistical inference. These are, for example: + +- [`equivalence_test()`](https://easystats.github.io/parameters/reference/equivalence_test.lm.html), to compute the (conditional) equivalence test for frequentist models +- [`p_significance()`](https://easystats.github.io/parameters/reference/p_significance.lm.html), to compute the probability of *practical significance*, which can be conceptualized as a unidirectional equivalence test +- [`p_function()`](https://easystats.github.io/parameters/reference/p_function.html), or _consonance function_, to compute p-values and compatibility (confidence) intervals for statistical models +- the `pd` argument (setting `pd = TRUE`) in `model_parameters()` includes a column with the *probability of direction*, i.e. the probability that a parameter is strictly positive or negative. See [`bayestestR::p_direction()`](https://easystats.github.io/bayestestR/reference/p_direction.html) for details. +- the `s_value` argument (setting `s_value = TRUE`) in `model_parameters()` replaces the p-values with their related _S_-values [@@rafi_semantic_2020] +- finally, it is possible to generate distributions of model coefficients by generating bootstrap-samples (setting `bootstrap = TRUE`) or simulating draws from model coefficients using [`simulate_model()`](https://easystats.github.io/parameters/reference/simulate_model.html). These samples can then be treated as "posterior samples" and used in many functions from the **bayestestR** package. + +Most of the above shown options or functions derive from methods originally implemented for Bayesian models [@makowski_indices_2019]. However, assuming that model assumptions are met (which means, the model fits well to the data, the correct model is chosen that reflects the data generating process (distributional model family) etc.), it seems appropriate to interpret results from classical frequentist models in a "Bayesian way" (more details: documentation in [`p_function()`](https://easystats.github.io/parameters/reference/p_function.html)). + ## Citation In order to cite this package, please use the following command: @@ -148,5 +166,7 @@ citation("parameters") ``` ## Code of Conduct - + Please note that the parameters project is released with a [Contributor Code of Conduct](https://www.contributor-covenant.org/version/2/1/code_of_conduct/). By contributing to this project, you agree to abide by its terms. + +## References diff --git a/README.md b/README.md index 3b150d4aa..9e2ca989e 100644 --- a/README.md +++ b/README.md @@ -4,7 +4,6 @@ [![DOI](https://joss.theoj.org/papers/10.21105/joss.02445/status.svg)](https://doi.org/10.21105/joss.02445) [![downloads](https://cranlogs.r-pkg.org/badges/parameters)](https://cran.r-project.org/package=parameters) [![total](https://cranlogs.r-pkg.org/badges/grand-total/parameters)](https://cranlogs.r-pkg.org/) -[![status](https://tinyverse.netlify.com/badge/parameters)](https://CRAN.R-project.org/package=parameters) ***Describe and understand your model’s parameters!*** @@ -32,11 +31,11 @@ of (model) objects from many different packages. badge](https://easystats.r-universe.dev/badges/parameters)](https://easystats.r-universe.dev) [![R-CMD-check](https://github.com/easystats/parameters/workflows/R-CMD-check/badge.svg?branch=main)](https://github.com/easystats/parameters/actions) -| Type | Source | Command | -|-------------|--------------|------------------------------------------------------------------------------| -| Release | CRAN | `install.packages("parameters")` | +| Type | Source | Command | +|----|----|----| +| Release | CRAN | `install.packages("parameters")` | | Development | r - universe | `install.packages("parameters", repos = "https://easystats.r-universe.dev")` | -| Development | GitHub | `remotes::install_github("easystats/parameters")` | +| Development | GitHub | `remotes::install_github("easystats/parameters")` | > **Tip** > @@ -196,15 +195,15 @@ model <- psych::fa(attitude, nfactors = 3) model_parameters(model) #> # Rotated loadings from Factor Analysis (oblimin-rotation) #> -#> Variable | MR1 | MR2 | MR3 | Complexity | Uniqueness +#> Variable | MR1 | MR2 | MR3 | Complexity | Uniqueness #> ------------------------------------------------------------ -#> rating | 0.90 | -0.07 | -0.05 | 1.02 | 0.23 -#> complaints | 0.97 | -0.06 | 0.04 | 1.01 | 0.10 -#> privileges | 0.44 | 0.25 | -0.05 | 1.64 | 0.65 -#> learning | 0.47 | 0.54 | -0.28 | 2.51 | 0.24 -#> raises | 0.55 | 0.43 | 0.25 | 2.35 | 0.23 -#> critical | 0.16 | 0.17 | 0.48 | 1.46 | 0.67 -#> advance | -0.11 | 0.91 | 0.07 | 1.04 | 0.22 +#> rating | 0.90 | -0.07 | -0.05 | 1.02 | 0.23 +#> complaints | 0.97 | -0.06 | 0.04 | 1.01 | 0.10 +#> privileges | 0.44 | 0.25 | -0.05 | 1.64 | 0.65 +#> learning | 0.47 | 0.54 | -0.28 | 2.51 | 0.24 +#> raises | 0.55 | 0.43 | 0.25 | 2.35 | 0.23 +#> critical | 0.16 | 0.17 | 0.48 | 1.46 | 0.67 +#> advance | -0.11 | 0.91 | 0.07 | 1.04 | 0.22 #> #> The 3 latent factors (oblimin rotation) accounted for 66.60% of the total variance of the original data (MR1 = 38.19%, MR2 = 22.69%, MR3 = 5.72%). ``` @@ -231,6 +230,59 @@ lm(disp ~ ., data = mtcars) |> #> carb | -28.75 | 5.60 | [ -40.28, -17.23] | -5.13 | < .001 ``` +## Statistical inference - how to quantify evidence + +There is no standardized approach to drawing conclusions based on the +available data and statistical models. A frequently chosen but also much +criticized approach is to evaluate results based on their statistical +significance (Amrhein, Korner-Nievergelt, & Roth, 2017). + +A more sophisticated way would be to test whether estimated effects +exceed the “smallest effect size of interest”, to avoid even the +smallest effects being considered relevant simply because they are +statistically significant, but clinically or practically irrelevant +(Lakens, 2024; Lakens, Scheel, & Isager, 2018). A rather unconventional +approach, which is nevertheless advocated by various authors, is to +interpret results from classical regression models in terms of +probabilities, similar to the usual approach in Bayesian statistics +(Greenland, Rafi, Matthews, & Higgs, 2022; Rafi & Greenland, 2020; +Schweder, 2018; Schweder & Hjort, 2003; Vos & Holbert, 2022). + +The *parameters* package provides several options or functions to aid +statistical inference. These are, for example: + +- [`equivalence_test()`](https://easystats.github.io/parameters/reference/equivalence_test.lm.html), + to compute the (conditional) equivalence test for frequentist models +- [`p_significance()`](https://easystats.github.io/parameters/reference/p_significance.lm.html), + to compute the probability of *practical significance*, which can be + conceptualized as a unidirectional equivalence test +- [`p_function()`](https://easystats.github.io/parameters/reference/p_function.html), + or *consonance function*, to compute p-values and compatibility + (confidence) intervals for statistical models +- the `pd` argument (setting `pd = TRUE`) in `model_parameters()` + includes a column with the *probability of direction*, i.e. the + probability that a parameter is strictly positive or negative. See + [`bayestestR::p_direction()`](https://easystats.github.io/bayestestR/reference/p_direction.html) + for details. +- the `s_value` argument (setting `s_value = TRUE`) in + `model_parameters()` replaces the p-values with their related + *S*-values (@ Rafi & Greenland, 2020) +- finally, it is possible to generate distributions of model + coefficients by generating bootstrap-samples (setting + `bootstrap = TRUE`) or simulating draws from model coefficients using + [`simulate_model()`](https://easystats.github.io/parameters/reference/simulate_model.html). + These samples can then be treated as “posterior samples” and used in + many functions from the **bayestestR** package. + +Most of the above shown options or functions derive from methods +originally implemented for Bayesian models (Makowski, Ben-Shachar, Chen, +& Lüdecke, 2019). However, assuming that model assumptions are met +(which means, the model fits well to the data, the correct model is +chosen that reflects the data generating process (distributional model +family) etc.), it seems appropriate to interpret results from classical +frequentist models in a “Bayesian way” (more details: documentation in +[`p_function()`](https://easystats.github.io/parameters/reference/p_function.html)). + ## Citation In order to cite this package, please use the following command: @@ -264,3 +316,85 @@ Please note that the parameters project is released with a [Contributor Code of Conduct](https://www.contributor-covenant.org/version/2/1/code_of_conduct/). By contributing to this project, you agree to abide by its terms. + +## References + +
+ +
+ +Amrhein, V., Korner-Nievergelt, F., & Roth, T. (2017). The earth is flat +( *p* \> 0.05): Significance thresholds and the crisis of unreplicable +research. *PeerJ*, *5*, e3544. + +
+ +
+ +Greenland, S., Rafi, Z., Matthews, R., & Higgs, M. (2022). *To Aid +Scientific Inference, Emphasize Unconditional Compatibility Descriptions +of Statistics*. Retrieved from + +
+ +
+ +Lakens, D. (2024). *Improving Your Statistical Inferences*. + + +
+ +
+ +Lakens, D., Scheel, A. M., & Isager, P. M. (2018). Equivalence testing +for psychological research: A tutorial. *Advances in Methods and +Practices in Psychological Science*, *1*(2), 259–269. + + +
+ +
+ +Makowski, D., Ben-Shachar, M. S., Chen, S. H. A., & Lüdecke, D. (2019). +Indices of Effect Existence and Significance in the Bayesian Framework. +*Frontiers in Psychology*, *10*, 2767. + + +
+ +
+ +Rafi, Z., & Greenland, S. (2020). Semantic and cognitive tools to aid +statistical science: Replace confidence and significance by +compatibility and surprise. *BMC Medical Research Methodology*, *20*(1), +244. + +
+ +
+ +Schweder, T. (2018). Confidence is epistemic probability for empirical +science. *Journal of Statistical Planning and Inference*, *195*, +116–125. + +
+ +
+ +Schweder, T., & Hjort, N. L. (2003). Frequentist Analogues of Priors and +Posteriors. In B. Stigum (Ed.), *Econometrics and the Philosophy of +Economics: Theory-Data Confrontations in Economics* (pp. 285–217). +Retrieved from + +
+ +
+ +Vos, P., & Holbert, D. (2022). Frequentist statistical inference without +repeated sampling. *Synthese*, *200*(2), 89. + + +
+ +
diff --git a/WIP/extract_random_variances.R b/WIP/extract_random_variances.R index a77a9e85d..b28b52c60 100644 --- a/WIP/extract_random_variances.R +++ b/WIP/extract_random_variances.R @@ -674,14 +674,17 @@ attr(vc2, "correlation") <- stats::cov2cor(model$D[vc_zi, vc_zi, drop = FALSE]) } + model_deviance <- insight::get_deviance(model, verbose = FALSE) + residual_df <- insight::get_df(model, type = "residual", verbose = FALSE) + vc1 <- list(vc1) names(vc1) <- re_names[[1]] - attr(vc1, "sc") <- sqrt(insight::get_deviance(model, verbose = FALSE) / insight::get_df(model, type = "residual", verbose = FALSE)) + attr(vc1, "sc") <- sqrt(abs(model_deviance) / residual_df) if (!is.null(vc2)) { vc2 <- list(vc2) names(vc2) <- re_names[[2]] - attr(vc2, "sc") <- sqrt(insight::get_deviance(model, verbose = FALSE) / insight::get_df(model, type = "residual", verbose = FALSE)) + attr(vc2, "sc") <- sqrt(abs(model_deviance) / residual_df) } varcorr <- insight::compact_list(list(vc1, vc2)) @@ -698,7 +701,7 @@ names(varcorr) <- re_names[1] attr(varcorr, "sc") <- model$coef$sigma2[[1]] - # nlme + # nlme / glmmPQL # --------------------------- } else if (inherits(model, "lme")) { re_names <- insight::find_random(model, split_nested = TRUE, flatten = TRUE) diff --git a/cran-comments.md b/cran-comments.md index f15e10657..127ca3820 100644 --- a/cran-comments.md +++ b/cran-comments.md @@ -1 +1 @@ -This release addresses errors in CRAN checks related to the last *insight* update. +Maintainance release. diff --git a/inst/WORDLIST b/inst/WORDLIST index a7e977782..70fddfdf6 100644 --- a/inst/WORDLIST +++ b/inst/WORDLIST @@ -1,4 +1,5 @@ ADF +AER Adressing Amrhein Analysing @@ -13,6 +14,7 @@ Bayarri BayesFM BayesFactor Bentler +Bergh Biometrics Biometrika Blume @@ -21,6 +23,7 @@ Bundock CFA CMD CNG +CRC Cattell Cattell's CrossValidated @@ -28,6 +31,7 @@ Curently D'Agostino DAS DBSCAN +DG DOI DRR Davison @@ -39,6 +43,7 @@ DoFs Dom Dorie Dupont +DV EFA EGAnet ESS @@ -75,12 +80,17 @@ Hmisc Hofman Hofmann Hornik +Isager ICA IRR +JB +JM JRM Jurs +KJ KMO Kenward +Korner Kruschke Kutner LMM @@ -92,6 +102,7 @@ Liu MADs MCMCglmm MLM +MPE MSA Maechler Malo @@ -106,6 +117,7 @@ NL Neter Neyman Nieto +Nievergelt Nondegenerate Nonresponse ORCID @@ -114,6 +126,7 @@ PCoA PHQ PLOS PMCMRplus +PeerJ Pernet Pettersson PloS @@ -129,6 +142,10 @@ Rocklin Rosseel Rousseeuw Routledge +Rothman +Scand +Senn +Statist SBC SDs SEM @@ -138,6 +155,7 @@ Sadana Satterthwaite Satterthwaite's Schaeffer +Scheel Schweder Sellke Shachar @@ -160,6 +178,7 @@ Valls Velicer Vos WRS +WeightIt Wasserman Wisenbaker Zoski @@ -228,8 +247,10 @@ ggeffects github glm glm's +glmgee glmmTMB glmx +glmtoolbox hclust heteroskedasticity hglm @@ -249,6 +270,7 @@ joss jstatsoft kmeans labelled +lakens lavaan lavaSearch lesslikely @@ -296,6 +318,7 @@ posthoc pre priori probabilistically +ps pscl quantreg quartiles @@ -316,12 +339,15 @@ strengejacke subclusters subscale subscales +svylme systemfit th tidymodels tinytable +tobit tseries unicode +unreplicable varEST varimax vincentab diff --git a/man/bootstrap_parameters.Rd b/man/bootstrap_parameters.Rd index 86fb23726..4a3070380 100644 --- a/man/bootstrap_parameters.Rd +++ b/man/bootstrap_parameters.Rd @@ -20,7 +20,8 @@ bootstrap_parameters(model, ...) \arguments{ \item{model}{Statistical model.} -\item{...}{Arguments passed to or from other methods.} +\item{...}{Arguments passed to other methods, like \code{\link[=bootstrap_model]{bootstrap_model()}} or +\code{\link[bayestestR:describe_posterior]{bayestestR::describe_posterior()}}.} \item{iterations}{The number of draws to simulate/bootstrap.} @@ -86,6 +87,11 @@ model <- lm(Sepal.Length ~ Species * Petal.Width, data = iris) b <- bootstrap_parameters(model) print(b) +# different type of bootstrapping +set.seed(2) +b <- bootstrap_parameters(model, type = "balanced") +print(b) + est <- emmeans::emmeans(b, trt.vs.ctrl ~ Species) print(model_parameters(est)) } diff --git a/man/ci.default.Rd b/man/ci.default.Rd index 57ffe3539..e1ca2e1eb 100644 --- a/man/ci.default.Rd +++ b/man/ci.default.Rd @@ -27,10 +27,9 @@ \item{dof}{Number of degrees of freedom to be used when calculating confidence intervals. If \code{NULL} (default), the degrees of freedom are -retrieved by calling \code{\link[=degrees_of_freedom]{degrees_of_freedom()}} with -approximation method defined in \code{method}. If not \code{NULL}, use this argument -to override the default degrees of freedom used to compute confidence -intervals.} +retrieved by calling \code{\link[insight:get_df]{insight::get_df()}} with approximation method +defined in \code{method}. If not \code{NULL}, use this argument to override the +default degrees of freedom used to compute confidence intervals.} \item{method}{Method for computing degrees of freedom for confidence intervals (CI) and the related p-values. Allowed are following @@ -41,7 +40,10 @@ options (which vary depending on the model class): \code{"residual"}, \emph{Confidence intervals and approximation of degrees of freedom} in \code{\link[=model_parameters]{model_parameters()}} for further details.} -\item{...}{Additional arguments} +\item{...}{Additional arguments passed down to the underlying functions. +E.g., arguments like \code{vcov} or \code{vcov_args} can be used to compute confidence +intervals using a specific variance-covariance matrix for the standard +errors.} \item{component}{Model component for which parameters should be shown. See the documentation for your object's class in \code{\link[=model_parameters]{model_parameters()}} or @@ -225,7 +227,16 @@ which is converted into a p-value using \code{\link[bayestestR:pd_to_p]{bayestes } \examples{ -\dontshow{if (require("glmmTMB")) (if (getRversion() >= "3.4") withAutoprint else force)(\{ # examplesIf} +\dontshow{if (require("glmmTMB") && requireNamespace("sandwich")) (if (getRversion() >= "3.4") withAutoprint else force)(\{ # examplesIf} +data(qol_cancer) +model <- lm(QoL ~ time + age + education, data = qol_cancer) + +# regular confidence intervals +ci(model) + +# using heteroscedasticity-robust standard errors +ci(model, vcov = "HC3") + \donttest{ library(parameters) data(Salamanders, package = "glmmTMB") diff --git a/man/degrees_of_freedom.Rd b/man/degrees_of_freedom.Rd index 714ced31a..291bd55aa 100644 --- a/man/degrees_of_freedom.Rd +++ b/man/degrees_of_freedom.Rd @@ -2,58 +2,48 @@ % Please edit documentation in R/dof.R \name{degrees_of_freedom} \alias{degrees_of_freedom} -\alias{degrees_of_freedom.default} \alias{dof} \title{Degrees of Freedom (DoF)} \usage{ -degrees_of_freedom(model, ...) +degrees_of_freedom(model, method = "analytical", ...) -\method{degrees_of_freedom}{default}(model, method = "analytical", ...) - -dof(model, ...) +dof(model, method = "analytical", ...) } \arguments{ \item{model}{A statistical model.} -\item{...}{Currently not used.} +\item{method}{Type of approximation for the degrees of freedom. Can be one of +the following: +\itemize{ +\item \code{"residual"} (aka \code{"analytical"}) returns the residual degrees of +freedom, which usually is what \code{\link[stats:df.residual]{stats::df.residual()}} returns. If a +model object has no method to extract residual degrees of freedom, these +are calculated as \code{n-p}, i.e. the number of observations minus the number +of estimated parameters. If residual degrees of freedom cannot be extracted +by either approach, returns \code{Inf}. +\item \code{"wald"} returns residual (aka analytical) degrees of freedom for models +with t-statistic, \code{1} for models with Chi-squared statistic, and \code{Inf} for +all other models. Also returns \code{Inf} if residual degrees of freedom cannot +be extracted. +\item \code{"normal"} always returns \code{Inf}. +\item \code{"model"} returns model-based degrees of freedom, i.e. the number of +(estimated) parameters. +\item For mixed models, can also be \code{"ml1"} (or \code{"m-l-1"}, approximation of +degrees of freedom based on a "m-l-1" heuristic as suggested by \emph{Elff et +al. 2019}) or \code{"between-within"} (or \code{"betwithin"}). +\item For mixed models of class \code{merMod}, \code{type} can also be \code{"satterthwaite"} +or \code{"kenward-roger"} (or \code{"kenward"}). See 'Details'. +} -\item{method}{Can be \code{"analytical"} (default, DoFs are estimated based -on the model type), \code{"residual"} in which case they are directly taken -from the model if available (for Bayesian models, the goal (looking for -help to make it happen) would be to refit the model as a frequentist one -before extracting the DoFs), \code{"ml1"} (see \code{\link[=dof_ml1]{dof_ml1()}}), \code{"betwithin"} -(see \code{\link[=dof_betwithin]{dof_betwithin()}}), \code{"satterthwaite"} (see \code{\link[=dof_satterthwaite]{dof_satterthwaite()}}), -\code{"kenward"} (see \code{\link[=dof_kenward]{dof_kenward()}}) or \code{"any"}, which tries to extract DoF -by any of those methods, whichever succeeds. See 'Details'.} +Usually, when degrees of freedom are required to calculate p-values or +confidence intervals, \code{type = "wald"} is likely to be the best choice in +most cases.} + +\item{...}{Currently not used.} } \description{ Estimate or extract degrees of freedom of models parameters. } -\details{ -Methods for calculating degrees of freedom: -\itemize{ -\item \code{"analytical"} for models of class \code{lmerMod}, Kenward-Roger approximated -degrees of freedoms are calculated, for other models, \code{n-k} (number of -observations minus number of parameters). -\item \code{"residual"} tries to extract residual degrees of freedom, and returns -\code{Inf} if residual degrees of freedom could not be extracted. -\item \code{"any"} first tries to extract residual degrees of freedom, and if these -are not available, extracts analytical degrees of freedom. -\item \code{"nokr"} same as \code{"analytical"}, but does not Kenward-Roger approximation -for models of class \code{lmerMod}. Instead, always uses \code{n-k} to calculate df -for any model. -\item \code{"normal"} returns \code{Inf}. -\item \code{"wald"} returns residual df for models with t-statistic, and \code{Inf} for all other models. -\item \code{"kenward"} calls \code{\link[=dof_kenward]{dof_kenward()}}. -\item \code{"satterthwaite"} calls \code{\link[=dof_satterthwaite]{dof_satterthwaite()}}. -\item \code{"ml1"} calls \code{\link[=dof_ml1]{dof_ml1()}}. -\item \code{"betwithin"} calls \code{\link[=dof_betwithin]{dof_betwithin()}}. -} - -For models with z-statistic, the returned degrees of freedom for model parameters -is \code{Inf} (unless \code{method = "ml1"} or \code{method = "betwithin"}), because there is -only one distribution for the related test statistic. -} \note{ In many cases, \code{degrees_of_freedom()} returns the same as \code{df.residuals()}, or \code{n-k} (number of observations minus number of parameters). However, @@ -65,16 +55,15 @@ Furthermore, for other approximation methods like \code{"kenward"} or freedom. } \examples{ +\dontshow{if (require("lme4", quietly = TRUE)) (if (getRversion() >= "3.4") withAutoprint else force)(\{ # examplesIf} model <- lm(Sepal.Length ~ Petal.Length * Species, data = iris) dof(model) model <- glm(vs ~ mpg * cyl, data = mtcars, family = "binomial") dof(model) \donttest{ -if (require("lme4", quietly = TRUE)) { - model <- lmer(Sepal.Length ~ Petal.Length + (1 | Species), data = iris) - dof(model) -} +model <- lmer(Sepal.Length ~ Petal.Length + (1 | Species), data = iris) +dof(model) if (require("rstanarm", quietly = TRUE)) { model <- stan_glm( @@ -86,4 +75,5 @@ if (require("rstanarm", quietly = TRUE)) { dof(model) } } +\dontshow{\}) # examplesIf} } diff --git a/man/display.parameters_model.Rd b/man/display.parameters_model.Rd index f351e0c63..c7ef7f915 100644 --- a/man/display.parameters_model.Rd +++ b/man/display.parameters_model.Rd @@ -1,15 +1,11 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/display.R, R/format.R, R/print_html.R, -% R/print_md.R, R/print_table.R +% Please edit documentation in R/display.R, R/print_table.R \name{display.parameters_model} \alias{display.parameters_model} \alias{display.parameters_sem} \alias{display.parameters_efa_summary} \alias{display.parameters_efa} \alias{display.equivalence_test_lm} -\alias{format.parameters_model} -\alias{print_html.parameters_model} -\alias{print_md.parameters_model} \alias{print_table} \title{Print tables in different output formats} \usage{ @@ -63,79 +59,11 @@ \method{display}{equivalence_test_lm}(object, format = "markdown", digits = 2, ...) -\method{format}{parameters_model}( - x, - pretty_names = TRUE, - split_components = TRUE, - select = NULL, - digits = 2, - ci_digits = digits, - p_digits = 3, - ci_width = NULL, - ci_brackets = NULL, - zap_small = FALSE, - format = NULL, - groups = NULL, - include_reference = FALSE, - ... -) - -\method{print_html}{parameters_model}( - x, - pretty_names = TRUE, - split_components = TRUE, - select = NULL, - caption = NULL, - subtitle = NULL, - footer = NULL, - align = NULL, - digits = 2, - ci_digits = digits, - p_digits = 3, - footer_digits = 3, - ci_brackets = c("(", ")"), - show_sigma = FALSE, - show_formula = FALSE, - zap_small = FALSE, - groups = NULL, - font_size = "100\%", - line_padding = 4, - column_labels = NULL, - include_reference = FALSE, - verbose = TRUE, - ... -) - -\method{print_md}{parameters_model}( - x, - pretty_names = TRUE, - split_components = TRUE, - select = NULL, - caption = NULL, - subtitle = NULL, - footer = NULL, - align = NULL, - digits = 2, - ci_digits = digits, - p_digits = 3, - footer_digits = 3, - ci_brackets = c("(", ")"), - show_sigma = FALSE, - show_formula = FALSE, - zap_small = FALSE, - groups = NULL, - include_reference = FALSE, - verbose = TRUE, - ... -) - print_table(x, digits = 2, p_digits = 3, theme = "default", ...) } \arguments{ -\item{object}{An object returned by \code{\link[=model_parameters]{model_parameters()}}, -\code{\link[=simulate_parameters]{simulate_parameters()}}, -\code{\link[=equivalence_test.lm]{equivalence_test()}} or -\code{\link[=principal_components]{principal_components()}}.} +\item{object}{An object returned by \code{\link[=model_parameters]{model_parameters()}},\code{\link[=simulate_parameters]{simulate_parameters()}}, +\code{\link[=equivalence_test]{equivalence_test()}} or \code{\link[=principal_components]{principal_components()}}.} \item{format}{String, indicating the output format. Can be \code{"markdown"} or \code{"html"}.} @@ -247,7 +175,8 @@ so this is just for completeness.} \item{verbose}{Toggle messages and warnings.} -\item{...}{Arguments passed to or from other methods.} +\item{...}{Arguments passed down to \code{\link[=format.parameters_model]{format.parameters_model()}}, +\code{\link[insight:format_table]{insight::format_table()}} and \code{\link[insight:export_table]{insight::export_table()}}} \item{sort}{Sort the loadings.} @@ -262,21 +191,6 @@ loadings data. Usually, the question related to the item.} \item{x}{An object returned by \code{\link[=model_parameters]{model_parameters()}}.} -\item{ci_width}{Minimum width of the returned string for confidence -intervals. If not \code{NULL} and width is larger than the string's length, -leading whitespaces are added to the string. If \code{width="auto"}, width -will be set to the length of the longest string.} - -\item{groups}{Named list, can be used to group parameters in the printed output. -List elements may either be character vectors that match the name of those -parameters that belong to one group, or list elements can be row numbers -of those parameter rows that should belong to one group. The names of the -list elements will be used as group names, which will be inserted as "header -row". A possible use case might be to emphasize focal predictors and control -variables, see 'Examples'. Parameters will be re-ordered according to the -order used in \code{groups}, while all non-matching parameters will be added -to the end.} - \item{theme}{String, indicating the table theme. Can be one of \code{"default"}, \code{"grid"}, \code{"striped"}, \code{"bootstrap"} or \code{"darklines"}.} } @@ -288,8 +202,8 @@ returned. } \description{ Prints tables (i.e. data frame) in different output formats. -\code{print_md()} is a alias for \code{display(format = "markdown")}, \code{print_html()} -is a alias for \code{display(format = "html")}. \code{print_table()} is for specific +\code{print_md()} is an alias for \code{display(format = "markdown")}, \code{print_html()} +is an alias for \code{display(format = "html")}. \code{print_table()} is for specific use cases only, and currently only works for \code{compare_parameters()} objects. } \details{ @@ -356,5 +270,5 @@ print_table(out) \dontshow{\}) # examplesIf} } \seealso{ -\code{\link[=print.parameters_model]{print.parameters_model()}} +\code{\link[=print.parameters_model]{print.parameters_model()}} and \code{\link[=print.compare_parameters]{print.compare_parameters()}} } diff --git a/man/equivalence_test.lm.Rd b/man/equivalence_test.lm.Rd index 1d4ab94d4..048468768 100644 --- a/man/equivalence_test.lm.Rd +++ b/man/equivalence_test.lm.Rd @@ -11,6 +11,8 @@ range = "default", ci = 0.95, rule = "classic", + vcov = NULL, + vcov_args = NULL, verbose = TRUE, ... ) @@ -21,6 +23,8 @@ ci = 0.95, rule = "classic", effects = c("fixed", "random"), + vcov = NULL, + vcov_args = NULL, verbose = TRUE, ... ) @@ -44,8 +48,32 @@ model's data.} \item{ci}{Confidence Interval (CI) level. Default to \code{0.95} (\verb{95\%}).} \item{rule}{Character, indicating the rules when testing for practical -equivalence. Can be \code{"bayes"}, \code{"classic"} or \code{"cet"}. See -'Details'.} +equivalence. Can be \code{"bayes"}, \code{"classic"} or \code{"cet"}. See 'Details'.} + +\item{vcov}{Variance-covariance matrix used to compute uncertainty estimates +(e.g., for robust standard errors). This argument accepts a covariance matrix, +a function which returns a covariance matrix, or a string which identifies +the function to be used to compute the covariance matrix. +\itemize{ +\item A covariance matrix +\item A function which returns a covariance matrix (e.g., \code{stats::vcov()}) +\item A string which indicates the kind of uncertainty estimates to return. +\itemize{ +\item Heteroskedasticity-consistent: \code{"vcovHC"}, \code{"HC"}, \code{"HC0"}, \code{"HC1"}, +\code{"HC2"}, \code{"HC3"}, \code{"HC4"}, \code{"HC4m"}, \code{"HC5"}. See \code{?sandwich::vcovHC}. +\item Cluster-robust: \code{"vcovCR"}, \code{"CR0"}, \code{"CR1"}, \code{"CR1p"}, \code{"CR1S"}, +\code{"CR2"}, \code{"CR3"}. See \code{?clubSandwich::vcovCR}. +\item Bootstrap: \code{"vcovBS"}, \code{"xy"}, \code{"residual"}, \code{"wild"}, \code{"mammen"}, +\code{"webb"}. See \code{?sandwich::vcovBS}. +\item Other \code{sandwich} package functions: \code{"vcovHAC"}, \code{"vcovPC"}, \code{"vcovCL"}, +\code{"vcovPL"}. +} +}} + +\item{vcov_args}{List of arguments to be passed to the function identified by +the \code{vcov} argument. This function is typically supplied by the \strong{sandwich} +or \strong{clubSandwich} packages. Please refer to their documentation (e.g., +\code{?sandwich::vcovHAC}) to see the list of available arguments.} \item{verbose}{Toggle warnings and messages.} @@ -67,17 +95,17 @@ A data frame. Compute the (conditional) equivalence test for frequentist models. } \details{ -In classical null hypothesis significance testing (NHST) within a frequentist -framework, it is not possible to accept the null hypothesis, H0 - unlike -in Bayesian statistics, where such probability statements are possible. -"\link{...} one can only reject the null hypothesis if the test +In classical null hypothesis significance testing (NHST) within a +frequentist framework, it is not possible to accept the null hypothesis, H0 - +unlike in Bayesian statistics, where such probability statements are +possible. "\link{...} one can only reject the null hypothesis if the test statistics falls into the critical region(s), or fail to reject this hypothesis. In the latter case, all we can say is that no significant effect was observed, but one cannot conclude that the null hypothesis is true." -(\emph{Pernet 2017}). One way to address this issues without Bayesian methods -is \emph{Equivalence Testing}, as implemented in \code{equivalence_test()}. -While you either can reject the null hypothesis or claim an inconclusive result -in NHST, the equivalence test - according to \emph{Pernet} - adds a third category, +(\emph{Pernet 2017}). One way to address this issues without Bayesian methods is +\emph{Equivalence Testing}, as implemented in \code{equivalence_test()}. While you +either can reject the null hypothesis or claim an inconclusive result in +NHST, the equivalence test - according to \emph{Pernet} - adds a third category, \emph{"accept"}. Roughly speaking, the idea behind equivalence testing in a frequentist framework is to check whether an estimate and its uncertainty (i.e. confidence interval) falls within a region of "practical equivalence". @@ -100,14 +128,19 @@ better). \item "classic" - The TOST rule (Lakens 2017) This rule follows the "TOST rule", i.e. a two one-sided test procedure -(\emph{Lakens 2017}). Following this rule, practical equivalence of an effect -(i.e. H0) is \emph{rejected}, when the coefficient is statistically significant -\emph{and} the narrow confidence intervals (i.e. \code{1-2*alpha}) \emph{include} or -\emph{exceed} the ROPE boundaries. Practical equivalence is assumed -(i.e. H0 "accepted") when the narrow confidence intervals are completely -inside the ROPE, no matter if the effect is statistically significant -or not. Else, the decision whether to accept or reject practical -equivalence is undecided. +(\emph{Lakens 2017}). Following this rule... +\itemize{ +\item practical equivalence is assumed (i.e. H0 \emph{"accepted"}) when the narrow +confidence intervals are completely inside the ROPE, no matter if the +effect is statistically significant or not; +\item practical equivalence (i.e. H0) is \emph{rejected}, when the coefficient is +statistically significant, both when the narrow confidence intervals +(i.e. \code{1-2*alpha}) include or exclude the the ROPE boundaries, but the +narrow confidence intervals are \emph{not fully covered} by the ROPE; +\item else the decision whether to accept or reject practical equivalence is +undecided (i.e. when effects are \emph{not} statistically significant \emph{and} +the narrow confidence intervals overlaps the ROPE). +} \item "cet" - Conditional Equivalence Testing (Campbell/Gustafson 2018) The Conditional Equivalence Testing as described by \emph{Campbell and @@ -133,10 +166,10 @@ only uses the regular intervals. The equivalence p-value is the area of the (cumulative) confidence distribution that is outside of the region of equivalence. It can be -interpreted as p-value for \emph{rejecting} the alternative hypothesis -and \emph{accepting} the "null hypothesis" (i.e. assuming practical -equivalence). That is, a high p-value means we reject the assumption of -practical equivalence and accept the alternative hypothesis. +interpreted as p-value for \emph{rejecting} the alternative hypothesis and +\emph{accepting} the "null hypothesis" (i.e. assuming practical equivalence). That +is, a high p-value means we reject the assumption of practical equivalence +and accept the alternative hypothesis. } \subsection{Second Generation p-Value (SGPV)}{ @@ -144,7 +177,42 @@ practical equivalence and accept the alternative hypothesis. Second generation p-values (SGPV) were proposed as a statistic that represents \emph{the proportion of data-supported hypotheses that are also null hypotheses} \emph{(Blume et al. 2018, Lakens and Delacre 2020)}. It represents the -proportion of the confidence interval range that is inside the ROPE. +proportion of the \emph{full} confidence interval range (assuming a normally or +t-distributed, equal-tailed interval, based on the model) that is inside the +ROPE. The SGPV ranges from zero to one. Higher values indicate that the +effect is more likely to be practically equivalent ("not of interest"). + +Note that the assumed interval, which is used to calculate the SGPV, is an +estimation of the \emph{full interval} based on the chosen confidence level. For +example, if the 95\% confidence interval of a coefficient ranges from -1 to 1, +the underlying \emph{full (normally or t-distributed) interval} approximately +ranges from -1.9 to 1.9, see also following code: + +\if{html}{\out{
}}\preformatted{# simulate full normal distribution +out <- bayestestR::distribution_normal(10000, 0, 0.5) +# range of "full" distribution +range(out) +# range of 95\% CI +round(quantile(out, probs = c(0.025, 0.975)), 2) +}\if{html}{\out{
}} + +This ensures that the SGPV always refers to the general compatible parameter +space of coefficients, independent from the confidence interval chosen for +testing practical equivalence. Therefore, the SGPV of the \emph{full interval} is +similar to the ROPE coverage of Bayesian equivalence tests, see following +code: + +\if{html}{\out{
}}\preformatted{library(bayestestR) +library(brms) +m <- lm(mpg ~ gear + wt + cyl + hp, data = mtcars) +m2 <- brm(mpg ~ gear + wt + cyl + hp, data = mtcars) +# SGPV for frequentist models +equivalence_test(m) +# similar to ROPE coverage of Bayesian models +equivalence_test(m2) +# similar to ROPE coverage of simulated draws / bootstrap samples +equivalence_test(simulate_model(m)) +}\if{html}{\out{
}} } \subsection{ROPE range}{ @@ -158,13 +226,73 @@ for further information. There is also a \href{https://easystats.github.io/see/articles/parameters.html}{\code{plot()}-method} implemented in the \href{https://easystats.github.io/see/}{\strong{see}-package}. } +\section{Statistical inference - how to quantify evidence}{ + +There is no standardized approach to drawing conclusions based on the +available data and statistical models. A frequently chosen but also much +criticized approach is to evaluate results based on their statistical +significance (\emph{Amrhein et al. 2017}). + +A more sophisticated way would be to test whether estimated effects exceed +the "smallest effect size of interest", to avoid even the smallest effects +being considered relevant simply because they are statistically significant, +but clinically or practically irrelevant (\emph{Lakens et al. 2018, Lakens 2024}). + +A rather unconventional approach, which is nevertheless advocated by various +authors, is to interpret results from classical regression models either in +terms of probabilities, similar to the usual approach in Bayesian statistics +(\emph{Schweder 2018; Schweder and Hjort 2003; Vos 2022}) or in terms of relative +measure of "evidence" or "compatibility" with the data (\emph{Greenland et al. 2022; +Rafi and Greenland 2020}), which nevertheless comes close to a probabilistic +interpretation. + +A more detailed discussion of this topic is found in the documentation of +\code{\link[=p_function]{p_function()}}. + +The \strong{parameters} package provides several options or functions to aid +statistical inference. These are, for example: +\itemize{ +\item \code{\link[=equivalence_test.lm]{equivalence_test()}}, to compute the (conditional) +equivalence test for frequentist models +\item \code{\link[=p_significance.lm]{p_significance()}}, to compute the probability of +\emph{practical significance}, which can be conceptualized as a unidirectional +equivalence test +\item \code{\link[=p_function]{p_function()}}, or \emph{consonance function}, to compute p-values and +compatibility (confidence) intervals for statistical models +\item the \code{pd} argument (setting \code{pd = TRUE}) in \code{model_parameters()} includes +a column with the \emph{probability of direction}, i.e. the probability that a +parameter is strictly positive or negative. See \code{\link[bayestestR:p_direction]{bayestestR::p_direction()}} +for details. If plotting is desired, the \code{\link[=p_direction.lm]{p_direction()}} +function can be used, together with \code{plot()}. +\item the \code{s_value} argument (setting \code{s_value = TRUE}) in \code{model_parameters()} +replaces the p-values with their related \emph{S}-values (\emph{Rafi and Greenland 2020}) +\item finally, it is possible to generate distributions of model coefficients by +generating bootstrap-samples (setting \code{bootstrap = TRUE}) or simulating +draws from model coefficients using \code{\link[=simulate_model]{simulate_model()}}. These samples +can then be treated as "posterior samples" and used in many functions from +the \strong{bayestestR} package. +} + +Most of the above shown options or functions derive from methods originally +implemented for Bayesian models (\emph{Makowski et al. 2019}). However, assuming +that model assumptions are met (which means, the model fits well to the data, +the correct model is chosen that reflects the data generating process +(distributional model family) etc.), it seems appropriate to interpret +results from classical frequentist models in a "Bayesian way" (more details: +documentation in \code{\link[=p_function]{p_function()}}). +} + \examples{ +\dontshow{if (requireNamespace("sandwich")) (if (getRversion() >= "3.4") withAutoprint else force)(\{ # examplesIf} data(qol_cancer) model <- lm(QoL ~ time + age + education, data = qol_cancer) # default rule equivalence_test(model) +# using heteroscedasticity-robust standard errors +equivalence_test(model, vcov = "HC3") + # conditional equivalence test equivalence_test(model, rule = "cet") @@ -173,9 +301,13 @@ if (require("see", quietly = TRUE)) { result <- equivalence_test(model) plot(result) } +\dontshow{\}) # examplesIf} } \references{ \itemize{ +\item Amrhein, V., Korner-Nievergelt, F., and Roth, T. (2017). The earth is +flat (p > 0.05): Significance thresholds and the crisis of unreplicable +research. PeerJ, 5, e3544. \doi{10.7717/peerj.3544} \item Blume, J. D., D'Agostino McGowan, L., Dupont, W. D., & Greevy, R. A. (2018). Second-generation p-values: Improved rigor, reproducibility, & transparency in statistical analyses. PLOS ONE, 13(3), e0188299. @@ -183,6 +315,9 @@ https://doi.org/10.1371/journal.pone.0188299 \item Campbell, H., & Gustafson, P. (2018). Conditional equivalence testing: An alternative remedy for publication bias. PLOS ONE, 13(4), e0195145. doi: 10.1371/journal.pone.0195145 +\item Greenland S, Rafi Z, Matthews R, Higgs M. To Aid Scientific Inference, +Emphasize Unconditional Compatibility Descriptions of Statistics. (2022) +https://arxiv.org/abs/1909.08583v7 (Accessed November 10, 2022) \item Kruschke, J. K. (2014). Doing Bayesian data analysis: A tutorial with R, JAGS, and Stan. Academic Press \item Kruschke, J. K. (2018). Rejecting or accepting parameter values in @@ -191,15 +326,37 @@ Science, 1(2), 270-280. doi: 10.1177/2515245918771304 \item Lakens, D. (2017). Equivalence Tests: A Practical Primer for t Tests, Correlations, and Meta-Analyses. Social Psychological and Personality Science, 8(4), 355–362. doi: 10.1177/1948550617697177 -\item Lakens, D., & Delacre, M. (2020). Equivalence Testing and the Second +\item Lakens, D. (2024). Improving Your Statistical Inferences (Version v1.5.1). +Retrieved from https://lakens.github.io/statistical_inferences/. +\doi{10.5281/ZENODO.6409077} +\item Lakens, D., and Delacre, M. (2020). Equivalence Testing and the Second Generation P-Value. Meta-Psychology, 4. https://doi.org/10.15626/MP.2018.933 +\item Lakens, D., Scheel, A. M., and Isager, P. M. (2018). Equivalence Testing +for Psychological Research: A Tutorial. Advances in Methods and Practices +in Psychological Science, 1(2), 259–269. \doi{10.1177/2515245918770963} +\item Makowski, D., Ben-Shachar, M. S., Chen, S. H. A., and Lüdecke, D. (2019). +Indices of Effect Existence and Significance in the Bayesian Framework. +Frontiers in Psychology, 10, 2767. \doi{10.3389/fpsyg.2019.02767} \item Pernet, C. (2017). Null hypothesis significance testing: A guide to commonly misunderstood concepts and recommendations for good practice. F1000Research, 4, 621. doi: 10.12688/f1000research.6963.5 +\item Rafi Z, Greenland S. Semantic and cognitive tools to aid statistical +science: replace confidence and significance by compatibility and surprise. +BMC Medical Research Methodology (2020) 20:244. +\item Schweder T. Confidence is epistemic probability for empirical science. +Journal of Statistical Planning and Inference (2018) 195:116–125. +\doi{10.1016/j.jspi.2017.09.016} +\item Schweder T, Hjort NL. Frequentist analogues of priors and posteriors. +In Stigum, B. (ed.), Econometrics and the Philosophy of Economics: Theory +Data Confrontation in Economics, pp. 285-217. Princeton University Press, +Princeton, NJ, 2003 +\item Vos P, Holbert D. Frequentist statistical inference without repeated sampling. +Synthese 200, 89 (2022). \doi{10.1007/s11229-022-03560-x} } } \seealso{ -For more details, see \code{\link[bayestestR:equivalence_test]{bayestestR::equivalence_test()}}. -Further readings can be found in the references. +For more details, see \code{\link[bayestestR:equivalence_test]{bayestestR::equivalence_test()}}. Further +readings can be found in the references. See also \code{\link[=p_significance]{p_significance()}} for +a unidirectional equivalence test. } diff --git a/man/format_parameters.Rd b/man/format_parameters.Rd index 05a5dc25f..08f65b89d 100644 --- a/man/format_parameters.Rd +++ b/man/format_parameters.Rd @@ -28,7 +28,7 @@ to make them more human-readable. Note that the \emph{interpretation} of interaction terms depends on many characteristics of the model. The number of parameters, and overall -performance of the model, can differ \emph{or not} between \code{a * b} +performance of the model, can differ \emph{or not} between \code{a * b}, \code{a : b}, and \code{a / b}, suggesting that sometimes interaction terms give different parameterizations of the same model, but other times it gives completely different models (depending on \code{a} or \code{b} being factors diff --git a/man/model_parameters.BFBayesFactor.Rd b/man/model_parameters.BFBayesFactor.Rd index 328e25f3d..9b67ccb4f 100644 --- a/man/model_parameters.BFBayesFactor.Rd +++ b/man/model_parameters.BFBayesFactor.Rd @@ -14,11 +14,9 @@ rope_range = "default", rope_ci = 0.95, priors = TRUE, - effectsize_type = NULL, + es_type = NULL, include_proportions = FALSE, verbose = TRUE, - cohens_d = NULL, - cramers_v = NULL, ... ) } @@ -51,16 +49,17 @@ For each "test", the corresponding \pkg{bayestestR} function is called (e.g. \code{\link[bayestestR:rope]{rope()}} or \code{\link[bayestestR:p_direction]{p_direction()}}) and its results included in the summary output.} -\item{rope_range}{ROPE's lower and higher bounds. Should be a list of two -values (e.g., \code{c(-0.1, 0.1)}) or \code{"default"}. If \code{"default"}, -the bounds are set to \code{x +- 0.1*SD(response)}.} +\item{rope_range}{ROPE's lower and higher bounds. Should be a vector of two +values (e.g., \code{c(-0.1, 0.1)}), \code{"default"} or a list of numeric vectors of +the same length as numbers of parameters. If \code{"default"}, the bounds are +set to \code{x +- 0.1*SD(response)}.} \item{rope_ci}{The Credible Interval (CI) probability, corresponding to the proportion of HDI, to use for the percentage in ROPE.} \item{priors}{Add the prior used for each parameter.} -\item{effectsize_type}{The effect size of interest. Not that possibly not all +\item{es_type}{The effect size of interest. Not that possibly not all effect sizes are applicable to the model object. See 'Details'. For Anova models, can also be a character vector with multiple effect size names.} @@ -71,8 +70,6 @@ information is often redundant.} \item{verbose}{Toggle off warnings.} -\item{cohens_d, cramers_v}{Deprecated. Please use \code{effectsize_type}.} - \item{...}{Additional arguments to be passed to or from methods.} } \value{ @@ -97,22 +94,26 @@ the \emph{g} parameters; See the \emph{Bayes Factors for ANOVAs} paper } } \examples{ +\dontshow{if (require("BayesFactor")) (if (getRversion() >= "3.4") withAutoprint else force)(\{ # examplesIf} \donttest{ -if (require("BayesFactor")) { - # Bayesian t-test - model <- ttestBF(x = rnorm(100, 1, 1)) - model_parameters(model) - model_parameters(model, cohens_d = TRUE, ci = .9) +# Bayesian t-test +model <- BayesFactor::ttestBF(x = rnorm(100, 1, 1)) +model_parameters(model) +model_parameters(model, es_type = "cohens_d", ci = 0.9) - # Bayesian contingency table analysis - data(raceDolls) - bf <- contingencyTableBF(raceDolls, sampleType = "indepMulti", fixedMargin = "cols") - model_parameters(bf, - centrality = "mean", - dispersion = TRUE, - verbose = FALSE, - effectsize_type = "cramers_v" - ) -} +# Bayesian contingency table analysis +data(raceDolls) +bf <- BayesFactor::contingencyTableBF( + raceDolls, + sampleType = "indepMulti", + fixedMargin = "cols" +) +model_parameters(bf, + centrality = "mean", + dispersion = TRUE, + verbose = FALSE, + es_type = "cramers_v" +) } +\dontshow{\}) # examplesIf} } diff --git a/man/model_parameters.Rd b/man/model_parameters.Rd index d124d2cc9..c3e5dc2f1 100644 --- a/man/model_parameters.Rd +++ b/man/model_parameters.Rd @@ -99,7 +99,7 @@ models). This method is particularly recommended for complex models that include interactions or transformations (e.g., polynomial or spline terms). The \code{robust} (default to \code{FALSE}) argument enables a robust standardization of data, i.e., based on the \code{median} and \code{MAD} instead of the \code{mean} and -\code{SD}. \strong{See \code{\link[=standardize]{standardize()}} for more details.} +\code{SD}. \strong{See \code{\link[datawizard:standardize]{datawizard::standardize()}} for more details.} \strong{Note} that \code{standardize_parameters(method = "refit")} may not return the same results as fitting a model on data that has been standardized with \code{standardize()}; \code{standardize_parameters()} used the data used by the model @@ -321,11 +321,67 @@ p-values are based on the probability of direction (\code{\link[bayestestR:p_dir which is converted into a p-value using \code{\link[bayestestR:pd_to_p]{bayestestR::pd_to_p()}}. } +\section{Statistical inference - how to quantify evidence}{ + +There is no standardized approach to drawing conclusions based on the +available data and statistical models. A frequently chosen but also much +criticized approach is to evaluate results based on their statistical +significance (\emph{Amrhein et al. 2017}). + +A more sophisticated way would be to test whether estimated effects exceed +the "smallest effect size of interest", to avoid even the smallest effects +being considered relevant simply because they are statistically significant, +but clinically or practically irrelevant (\emph{Lakens et al. 2018, Lakens 2024}). + +A rather unconventional approach, which is nevertheless advocated by various +authors, is to interpret results from classical regression models either in +terms of probabilities, similar to the usual approach in Bayesian statistics +(\emph{Schweder 2018; Schweder and Hjort 2003; Vos 2022}) or in terms of relative +measure of "evidence" or "compatibility" with the data (\emph{Greenland et al. 2022; +Rafi and Greenland 2020}), which nevertheless comes close to a probabilistic +interpretation. + +A more detailed discussion of this topic is found in the documentation of +\code{\link[=p_function]{p_function()}}. + +The \strong{parameters} package provides several options or functions to aid +statistical inference. These are, for example: +\itemize{ +\item \code{\link[=equivalence_test.lm]{equivalence_test()}}, to compute the (conditional) +equivalence test for frequentist models +\item \code{\link[=p_significance.lm]{p_significance()}}, to compute the probability of +\emph{practical significance}, which can be conceptualized as a unidirectional +equivalence test +\item \code{\link[=p_function]{p_function()}}, or \emph{consonance function}, to compute p-values and +compatibility (confidence) intervals for statistical models +\item the \code{pd} argument (setting \code{pd = TRUE}) in \code{model_parameters()} includes +a column with the \emph{probability of direction}, i.e. the probability that a +parameter is strictly positive or negative. See \code{\link[bayestestR:p_direction]{bayestestR::p_direction()}} +for details. If plotting is desired, the \code{\link[=p_direction.lm]{p_direction()}} +function can be used, together with \code{plot()}. +\item the \code{s_value} argument (setting \code{s_value = TRUE}) in \code{model_parameters()} +replaces the p-values with their related \emph{S}-values (\emph{Rafi and Greenland 2020}) +\item finally, it is possible to generate distributions of model coefficients by +generating bootstrap-samples (setting \code{bootstrap = TRUE}) or simulating +draws from model coefficients using \code{\link[=simulate_model]{simulate_model()}}. These samples +can then be treated as "posterior samples" and used in many functions from +the \strong{bayestestR} package. +} + +Most of the above shown options or functions derive from methods originally +implemented for Bayesian models (\emph{Makowski et al. 2019}). However, assuming +that model assumptions are met (which means, the model fits well to the data, +the correct model is chosen that reflects the data generating process +(distributional model family) etc.), it seems appropriate to interpret +results from classical frequentist models in a "Bayesian way" (more details: +documentation in \code{\link[=p_function]{p_function()}}). +} + \section{Interpretation of Interaction Terms}{ Note that the \emph{interpretation} of interaction terms depends on many characteristics of the model. The number of parameters, and overall -performance of the model, can differ \emph{or not} between \code{a * b} +performance of the model, can differ \emph{or not} between \code{a * b}, \code{a : b}, and \code{a / b}, suggesting that sometimes interaction terms give different parameterizations of the same model, but other times it gives completely different models (depending on \code{a} or \code{b} being factors @@ -346,12 +402,12 @@ warnings for the different functions in the \strong{parameters} package. However some messages providing additional information can be displayed or suppressed using \code{options()}: \itemize{ -\item \code{parameters_summary}: \code{options(parameters_summary = TRUE)} will override the -\code{summary} argument in \code{model_parameters()} and always show the model summary -for non-mixed models. -\item \code{parameters_mixed_summary}: \code{options(parameters_mixed_summary = TRUE)} will -override the \code{summary} argument in \code{model_parameters()} for mixed models, and -will then always show the model summary. +\item \code{parameters_info}: \code{options(parameters_info = TRUE)} will override the +\code{include_info} argument in \code{model_parameters()} and always show the model +summary for non-mixed models. +\item \code{parameters_mixed_info}: \code{options(parameters_mixed_info = TRUE)} will +override the \code{include_info} argument in \code{model_parameters()} for mixed +models, and will then always show the model summary. \item \code{parameters_cimethod}: \code{options(parameters_cimethod = TRUE)} will show the additional information about the approximation method used to calculate confidence intervals and p-values. Set to \code{FALSE} to hide this message when @@ -377,18 +433,45 @@ options. \item \code{easystats_html_engine}: \code{options(easystats_html_engine = "gt")} will set the default HTML engine for tables to \code{gt}, i.e. the \emph{gt} package is used to create HTML tables. If set to \code{tt}, the \emph{tinytable} package is used. +\item \code{insight_use_symbols}: \code{options(insight_use_symbols = TRUE)} will try to +print unicode-chars for symbols as column names, wherever possible (e.g., +\ifelse{html}{\out{ω}}{\eqn{\omega}} instead of \code{Omega}). } } \references{ \itemize{ +\item Amrhein, V., Korner-Nievergelt, F., and Roth, T. (2017). The earth is +flat (p > 0.05): Significance thresholds and the crisis of unreplicable +research. PeerJ, 5, e3544. \doi{10.7717/peerj.3544} +\item Greenland S, Rafi Z, Matthews R, Higgs M. To Aid Scientific Inference, +Emphasize Unconditional Compatibility Descriptions of Statistics. (2022) +https://arxiv.org/abs/1909.08583v7 (Accessed November 10, 2022) \item Hoffman, L. (2015). Longitudinal analysis: Modeling within-person fluctuation and change. Routledge. -\item Neter, J., Wasserman, W., & Kutner, M. H. (1989). Applied linear +\item Lakens, D. (2024). Improving Your Statistical Inferences (Version v1.5.1). +Retrieved from https://lakens.github.io/statistical_inferences/. +\doi{10.5281/ZENODO.6409077} +\item Lakens, D., Scheel, A. M., and Isager, P. M. (2018). Equivalence Testing +for Psychological Research: A Tutorial. Advances in Methods and Practices +in Psychological Science, 1(2), 259–269. \doi{10.1177/2515245918770963} +\item Makowski, D., Ben-Shachar, M. S., Chen, S. H. A., and Lüdecke, D. (2019). +Indices of Effect Existence and Significance in the Bayesian Framework. +Frontiers in Psychology, 10, 2767. \doi{10.3389/fpsyg.2019.02767} +\item Neter, J., Wasserman, W., and Kutner, M. H. (1989). Applied linear regression models. \item Rafi Z, Greenland S. Semantic and cognitive tools to aid statistical science: replace confidence and significance by compatibility and surprise. BMC Medical Research Methodology (2020) 20:244. +\item Schweder T. Confidence is epistemic probability for empirical science. +Journal of Statistical Planning and Inference (2018) 195:116–125. +\doi{10.1016/j.jspi.2017.09.016} +\item Schweder T, Hjort NL. Frequentist analogues of priors and posteriors. +In Stigum, B. (ed.), Econometrics and the Philosophy of Economics: Theory +Data Confrontation in Economics, pp. 285-217. Princeton University Press, +Princeton, NJ, 2003 +\item Vos P, Holbert D. Frequentist statistical inference without repeated sampling. +Synthese 200, 89 (2022). \doi{10.1007/s11229-022-03560-x} } } \seealso{ diff --git a/man/model_parameters.aov.Rd b/man/model_parameters.aov.Rd index 0b769fb43..bd24bb816 100644 --- a/man/model_parameters.aov.Rd +++ b/man/model_parameters.aov.Rd @@ -13,20 +13,17 @@ alternative = NULL, test = NULL, power = FALSE, - effectsize_type = NULL, + es_type = NULL, keep = NULL, drop = NULL, table_wide = FALSE, verbose = TRUE, - omega_squared = NULL, - eta_squared = NULL, - epsilon_squared = NULL, ... ) \method{model_parameters}{afex_aov}( model, - effectsize_type = NULL, + es_type = NULL, df_error = NULL, type = NULL, keep = NULL, @@ -50,7 +47,7 @@ for ANOVA-tables from mixed models. See 'Examples'. (Ignored for \code{afex_aov}.)} \item{ci}{Confidence Interval (CI) level for effect sizes specified in -\code{effectsize_type}. The default, \code{NULL}, will compute no confidence +\code{es_type}. The default, \code{NULL}, will compute no confidence intervals. \code{ci} should be a scalar between 0 and 1.} \item{alternative}{A character string specifying the alternative hypothesis; @@ -67,7 +64,7 @@ the multivariate test (that is also given by the \code{print}-method). If \item{power}{Logical, if \code{TRUE}, adds a column with power for each parameter.} -\item{effectsize_type}{The effect size of interest. Not that possibly not all +\item{es_type}{The effect size of interest. Not that possibly not all effect sizes are applicable to the model object. See 'Details'. For Anova models, can also be a character vector with multiple effect size names.} @@ -99,8 +96,6 @@ be in the same row. Default: \code{FALSE}.} \item{verbose}{Toggle warnings and messages.} -\item{omega_squared, eta_squared, epsilon_squared}{Deprecated. Please use \code{effectsize_type}.} - \item{...}{Arguments passed to \code{\link[effectsize:effectsize]{effectsize::effectsize()}}. For example, to calculate \emph{partial} effect sizes types, use \code{partial = TRUE}. For objects of class \code{htest} or \code{BFBayesFactor}, \code{adjust = TRUE} can be used to return @@ -166,13 +161,13 @@ df$Sepal.Big <- ifelse(df$Sepal.Width >= 3, "Yes", "No") model <- aov(Sepal.Length ~ Sepal.Big, data = df) model_parameters(model) -model_parameters(model, effectsize_type = c("omega", "eta"), ci = 0.9) +model_parameters(model, es_type = c("omega", "eta"), ci = 0.9) model <- anova(lm(Sepal.Length ~ Sepal.Big, data = df)) model_parameters(model) model_parameters( model, - effectsize_type = c("omega", "eta", "epsilon"), + es_type = c("omega", "eta", "epsilon"), alternative = "greater" ) @@ -192,7 +187,7 @@ model_parameters(model) # parameters table including effect sizes model_parameters( model, - effectsize_type = "eta", + es_type = "eta", ci = 0.9, df_error = dof_satterthwaite(mm)[2:3] ) diff --git a/man/model_parameters.averaging.Rd b/man/model_parameters.averaging.Rd index e15a8983d..c9c8cbdd1 100644 --- a/man/model_parameters.averaging.Rd +++ b/man/model_parameters.averaging.Rd @@ -30,6 +30,7 @@ exponentiate = FALSE, p_adjust = NULL, summary = getOption("parameters_summary", FALSE), + include_info = getOption("parameters_info", FALSE), keep = NULL, drop = NULL, verbose = TRUE, @@ -43,6 +44,7 @@ exponentiate = FALSE, p_adjust = NULL, summary = getOption("parameters_summary", FALSE), + include_info = getOption("parameters_info", FALSE), keep = NULL, drop = NULL, verbose = TRUE, @@ -59,6 +61,7 @@ exponentiate = FALSE, p_adjust = NULL, summary = getOption("parameters_summary", FALSE), + include_info = getOption("parameters_info", FALSE), keep = NULL, drop = NULL, verbose = TRUE, @@ -174,6 +177,7 @@ exponentiate = FALSE, p_adjust = NULL, summary = getOption("parameters_summary", FALSE), + include_info = getOption("parameters_info", FALSE), keep = NULL, drop = NULL, verbose = TRUE, @@ -190,6 +194,7 @@ exponentiate = FALSE, p_adjust = NULL, summary = getOption("parameters_summary", FALSE), + include_info = getOption("parameters_info", FALSE), keep = NULL, drop = NULL, verbose = TRUE, @@ -250,7 +255,9 @@ possible adjustment methods are \code{"tukey"}, \code{"scheffe"}, \code{"sidak"} and \code{"none"} to explicitly disable adjustment for \code{emmGrid} objects (from \strong{emmeans}).} -\item{summary}{Logical, if \code{TRUE}, prints summary information about the +\item{summary}{Deprecated, please use \code{info} instead.} + +\item{include_info}{Logical, if \code{TRUE}, prints summary information about the model (model formula, number of observations, residual standard deviation and more).} @@ -279,8 +286,19 @@ names.} \item{verbose}{Toggle warnings and messages.} \item{...}{Arguments passed to or from other methods. For instance, when -\code{bootstrap = TRUE}, arguments like \code{type} or \code{parallel} are -passed down to \code{bootstrap_model()}.} +\code{bootstrap = TRUE}, arguments like \code{type} or \code{parallel} are passed down to +\code{bootstrap_model()}. Further non-documented arguments are \code{digits}, +\code{p_digits}, \code{ci_digits} and \code{footer_digits} to set the number of digits for +the output. If \code{s_value = TRUE}, the p-value will be replaced by the +S-value in the output (cf. \emph{Rafi and Greenland 2020}). \code{pd} adds an +additional column with the \emph{probability of direction} (see +\code{\link[bayestestR:p_direction]{bayestestR::p_direction()}} for details). \code{groups} can be used to group +coefficients. It will be passed to the print-method, or can directly be +used in \code{print()}, see documentation in \code{\link[=print.parameters_model]{print.parameters_model()}}. +Furthermore, see 'Examples' for this function. For developers, whose +interest mainly is to get a "tidy" data frame of model summaries, it is +recommended to set \code{pretty_names = FALSE} to speed up computation of the +summary table.} \item{include_studies}{Logical, if \code{TRUE} (default), includes parameters for all studies. Else, only parameters for overall-effects are shown.} diff --git a/man/model_parameters.cgam.Rd b/man/model_parameters.cgam.Rd index 90a5ff164..c2a4afa4b 100644 --- a/man/model_parameters.cgam.Rd +++ b/man/model_parameters.cgam.Rd @@ -34,7 +34,7 @@ \method{model_parameters}{Gam}( model, - effectsize_type = NULL, + es_type = NULL, df_error = NULL, type = NULL, table_wide = FALSE, @@ -140,10 +140,21 @@ names.} \item{verbose}{Toggle warnings and messages.} \item{...}{Arguments passed to or from other methods. For instance, when -\code{bootstrap = TRUE}, arguments like \code{type} or \code{parallel} are -passed down to \code{bootstrap_model()}.} - -\item{effectsize_type}{The effect size of interest. Not that possibly not all +\code{bootstrap = TRUE}, arguments like \code{type} or \code{parallel} are passed down to +\code{bootstrap_model()}. Further non-documented arguments are \code{digits}, +\code{p_digits}, \code{ci_digits} and \code{footer_digits} to set the number of digits for +the output. If \code{s_value = TRUE}, the p-value will be replaced by the +S-value in the output (cf. \emph{Rafi and Greenland 2020}). \code{pd} adds an +additional column with the \emph{probability of direction} (see +\code{\link[bayestestR:p_direction]{bayestestR::p_direction()}} for details). \code{groups} can be used to group +coefficients. It will be passed to the print-method, or can directly be +used in \code{print()}, see documentation in \code{\link[=print.parameters_model]{print.parameters_model()}}. +Furthermore, see 'Examples' for this function. For developers, whose +interest mainly is to get a "tidy" data frame of model summaries, it is +recommended to set \code{pretty_names = FALSE} to speed up computation of the +summary table.} + +\item{es_type}{The effect size of interest. Not that possibly not all effect sizes are applicable to the model object. See 'Details'. For Anova models, can also be a character vector with multiple effect size names.} diff --git a/man/model_parameters.default.Rd b/man/model_parameters.default.Rd index 2a2ccec29..132dc2d5d 100644 --- a/man/model_parameters.default.Rd +++ b/man/model_parameters.default.Rd @@ -17,12 +17,13 @@ standardize = NULL, exponentiate = FALSE, p_adjust = NULL, + vcov = NULL, + vcov_args = NULL, summary = getOption("parameters_summary", FALSE), + include_info = getOption("parameters_info", FALSE), keep = NULL, drop = NULL, verbose = TRUE, - vcov = NULL, - vcov_args = NULL, ... ) @@ -35,11 +36,12 @@ standardize = NULL, exponentiate = FALSE, p_adjust = NULL, + vcov = NULL, + vcov_args = NULL, summary = getOption("parameters_summary", FALSE), + include_info = getOption("parameters_info", FALSE), keep = NULL, drop = NULL, - vcov = NULL, - vcov_args = NULL, verbose = TRUE, ... ) @@ -53,12 +55,13 @@ standardize = NULL, exponentiate = FALSE, p_adjust = NULL, + vcov = NULL, + vcov_args = NULL, summary = getOption("parameters_summary", FALSE), + include_info = getOption("parameters_info", FALSE), keep = NULL, drop = NULL, verbose = TRUE, - vcov = NULL, - vcov_args = NULL, ... ) @@ -122,7 +125,34 @@ possible adjustment methods are \code{"tukey"}, \code{"scheffe"}, \code{"sidak"} and \code{"none"} to explicitly disable adjustment for \code{emmGrid} objects (from \strong{emmeans}).} -\item{summary}{Logical, if \code{TRUE}, prints summary information about the +\item{vcov}{Variance-covariance matrix used to compute uncertainty estimates +(e.g., for robust standard errors). This argument accepts a covariance matrix, +a function which returns a covariance matrix, or a string which identifies +the function to be used to compute the covariance matrix. +\itemize{ +\item A covariance matrix +\item A function which returns a covariance matrix (e.g., \code{stats::vcov()}) +\item A string which indicates the kind of uncertainty estimates to return. +\itemize{ +\item Heteroskedasticity-consistent: \code{"vcovHC"}, \code{"HC"}, \code{"HC0"}, \code{"HC1"}, +\code{"HC2"}, \code{"HC3"}, \code{"HC4"}, \code{"HC4m"}, \code{"HC5"}. See \code{?sandwich::vcovHC}. +\item Cluster-robust: \code{"vcovCR"}, \code{"CR0"}, \code{"CR1"}, \code{"CR1p"}, \code{"CR1S"}, +\code{"CR2"}, \code{"CR3"}. See \code{?clubSandwich::vcovCR}. +\item Bootstrap: \code{"vcovBS"}, \code{"xy"}, \code{"residual"}, \code{"wild"}, \code{"mammen"}, +\code{"webb"}. See \code{?sandwich::vcovBS}. +\item Other \code{sandwich} package functions: \code{"vcovHAC"}, \code{"vcovPC"}, \code{"vcovCL"}, +\code{"vcovPL"}. +} +}} + +\item{vcov_args}{List of arguments to be passed to the function identified by +the \code{vcov} argument. This function is typically supplied by the \strong{sandwich} +or \strong{clubSandwich} packages. Please refer to their documentation (e.g., +\code{?sandwich::vcovHAC}) to see the list of available arguments.} + +\item{summary}{Deprecated, please use \code{info} instead.} + +\item{include_info}{Logical, if \code{TRUE}, prints summary information about the model (model formula, number of observations, residual standard deviation and more).} @@ -150,40 +180,27 @@ names.} \item{verbose}{Toggle warnings and messages.} -\item{vcov}{Variance-covariance matrix used to compute uncertainty estimates -(e.g., for robust standard errors). This argument accepts a covariance matrix, -a function which returns a covariance matrix, or a string which identifies -the function to be used to compute the covariance matrix. -\itemize{ -\item A covariance matrix -\item A function which returns a covariance matrix (e.g., \code{stats::vcov()}) -\item A string which indicates the kind of uncertainty estimates to return. -\itemize{ -\item Heteroskedasticity-consistent: \code{"vcovHC"}, \code{"HC"}, \code{"HC0"}, \code{"HC1"}, -\code{"HC2"}, \code{"HC3"}, \code{"HC4"}, \code{"HC4m"}, \code{"HC5"}. See \code{?sandwich::vcovHC}. -\item Cluster-robust: \code{"vcovCR"}, \code{"CR0"}, \code{"CR1"}, \code{"CR1p"}, \code{"CR1S"}, \code{"CR2"}, -\code{"CR3"}. See \code{?clubSandwich::vcovCR}. -\item Bootstrap: \code{"vcovBS"}, \code{"xy"}, \code{"residual"}, \code{"wild"}, \code{"mammen"}, \code{"webb"}. -See \code{?sandwich::vcovBS}. -\item Other \code{sandwich} package functions: \code{"vcovHAC"}, \code{"vcovPC"}, \code{"vcovCL"}, \code{"vcovPL"}. -} -}} - -\item{vcov_args}{List of arguments to be passed to the function identified by -the \code{vcov} argument. This function is typically supplied by the \strong{sandwich} -or \strong{clubSandwich} packages. Please refer to their documentation (e.g., -\code{?sandwich::vcovHAC}) to see the list of available arguments.} - \item{...}{Arguments passed to or from other methods. For instance, when -\code{bootstrap = TRUE}, arguments like \code{type} or \code{parallel} are -passed down to \code{bootstrap_model()}.} +\code{bootstrap = TRUE}, arguments like \code{type} or \code{parallel} are passed down to +\code{bootstrap_model()}. Further non-documented arguments are \code{digits}, +\code{p_digits}, \code{ci_digits} and \code{footer_digits} to set the number of digits for +the output. If \code{s_value = TRUE}, the p-value will be replaced by the +S-value in the output (cf. \emph{Rafi and Greenland 2020}). \code{pd} adds an +additional column with the \emph{probability of direction} (see +\code{\link[bayestestR:p_direction]{bayestestR::p_direction()}} for details). \code{groups} can be used to group +coefficients. It will be passed to the print-method, or can directly be +used in \code{print()}, see documentation in \code{\link[=print.parameters_model]{print.parameters_model()}}. +Furthermore, see 'Examples' for this function. For developers, whose +interest mainly is to get a "tidy" data frame of model summaries, it is +recommended to set \code{pretty_names = FALSE} to speed up computation of the +summary table.} } \value{ A data frame of indices related to the model's parameters. } \description{ -Extract and compute indices and measures to describe parameters of (general) -linear models (GLMs). +Extract and compute indices and measures to describe parameters +of (generalized) linear models (GLMs). } \section{Confidence intervals and approximation of degrees of freedom}{ @@ -375,6 +392,11 @@ model_parameters(model, # different p-value style in output model_parameters(model, p_digits = 5) model_parameters(model, digits = 3, ci_digits = 4, p_digits = "scientific") + +# report S-value or probability of direction for parameters +model_parameters(model, s_value = TRUE) +model_parameters(model, pd = TRUE) + \donttest{ # logistic regression model model <- glm(vs ~ wt + cyl, data = mtcars, family = "binomial") @@ -395,6 +417,6 @@ model_parameters(model) \dontshow{\}) # examplesIf} } \seealso{ -\code{\link[insight:standardize_names]{insight::standardize_names()}} to -rename columns into a consistent, standardized naming scheme. +\code{\link[insight:standardize_names]{insight::standardize_names()}} to rename columns into a +consistent, standardized naming scheme. } diff --git a/man/model_parameters.glht.Rd b/man/model_parameters.glht.Rd index 9ac52abde..b71244fd3 100644 --- a/man/model_parameters.glht.Rd +++ b/man/model_parameters.glht.Rd @@ -58,8 +58,19 @@ names.} \item{verbose}{Toggle warnings and messages.} \item{...}{Arguments passed to or from other methods. For instance, when -\code{bootstrap = TRUE}, arguments like \code{type} or \code{parallel} are -passed down to \code{bootstrap_model()}.} +\code{bootstrap = TRUE}, arguments like \code{type} or \code{parallel} are passed down to +\code{bootstrap_model()}. Further non-documented arguments are \code{digits}, +\code{p_digits}, \code{ci_digits} and \code{footer_digits} to set the number of digits for +the output. If \code{s_value = TRUE}, the p-value will be replaced by the +S-value in the output (cf. \emph{Rafi and Greenland 2020}). \code{pd} adds an +additional column with the \emph{probability of direction} (see +\code{\link[bayestestR:p_direction]{bayestestR::p_direction()}} for details). \code{groups} can be used to group +coefficients. It will be passed to the print-method, or can directly be +used in \code{print()}, see documentation in \code{\link[=print.parameters_model]{print.parameters_model()}}. +Furthermore, see 'Examples' for this function. For developers, whose +interest mainly is to get a "tidy" data frame of model summaries, it is +recommended to set \code{pretty_names = FALSE} to speed up computation of the +summary table.} } \value{ A data frame of indices related to the model's parameters. diff --git a/man/model_parameters.htest.Rd b/man/model_parameters.htest.Rd index f58bba0b3..3d83e29c7 100644 --- a/man/model_parameters.htest.Rd +++ b/man/model_parameters.htest.Rd @@ -10,19 +10,8 @@ ci = 0.95, alternative = NULL, bootstrap = FALSE, - effectsize_type = NULL, + es_type = NULL, verbose = TRUE, - cramers_v = NULL, - phi = NULL, - standardized_d = NULL, - hedges_g = NULL, - omega_squared = NULL, - eta_squared = NULL, - epsilon_squared = NULL, - cohens_g = NULL, - rank_biserial = NULL, - rank_epsilon_squared = NULL, - kendalls_w = NULL, ... ) @@ -50,17 +39,26 @@ the \href{https://easystats.github.io/effectsize/}{effectsize_CIs vignette}.} \item{bootstrap}{Should estimates be bootstrapped?} -\item{effectsize_type}{The effect size of interest. Not that possibly not all +\item{es_type}{The effect size of interest. Not that possibly not all effect sizes are applicable to the model object. See 'Details'. For Anova models, can also be a character vector with multiple effect size names.} \item{verbose}{Toggle warnings and messages.} -\item{cramers_v, phi, cohens_g, standardized_d, hedges_g, omega_squared, eta_squared, epsilon_squared, rank_biserial, rank_epsilon_squared, kendalls_w}{Deprecated. Please use \code{effectsize_type}.} - \item{...}{Arguments passed to or from other methods. For instance, when -\code{bootstrap = TRUE}, arguments like \code{type} or \code{parallel} are -passed down to \code{bootstrap_model()}.} +\code{bootstrap = TRUE}, arguments like \code{type} or \code{parallel} are passed down to +\code{bootstrap_model()}. Further non-documented arguments are \code{digits}, +\code{p_digits}, \code{ci_digits} and \code{footer_digits} to set the number of digits for +the output. If \code{s_value = TRUE}, the p-value will be replaced by the +S-value in the output (cf. \emph{Rafi and Greenland 2020}). \code{pd} adds an +additional column with the \emph{probability of direction} (see +\code{\link[bayestestR:p_direction]{bayestestR::p_direction()}} for details). \code{groups} can be used to group +coefficients. It will be passed to the print-method, or can directly be +used in \code{print()}, see documentation in \code{\link[=print.parameters_model]{print.parameters_model()}}. +Furthermore, see 'Examples' for this function. For developers, whose +interest mainly is to get a "tidy" data frame of model summaries, it is +recommended to set \code{pretty_names = FALSE} to speed up computation of the +summary table.} \item{ci_method}{Method for computing degrees of freedom for confidence intervals (CI) and the related p-values. Allowed are following @@ -137,13 +135,13 @@ model <- cor.test(mtcars$mpg, mtcars$cyl, method = "pearson") model_parameters(model) model <- t.test(iris$Sepal.Width, iris$Sepal.Length) -model_parameters(model, effectsize_type = "hedges_g") +model_parameters(model, es_type = "hedges_g") model <- t.test(mtcars$mpg ~ mtcars$vs) -model_parameters(model, effectsize_type = "hedges_g") +model_parameters(model, es_type = "hedges_g") model <- t.test(iris$Sepal.Width, mu = 1) -model_parameters(model, effectsize_type = "cohens_d") +model_parameters(model, es_type = "cohens_d") data(airquality) airquality$Month <- factor(airquality$Month, labels = month.abb[5:9]) @@ -156,6 +154,6 @@ model <- suppressWarnings(pairwise.prop.test(smokers, patients)) model_parameters(model) model <- suppressWarnings(chisq.test(table(mtcars$am, mtcars$cyl))) -model_parameters(model, effectsize_type = "cramers_v") +model_parameters(model, es_type = "cramers_v") } diff --git a/man/model_parameters.merMod.Rd b/man/model_parameters.merMod.Rd index 8b1b8e75c..a5c99f91e 100644 --- a/man/model_parameters.merMod.Rd +++ b/man/model_parameters.merMod.Rd @@ -47,10 +47,11 @@ p_adjust = NULL, wb_component = TRUE, summary = getOption("parameters_mixed_summary", FALSE), + include_info = getOption("parameters_mixed_info", FALSE), + include_sigma = FALSE, keep = NULL, drop = NULL, verbose = TRUE, - include_sigma = FALSE, ... ) @@ -66,14 +67,15 @@ group_level = FALSE, exponentiate = FALSE, p_adjust = NULL, + vcov = NULL, + vcov_args = NULL, wb_component = TRUE, summary = getOption("parameters_mixed_summary", FALSE), + include_info = getOption("parameters_mixed_info", FALSE), + include_sigma = FALSE, keep = NULL, drop = NULL, verbose = TRUE, - include_sigma = FALSE, - vcov = NULL, - vcov_args = NULL, ... ) @@ -92,10 +94,11 @@ p_adjust = NULL, wb_component = TRUE, summary = getOption("parameters_mixed_summary", FALSE), + include_info = getOption("parameters_mixed_info", FALSE), + include_sigma = FALSE, keep = NULL, drop = NULL, verbose = TRUE, - include_sigma = FALSE, ... ) @@ -114,10 +117,11 @@ p_adjust = NULL, wb_component = TRUE, summary = getOption("parameters_mixed_summary", FALSE), + include_info = getOption("parameters_mixed_info", FALSE), + include_sigma = FALSE, keep = NULL, drop = NULL, verbose = TRUE, - include_sigma = FALSE, ... ) @@ -133,14 +137,15 @@ group_level = FALSE, exponentiate = FALSE, p_adjust = NULL, + vcov = NULL, + vcov_args = NULL, wb_component = TRUE, summary = getOption("parameters_mixed_summary", FALSE), + include_info = getOption("parameters_mixed_info", FALSE), + include_sigma = FALSE, keep = NULL, drop = NULL, verbose = TRUE, - include_sigma = FALSE, - vcov = NULL, - vcov_args = NULL, ... ) @@ -154,6 +159,7 @@ exponentiate = FALSE, p_adjust = NULL, summary = getOption("parameters_summary", FALSE), + include_info = getOption("parameters_info", FALSE), keep = NULL, drop = NULL, verbose = TRUE, @@ -289,8 +295,19 @@ names.} \item{verbose}{Toggle warnings and messages.} \item{...}{Arguments passed to or from other methods. For instance, when -\code{bootstrap = TRUE}, arguments like \code{type} or \code{parallel} are -passed down to \code{bootstrap_model()}.} +\code{bootstrap = TRUE}, arguments like \code{type} or \code{parallel} are passed down to +\code{bootstrap_model()}. Further non-documented arguments are \code{digits}, +\code{p_digits}, \code{ci_digits} and \code{footer_digits} to set the number of digits for +the output. If \code{s_value = TRUE}, the p-value will be replaced by the +S-value in the output (cf. \emph{Rafi and Greenland 2020}). \code{pd} adds an +additional column with the \emph{probability of direction} (see +\code{\link[bayestestR:p_direction]{bayestestR::p_direction()}} for details). \code{groups} can be used to group +coefficients. It will be passed to the print-method, or can directly be +used in \code{print()}, see documentation in \code{\link[=print.parameters_model]{print.parameters_model()}}. +Furthermore, see 'Examples' in \code{\link[=model_parameters.default]{model_parameters.default()}}. For +developers, whose interest mainly is to get a "tidy" data frame of model +summaries, it is recommended to set \code{pretty_names = FALSE} to speed up +computation of the summary table.} \item{component}{Should all parameters, parameters for the conditional model, for the zero-inflation part of the model, or the dispersion model be returned? @@ -305,7 +322,9 @@ between-effects, and cross-level interactions. By default, the \code{Component} column indicates, which parameters belong to the conditional or zero-inflation component of the model.} -\item{summary}{Logical, if \code{TRUE}, prints summary information about the +\item{summary}{Deprecated, please use \code{info} instead.} + +\item{include_info}{Logical, if \code{TRUE}, prints summary information about the model (model formula, number of observations, residual standard deviation and more).} @@ -320,11 +339,12 @@ the function to be used to compute the covariance matrix. \itemize{ \item Heteroskedasticity-consistent: \code{"vcovHC"}, \code{"HC"}, \code{"HC0"}, \code{"HC1"}, \code{"HC2"}, \code{"HC3"}, \code{"HC4"}, \code{"HC4m"}, \code{"HC5"}. See \code{?sandwich::vcovHC}. -\item Cluster-robust: \code{"vcovCR"}, \code{"CR0"}, \code{"CR1"}, \code{"CR1p"}, \code{"CR1S"}, \code{"CR2"}, -\code{"CR3"}. See \code{?clubSandwich::vcovCR}. -\item Bootstrap: \code{"vcovBS"}, \code{"xy"}, \code{"residual"}, \code{"wild"}, \code{"mammen"}, \code{"webb"}. -See \code{?sandwich::vcovBS}. -\item Other \code{sandwich} package functions: \code{"vcovHAC"}, \code{"vcovPC"}, \code{"vcovCL"}, \code{"vcovPL"}. +\item Cluster-robust: \code{"vcovCR"}, \code{"CR0"}, \code{"CR1"}, \code{"CR1p"}, \code{"CR1S"}, +\code{"CR2"}, \code{"CR3"}. See \code{?clubSandwich::vcovCR}. +\item Bootstrap: \code{"vcovBS"}, \code{"xy"}, \code{"residual"}, \code{"wild"}, \code{"mammen"}, +\code{"webb"}. See \code{?sandwich::vcovBS}. +\item Other \code{sandwich} package functions: \code{"vcovHAC"}, \code{"vcovPC"}, \code{"vcovCL"}, +\code{"vcovPL"}. } }} diff --git a/man/model_parameters.mira.Rd b/man/model_parameters.mira.Rd index 323886aa8..5b379f152 100644 --- a/man/model_parameters.mira.Rd +++ b/man/model_parameters.mira.Rd @@ -87,38 +87,32 @@ similar to \code{summary(mice::pool())}, i.e. it generates the pooled summary of multiple imputed repeated regression analyses. } \examples{ +\dontshow{if (require("mice", quietly = TRUE) && require("gee", quietly = TRUE)) (if (getRversion() >= "3.4") withAutoprint else force)(\{ # examplesIf} library(parameters) -if (require("mice", quietly = TRUE)) { - data(nhanes2) - imp <- mice(nhanes2) - fit <- with(data = imp, exp = lm(bmi ~ age + hyp + chl)) - model_parameters(fit) -} +data(nhanes2, package = "mice") +imp <- mice::mice(nhanes2) +fit <- with(data = imp, exp = lm(bmi ~ age + hyp + chl)) +model_parameters(fit) \donttest{ # model_parameters() also works for models that have no "tidy"-method in mice -if (require("mice", quietly = TRUE) && require("gee", quietly = TRUE)) { - data(warpbreaks) - set.seed(1234) - warpbreaks$tension[sample(1:nrow(warpbreaks), size = 10)] <- NA - imp <- mice(warpbreaks) - fit <- with(data = imp, expr = gee(breaks ~ tension, id = wool)) +data(warpbreaks) +set.seed(1234) +warpbreaks$tension[sample(1:nrow(warpbreaks), size = 10)] <- NA +imp <- mice::mice(warpbreaks) +fit <- with(data = imp, expr = gee::gee(breaks ~ tension, id = wool)) - # does not work: - # summary(pool(fit)) +# does not work: +# summary(mice::pool(fit)) - model_parameters(fit) -} +model_parameters(fit) } - - # and it works with pooled results -if (require("mice")) { - data("nhanes2") - imp <- mice(nhanes2) - fit <- with(data = imp, exp = lm(bmi ~ age + hyp + chl)) - pooled <- pool(fit) +data("nhanes2", package = "mice") +imp <- mice::mice(nhanes2) +fit <- with(data = imp, exp = lm(bmi ~ age + hyp + chl)) +pooled <- mice::pool(fit) - model_parameters(pooled) -} +model_parameters(pooled) +\dontshow{\}) # examplesIf} } diff --git a/man/model_parameters.mlm.Rd b/man/model_parameters.mlm.Rd index fb6e86490..54d2ee308 100644 --- a/man/model_parameters.mlm.Rd +++ b/man/model_parameters.mlm.Rd @@ -35,6 +35,7 @@ exponentiate = FALSE, p_adjust = NULL, summary = getOption("parameters_summary", FALSE), + include_info = getOption("parameters_info", FALSE), keep = NULL, drop = NULL, verbose = TRUE, @@ -67,6 +68,7 @@ exponentiate = FALSE, p_adjust = NULL, summary = getOption("parameters_summary", FALSE), + include_info = getOption("parameters_info", FALSE), keep = NULL, drop = NULL, verbose = TRUE, @@ -152,10 +154,23 @@ names.} \item{verbose}{Toggle warnings and messages.} \item{...}{Arguments passed to or from other methods. For instance, when -\code{bootstrap = TRUE}, arguments like \code{type} or \code{parallel} are -passed down to \code{bootstrap_model()}.} - -\item{summary}{Logical, if \code{TRUE}, prints summary information about the +\code{bootstrap = TRUE}, arguments like \code{type} or \code{parallel} are passed down to +\code{bootstrap_model()}. Further non-documented arguments are \code{digits}, +\code{p_digits}, \code{ci_digits} and \code{footer_digits} to set the number of digits for +the output. If \code{s_value = TRUE}, the p-value will be replaced by the +S-value in the output (cf. \emph{Rafi and Greenland 2020}). \code{pd} adds an +additional column with the \emph{probability of direction} (see +\code{\link[bayestestR:p_direction]{bayestestR::p_direction()}} for details). \code{groups} can be used to group +coefficients. It will be passed to the print-method, or can directly be +used in \code{print()}, see documentation in \code{\link[=print.parameters_model]{print.parameters_model()}}. +Furthermore, see 'Examples' for this function. For developers, whose +interest mainly is to get a "tidy" data frame of model summaries, it is +recommended to set \code{pretty_names = FALSE} to speed up computation of the +summary table.} + +\item{summary}{Deprecated, please use \code{info} instead.} + +\item{include_info}{Logical, if \code{TRUE}, prints summary information about the model (model formula, number of observations, residual standard deviation and more).} @@ -170,11 +185,12 @@ the function to be used to compute the covariance matrix. \itemize{ \item Heteroskedasticity-consistent: \code{"vcovHC"}, \code{"HC"}, \code{"HC0"}, \code{"HC1"}, \code{"HC2"}, \code{"HC3"}, \code{"HC4"}, \code{"HC4m"}, \code{"HC5"}. See \code{?sandwich::vcovHC}. -\item Cluster-robust: \code{"vcovCR"}, \code{"CR0"}, \code{"CR1"}, \code{"CR1p"}, \code{"CR1S"}, \code{"CR2"}, -\code{"CR3"}. See \code{?clubSandwich::vcovCR}. -\item Bootstrap: \code{"vcovBS"}, \code{"xy"}, \code{"residual"}, \code{"wild"}, \code{"mammen"}, \code{"webb"}. -See \code{?sandwich::vcovBS}. -\item Other \code{sandwich} package functions: \code{"vcovHAC"}, \code{"vcovPC"}, \code{"vcovCL"}, \code{"vcovPL"}. +\item Cluster-robust: \code{"vcovCR"}, \code{"CR0"}, \code{"CR1"}, \code{"CR1p"}, \code{"CR1S"}, +\code{"CR2"}, \code{"CR3"}. See \code{?clubSandwich::vcovCR}. +\item Bootstrap: \code{"vcovBS"}, \code{"xy"}, \code{"residual"}, \code{"wild"}, \code{"mammen"}, +\code{"webb"}. See \code{?sandwich::vcovBS}. +\item Other \code{sandwich} package functions: \code{"vcovHAC"}, \code{"vcovPC"}, \code{"vcovCL"}, +\code{"vcovPL"}. } }} diff --git a/man/model_parameters.rma.Rd b/man/model_parameters.rma.Rd index 2d12431d8..e58a6844f 100644 --- a/man/model_parameters.rma.Rd +++ b/man/model_parameters.rma.Rd @@ -88,8 +88,19 @@ names.} \item{verbose}{Toggle warnings and messages.} \item{...}{Arguments passed to or from other methods. For instance, when -\code{bootstrap = TRUE}, arguments like \code{type} or \code{parallel} are -passed down to \code{bootstrap_model()}.} +\code{bootstrap = TRUE}, arguments like \code{type} or \code{parallel} are passed down to +\code{bootstrap_model()}. Further non-documented arguments are \code{digits}, +\code{p_digits}, \code{ci_digits} and \code{footer_digits} to set the number of digits for +the output. If \code{s_value = TRUE}, the p-value will be replaced by the +S-value in the output (cf. \emph{Rafi and Greenland 2020}). \code{pd} adds an +additional column with the \emph{probability of direction} (see +\code{\link[bayestestR:p_direction]{bayestestR::p_direction()}} for details). \code{groups} can be used to group +coefficients. It will be passed to the print-method, or can directly be +used in \code{print()}, see documentation in \code{\link[=print.parameters_model]{print.parameters_model()}}. +Furthermore, see 'Examples' for this function. For developers, whose +interest mainly is to get a "tidy" data frame of model summaries, it is +recommended to set \code{pretty_names = FALSE} to speed up computation of the +summary table.} } \value{ A data frame of indices related to the model's parameters. diff --git a/man/model_parameters.stanreg.Rd b/man/model_parameters.stanreg.Rd index 3980d2292..57095a54b 100644 --- a/man/model_parameters.stanreg.Rd +++ b/man/model_parameters.stanreg.Rd @@ -27,7 +27,13 @@ ... ) -\method{model_parameters}{data.frame}(model, as_draws = FALSE, verbose = TRUE, ...) +\method{model_parameters}{data.frame}( + model, + as_draws = FALSE, + exponentiate = FALSE, + verbose = TRUE, + ... +) \method{model_parameters}{brmsfit}( model, @@ -61,6 +67,7 @@ test = "pd", rope_range = "default", rope_ci = 0.95, + exponentiate = FALSE, keep = NULL, drop = NULL, verbose = TRUE, @@ -124,9 +131,10 @@ For each "test", the corresponding \pkg{bayestestR} function is called (e.g. \code{\link[bayestestR:rope]{rope()}} or \code{\link[bayestestR:p_direction]{p_direction()}}) and its results included in the summary output.} -\item{rope_range}{ROPE's lower and higher bounds. Should be a list of two -values (e.g., \code{c(-0.1, 0.1)}) or \code{"default"}. If \code{"default"}, -the bounds are set to \code{x +- 0.1*SD(response)}.} +\item{rope_range}{ROPE's lower and higher bounds. Should be a vector of two +values (e.g., \code{c(-0.1, 0.1)}), \code{"default"} or a list of numeric vectors of +the same length as numbers of parameters. If \code{"default"}, the bounds are +set to \code{x +- 0.1*SD(response)}.} \item{rope_ci}{The Credible Interval (CI) probability, corresponding to the proportion of HDI, to use for the percentage in ROPE.} @@ -171,6 +179,19 @@ the data frame is treated as posterior samples and handled similar to Bayesian models. All arguments in \code{...} are passed to \code{model_parameters.draws()}.} +\item{exponentiate}{Logical, indicating whether or not to exponentiate the +coefficients (and related confidence intervals). This is typical for +logistic regression, or more generally speaking, for models with log or +logit links. It is also recommended to use \code{exponentiate = TRUE} for models +with log-transformed response values. \strong{Note:} Delta-method standard +errors are also computed (by multiplying the standard errors by the +transformed coefficients). This is to mimic behaviour of other software +packages, such as Stata, but these standard errors poorly estimate +uncertainty for the transformed coefficient. The transformed confidence +interval more clearly captures this uncertainty. For \code{compare_parameters()}, +\code{exponentiate = "nongaussian"} will only exponentiate coefficients from +non-Gaussian families.} + \item{effects}{Should results for fixed effects, random effects or both be returned? Only applies to mixed models. May be abbreviated.} @@ -188,19 +209,6 @@ argument - but no auxiliary parameters). For \code{component = "distributional"} (or \code{"auxiliary"}), components like \code{sigma}, \code{dispersion}, or \code{beta} (and other auxiliary parameters) are returned.} -\item{exponentiate}{Logical, indicating whether or not to exponentiate the -coefficients (and related confidence intervals). This is typical for -logistic regression, or more generally speaking, for models with log or -logit links. It is also recommended to use \code{exponentiate = TRUE} for models -with log-transformed response values. \strong{Note:} Delta-method standard -errors are also computed (by multiplying the standard errors by the -transformed coefficients). This is to mimic behaviour of other software -packages, such as Stata, but these standard errors poorly estimate -uncertainty for the transformed coefficient. The transformed confidence -interval more clearly captures this uncertainty. For \code{compare_parameters()}, -\code{exponentiate = "nongaussian"} will only exponentiate coefficients from -non-Gaussian families.} - \item{standardize}{The method used for standardizing the parameters. Can be \code{NULL} (default; no standardization), \code{"refit"} (for re-fitting the model on standardized data) or one of \code{"basic"}, \code{"posthoc"}, \code{"smart"}, diff --git a/man/model_parameters.zcpglm.Rd b/man/model_parameters.zcpglm.Rd index c277b50c3..c9d67ae9d 100644 --- a/man/model_parameters.zcpglm.Rd +++ b/man/model_parameters.zcpglm.Rd @@ -14,9 +14,10 @@ standardize = NULL, exponentiate = FALSE, p_adjust = NULL, + summary = getOption("parameters_summary", FALSE), + include_info = getOption("parameters_info", FALSE), keep = NULL, drop = NULL, - summary = getOption("parameters_summary", FALSE), verbose = TRUE, ... ) @@ -88,6 +89,12 @@ possible adjustment methods are \code{"tukey"}, \code{"scheffe"}, \code{"sidak"} and \code{"none"} to explicitly disable adjustment for \code{emmGrid} objects (from \strong{emmeans}).} +\item{summary}{Deprecated, please use \code{info} instead.} + +\item{include_info}{Logical, if \code{TRUE}, prints summary information about the +model (model formula, number of observations, residual standard deviation +and more).} + \item{keep}{Character containing a regular expression pattern that describes the parameters that should be included (for \code{keep}) or excluded (for \code{drop}) in the returned data frame. \code{keep} may also be a @@ -110,15 +117,22 @@ names.} \item{drop}{See \code{keep}.} -\item{summary}{Logical, if \code{TRUE}, prints summary information about the -model (model formula, number of observations, residual standard deviation -and more).} - \item{verbose}{Toggle warnings and messages.} \item{...}{Arguments passed to or from other methods. For instance, when -\code{bootstrap = TRUE}, arguments like \code{type} or \code{parallel} are -passed down to \code{bootstrap_model()}.} +\code{bootstrap = TRUE}, arguments like \code{type} or \code{parallel} are passed down to +\code{bootstrap_model()}. Further non-documented arguments are \code{digits}, +\code{p_digits}, \code{ci_digits} and \code{footer_digits} to set the number of digits for +the output. If \code{s_value = TRUE}, the p-value will be replaced by the +S-value in the output (cf. \emph{Rafi and Greenland 2020}). \code{pd} adds an +additional column with the \emph{probability of direction} (see +\code{\link[bayestestR:p_direction]{bayestestR::p_direction()}} for details). \code{groups} can be used to group +coefficients. It will be passed to the print-method, or can directly be +used in \code{print()}, see documentation in \code{\link[=print.parameters_model]{print.parameters_model()}}. +Furthermore, see 'Examples' for this function. For developers, whose +interest mainly is to get a "tidy" data frame of model summaries, it is +recommended to set \code{pretty_names = FALSE} to speed up computation of the +summary table.} } \value{ A data frame of indices related to the model's parameters. diff --git a/man/n_clusters.Rd b/man/n_clusters.Rd index 444d06ad7..13b385a05 100644 --- a/man/n_clusters.Rd +++ b/man/n_clusters.Rd @@ -94,8 +94,19 @@ as \code{method}).} \item{n_max}{Maximal number of clusters to test.} \item{...}{Arguments passed to or from other methods. For instance, when -\code{bootstrap = TRUE}, arguments like \code{type} or \code{parallel} are -passed down to \code{bootstrap_model()}.} +\code{bootstrap = TRUE}, arguments like \code{type} or \code{parallel} are passed down to +\code{bootstrap_model()}. Further non-documented arguments are \code{digits}, +\code{p_digits}, \code{ci_digits} and \code{footer_digits} to set the number of digits for +the output. If \code{s_value = TRUE}, the p-value will be replaced by the +S-value in the output (cf. \emph{Rafi and Greenland 2020}). \code{pd} adds an +additional column with the \emph{probability of direction} (see +\code{\link[bayestestR:p_direction]{bayestestR::p_direction()}} for details). \code{groups} can be used to group +coefficients. It will be passed to the print-method, or can directly be +used in \code{print()}, see documentation in \code{\link[=print.parameters_model]{print.parameters_model()}}. +Furthermore, see 'Examples' for this function. For developers, whose +interest mainly is to get a "tidy" data frame of model summaries, it is +recommended to set \code{pretty_names = FALSE} to speed up computation of the +summary table.} \item{clustering_function, gap_method}{Other arguments passed to other functions. \code{clustering_function} is used by \code{fviz_nbclust()} and diff --git a/man/p_direction.lm.Rd b/man/p_direction.lm.Rd new file mode 100644 index 000000000..e7e74d8e7 --- /dev/null +++ b/man/p_direction.lm.Rd @@ -0,0 +1,240 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/p_direction.R +\name{p_direction.lm} +\alias{p_direction.lm} +\title{Probability of Direction (pd)} +\usage{ +\method{p_direction}{lm}( + x, + ci = 0.95, + method = "direct", + null = 0, + vcov = NULL, + vcov_args = NULL, + ... +) +} +\arguments{ +\item{x}{A statistical model.} + +\item{ci}{Confidence Interval (CI) level. Default to \code{0.95} (\verb{95\%}).} + +\item{method}{Can be \code{"direct"} or one of methods of \code{\link[bayestestR:estimate_density]{estimate_density()}}, +such as \code{"kernel"}, \code{"logspline"} or \code{"KernSmooth"}. See details.} + +\item{null}{The value considered as a "null" effect. Traditionally 0, but +could also be 1 in the case of ratios of change (OR, IRR, ...).} + +\item{vcov}{Variance-covariance matrix used to compute uncertainty estimates +(e.g., for robust standard errors). This argument accepts a covariance matrix, +a function which returns a covariance matrix, or a string which identifies +the function to be used to compute the covariance matrix. +\itemize{ +\item A covariance matrix +\item A function which returns a covariance matrix (e.g., \code{stats::vcov()}) +\item A string which indicates the kind of uncertainty estimates to return. +\itemize{ +\item Heteroskedasticity-consistent: \code{"vcovHC"}, \code{"HC"}, \code{"HC0"}, \code{"HC1"}, +\code{"HC2"}, \code{"HC3"}, \code{"HC4"}, \code{"HC4m"}, \code{"HC5"}. See \code{?sandwich::vcovHC}. +\item Cluster-robust: \code{"vcovCR"}, \code{"CR0"}, \code{"CR1"}, \code{"CR1p"}, \code{"CR1S"}, +\code{"CR2"}, \code{"CR3"}. See \code{?clubSandwich::vcovCR}. +\item Bootstrap: \code{"vcovBS"}, \code{"xy"}, \code{"residual"}, \code{"wild"}, \code{"mammen"}, +\code{"webb"}. See \code{?sandwich::vcovBS}. +\item Other \code{sandwich} package functions: \code{"vcovHAC"}, \code{"vcovPC"}, \code{"vcovCL"}, +\code{"vcovPL"}. +} +}} + +\item{vcov_args}{List of arguments to be passed to the function identified by +the \code{vcov} argument. This function is typically supplied by the \strong{sandwich} +or \strong{clubSandwich} packages. Please refer to their documentation (e.g., +\code{?sandwich::vcovHAC}) to see the list of available arguments.} + +\item{...}{Arguments passed to other methods, e.g. \code{ci()}. Arguments like +\code{vcov} or \code{vcov_args} can be used to compute confidence intervals using a +specific variance-covariance matrix for the standard errors.} +} +\value{ +A data frame. +} +\description{ +Compute the \strong{Probability of Direction} (\emph{pd}, also known as +the Maximum Probability of Effect - \emph{MPE}). This can be interpreted as the +probability that a parameter (described by its full confidence, or +"compatibility" interval) is strictly positive or negative (whichever is the +most probable). Although differently expressed, this index is fairly similar +(i.e., is strongly correlated) to the frequentist \emph{p-value} (see 'Details'). +} +\section{What is the \emph{pd}?}{ + + + +The Probability of Direction (pd) is an index of effect existence, representing +the certainty with which an effect goes in a particular direction (i.e., is +positive or negative / has a sign), typically ranging from 0.5 to 1 (but see +next section for cases where it can range between 0 and 1). Beyond +its simplicity of interpretation, understanding and computation, this index +also presents other interesting properties: +\itemize{ +\item Like other posterior-based indices, \emph{pd} is solely based on the posterior +distributions and does not require any additional information from the data +or the model (e.g., such as priors, as in the case of Bayes factors). +\item It is robust to the scale of both the response variable and the predictors. +\item It is strongly correlated with the frequentist p-value, and can thus +be used to draw parallels and give some reference to readers non-familiar +with Bayesian statistics (Makowski et al., 2019). +} + +} + +\section{Relationship with the p-value}{ + + + +In most cases, it seems that the \emph{pd} has a direct correspondence with the +frequentist one-sided \emph{p}-value through the formula (for two-sided \emph{p}): +\ifelse{html}{\out{p = 2 * (1 - pd)}}{\eqn{p = 2 \times (1 - p_d)}} +Thus, a two-sided p-value of respectively \code{.1}, \code{.05}, \code{.01} and \code{.001} would +correspond approximately to a \emph{pd} of \verb{95\%}, \verb{97.5\%}, \verb{99.5\%} and \verb{99.95\%}. +See \code{\link[bayestestR:pd_to_p]{pd_to_p()}} for details. + +} + +\section{Possible Range of Values}{ + + + +The largest value \emph{pd} can take is 1 - the posterior is strictly directional. +However, the smallest value \emph{pd} can take depends on the parameter space +represented by the posterior. + +\strong{For a continuous parameter space}, exact values of 0 (or any point null +value) are not possible, and so 100\% of the posterior has \emph{some} sign, some +positive, some negative. Therefore, the smallest the \emph{pd} can be is 0.5 - +with an equal posterior mass of positive and negative values. Values close to +0.5 \emph{cannot} be used to support the null hypothesis (that the parameter does +\emph{not} have a direction) is a similar why to how large p-values cannot be used +to support the null hypothesis (see \code{\link[bayestestR:pd_to_p]{pd_to_p()}}; Makowski et al., 2019). + +\strong{For a discrete parameter space or a parameter space that is a mixture +between discrete and continuous spaces}, exact values of 0 (or any point +null value) \emph{are} possible! Therefore, the smallest the \emph{pd} can be is 0 - +with 100\% of the posterior mass on 0. Thus values close to 0 can be used to +support the null hypothesis (see van den Bergh et al., 2021). + +Examples of posteriors representing discrete parameter space: +\itemize{ +\item When a parameter can only take discrete values. +\item When a mixture prior/posterior is used (such as the spike-and-slab prior; +see van den Bergh et al., 2021). +\item When conducting Bayesian model averaging (e.g., \code{\link[bayestestR:weighted_posteriors]{weighted_posteriors()}} or +\code{brms::posterior_average}). +} + +} + +\section{Statistical inference - how to quantify evidence}{ + +There is no standardized approach to drawing conclusions based on the +available data and statistical models. A frequently chosen but also much +criticized approach is to evaluate results based on their statistical +significance (\emph{Amrhein et al. 2017}). + +A more sophisticated way would be to test whether estimated effects exceed +the "smallest effect size of interest", to avoid even the smallest effects +being considered relevant simply because they are statistically significant, +but clinically or practically irrelevant (\emph{Lakens et al. 2018, Lakens 2024}). + +A rather unconventional approach, which is nevertheless advocated by various +authors, is to interpret results from classical regression models either in +terms of probabilities, similar to the usual approach in Bayesian statistics +(\emph{Schweder 2018; Schweder and Hjort 2003; Vos 2022}) or in terms of relative +measure of "evidence" or "compatibility" with the data (\emph{Greenland et al. 2022; +Rafi and Greenland 2020}), which nevertheless comes close to a probabilistic +interpretation. + +A more detailed discussion of this topic is found in the documentation of +\code{\link[=p_function]{p_function()}}. + +The \strong{parameters} package provides several options or functions to aid +statistical inference. These are, for example: +\itemize{ +\item \code{\link[=equivalence_test.lm]{equivalence_test()}}, to compute the (conditional) +equivalence test for frequentist models +\item \code{\link[=p_significance.lm]{p_significance()}}, to compute the probability of +\emph{practical significance}, which can be conceptualized as a unidirectional +equivalence test +\item \code{\link[=p_function]{p_function()}}, or \emph{consonance function}, to compute p-values and +compatibility (confidence) intervals for statistical models +\item the \code{pd} argument (setting \code{pd = TRUE}) in \code{model_parameters()} includes +a column with the \emph{probability of direction}, i.e. the probability that a +parameter is strictly positive or negative. See \code{\link[bayestestR:p_direction]{bayestestR::p_direction()}} +for details. If plotting is desired, the \code{\link[=p_direction.lm]{p_direction()}} +function can be used, together with \code{plot()}. +\item the \code{s_value} argument (setting \code{s_value = TRUE}) in \code{model_parameters()} +replaces the p-values with their related \emph{S}-values (\emph{Rafi and Greenland 2020}) +\item finally, it is possible to generate distributions of model coefficients by +generating bootstrap-samples (setting \code{bootstrap = TRUE}) or simulating +draws from model coefficients using \code{\link[=simulate_model]{simulate_model()}}. These samples +can then be treated as "posterior samples" and used in many functions from +the \strong{bayestestR} package. +} + +Most of the above shown options or functions derive from methods originally +implemented for Bayesian models (\emph{Makowski et al. 2019}). However, assuming +that model assumptions are met (which means, the model fits well to the data, +the correct model is chosen that reflects the data generating process +(distributional model family) etc.), it seems appropriate to interpret +results from classical frequentist models in a "Bayesian way" (more details: +documentation in \code{\link[=p_function]{p_function()}}). +} + +\examples{ +\dontshow{if (requireNamespace("bayestestR") && require("see", quietly = TRUE) && requireNamespace("sandwich")) (if (getRversion() >= "3.4") withAutoprint else force)(\{ # examplesIf} +data(qol_cancer) +model <- lm(QoL ~ time + age + education, data = qol_cancer) +p_direction(model) + +# based on heteroscedasticity-robust standard errors +p_direction(model, vcov = "HC3") + +result <- p_direction(model) +plot(result) +\dontshow{\}) # examplesIf} +} +\references{ +\itemize{ +\item Amrhein, V., Korner-Nievergelt, F., and Roth, T. (2017). The earth is +flat (p > 0.05): Significance thresholds and the crisis of unreplicable +research. PeerJ, 5, e3544. \doi{10.7717/peerj.3544} +\item Greenland S, Rafi Z, Matthews R, Higgs M. To Aid Scientific Inference, +Emphasize Unconditional Compatibility Descriptions of Statistics. (2022) +https://arxiv.org/abs/1909.08583v7 (Accessed November 10, 2022) +\item Lakens, D. (2024). Improving Your Statistical Inferences (Version v1.5.1). +Retrieved from https://lakens.github.io/statistical_inferences/. +\doi{10.5281/ZENODO.6409077} +\item Lakens, D., Scheel, A. M., and Isager, P. M. (2018). Equivalence Testing +for Psychological Research: A Tutorial. Advances in Methods and Practices +in Psychological Science, 1(2), 259–269. \doi{10.1177/2515245918770963} +\item Makowski, D., Ben-Shachar, M. S., Chen, S. H. A., and Lüdecke, D. (2019). +Indices of Effect Existence and Significance in the Bayesian Framework. +Frontiers in Psychology, 10, 2767. \doi{10.3389/fpsyg.2019.02767} +\item Rafi Z, Greenland S. Semantic and cognitive tools to aid statistical +science: replace confidence and significance by compatibility and surprise. +BMC Medical Research Methodology (2020) 20:244. +\item Schweder T. Confidence is epistemic probability for empirical science. +Journal of Statistical Planning and Inference (2018) 195:116–125. +\doi{10.1016/j.jspi.2017.09.016} +\item Schweder T, Hjort NL. Frequentist analogues of priors and posteriors. +In Stigum, B. (ed.), Econometrics and the Philosophy of Economics: Theory +Data Confrontation in Economics, pp. 285-217. Princeton University Press, +Princeton, NJ, 2003 +\item Vos P, Holbert D. Frequentist statistical inference without repeated sampling. +Synthese 200, 89 (2022). \doi{10.1007/s11229-022-03560-x} +} +} +\seealso{ +See also \code{\link[=equivalence_test]{equivalence_test()}}, \code{\link[=p_function]{p_function()}} and +\code{\link[=p_significance]{p_significance()}} for functions related to checking effect existence and +significance. +} diff --git a/man/p_function.Rd b/man/p_function.Rd index 0adbccc17..f22d64817 100644 --- a/man/p_function.Rd +++ b/man/p_function.Rd @@ -12,6 +12,8 @@ p_function( exponentiate = FALSE, effects = "fixed", component = "all", + vcov = NULL, + vcov_args = NULL, keep = NULL, drop = NULL, verbose = TRUE, @@ -24,6 +26,8 @@ consonance_function( exponentiate = FALSE, effects = "fixed", component = "all", + vcov = NULL, + vcov_args = NULL, keep = NULL, drop = NULL, verbose = TRUE, @@ -36,6 +40,8 @@ confidence_curve( exponentiate = FALSE, effects = "fixed", component = "all", + vcov = NULL, + vcov_args = NULL, keep = NULL, drop = NULL, verbose = TRUE, @@ -76,6 +82,31 @@ Applies to models with zero-inflation and/or dispersion component. \code{compone may be one of \code{"conditional"}, \code{"zi"}, \code{"zero-inflated"}, \code{"dispersion"} or \code{"all"} (default). May be abbreviated.} +\item{vcov}{Variance-covariance matrix used to compute uncertainty estimates +(e.g., for robust standard errors). This argument accepts a covariance matrix, +a function which returns a covariance matrix, or a string which identifies +the function to be used to compute the covariance matrix. +\itemize{ +\item A covariance matrix +\item A function which returns a covariance matrix (e.g., \code{stats::vcov()}) +\item A string which indicates the kind of uncertainty estimates to return. +\itemize{ +\item Heteroskedasticity-consistent: \code{"vcovHC"}, \code{"HC"}, \code{"HC0"}, \code{"HC1"}, +\code{"HC2"}, \code{"HC3"}, \code{"HC4"}, \code{"HC4m"}, \code{"HC5"}. See \code{?sandwich::vcovHC}. +\item Cluster-robust: \code{"vcovCR"}, \code{"CR0"}, \code{"CR1"}, \code{"CR1p"}, \code{"CR1S"}, +\code{"CR2"}, \code{"CR3"}. See \code{?clubSandwich::vcovCR}. +\item Bootstrap: \code{"vcovBS"}, \code{"xy"}, \code{"residual"}, \code{"wild"}, \code{"mammen"}, +\code{"webb"}. See \code{?sandwich::vcovBS}. +\item Other \code{sandwich} package functions: \code{"vcovHAC"}, \code{"vcovPC"}, \code{"vcovCL"}, +\code{"vcovPL"}. +} +}} + +\item{vcov_args}{List of arguments to be passed to the function identified by +the \code{vcov} argument. This function is typically supplied by the \strong{sandwich} +or \strong{clubSandwich} packages. Please refer to their documentation (e.g., +\code{?sandwich::vcovHAC}) to see the list of available arguments.} + \item{keep}{Character containing a regular expression pattern that describes the parameters that should be included (for \code{keep}) or excluded (for \code{drop}) in the returned data frame. \code{keep} may also be a @@ -177,7 +208,7 @@ of the \emph{p}-value on the assumptions as well as on the data, recognizing tha study is null" (\emph{Gelman/Greenland 2019}). } -\subsection{Probabilistic interpretation of compatibility intervals}{ +\subsection{Probabilistic interpretation of p-values and compatibility intervals}{ Schweder (2018) resp. Schweder and Hjort (2016) (and others) argue that confidence curves (as produced by \code{p_function()}) have a valid probabilistic @@ -208,22 +239,57 @@ distribution is appropriate. "The realized confidence distribution is clearly an epistemic probability distribution" (\emph{Schweder 2018}). In Bayesian words, compatibility intervals (or confidence distributons, or consonance curves) are "posteriors without -priors" (\emph{Schweder, Hjort, 2003}). In this regard, interpretation of \emph{p}-values -might be guided using \code{\link[bayestestR:pd_to_p]{bayestestR::p_to_pd()}}. +priors" (\emph{Schweder, Hjort, 2003}). + +The \emph{p}-value indicates the degree of compatibility of the endpoints of the +interval at a given confidence level with (1) the observed data and (2) model +assumptions. The observed point estimate (\emph{p}-value = 1) is the value +estimated to be \emph{most compatible} with the data and model assumptions, +whereas values values far from the observed point estimate (where \emph{p} +approaches 0) are least compatible with the data and model assumptions +(\emph{Schweder and Hjort 2016, pp. 60-61; Amrhein and Greenland 2022}). In this +regards, \emph{p}-values are statements about \emph{confidence} or \emph{compatibility}: +The p-value is not an absolute measure of evidence for a model (such as the +null/alternative model), it is a continuous measure of the compatibility of +the observed data with the model used to compute it (\emph{Greenland et al. 2016}, +\emph{Greenland 2023}). Going one step further, and following \emph{Schweder}, p-values +can be considered as \emph{epistemic probability} - "not necessarily of the +hypothesis being true, but of it \emph{possibly} being true" (\emph{Schweder 2018}). +Hence, the interpretation of \emph{p}-values might be guided using +\code{\link[bayestestR:pd_to_p]{bayestestR::p_to_pd()}}. +} + +\subsection{Probability or compatibility?}{ + +We here presented the discussion of p-values and confidence intervals from the +perspective of two paradigms, one saying that probability statements can be +made, one saying that interpretation is guided in terms of "compatibility". +Cox and Hinkley say, "interval estimates cannot be taken as probability +statements" (\emph{Cox and Hinkley 1979: 208}), which conflicts with the Schweder +and Hjort confidence distribution school. However, if you view interval +estimates as being intervals of values being consistent with the data, +this comes close to the idea of (epistemic) probability. We do not believe that +these two paradigms contradict or exclude each other. Rather, the aim is to +emphasize one point of view or the other, i.e. to place the linguistic +nuances either on 'compatibility' or 'probability'. + +The main take-away is \emph{not} to interpret p-values as dichotomous decisions +that distinguish between "we found an effect" (statistically significant)" vs. +"we found no effect" (statistically not significant) (\emph{Altman and Bland 1995}). } -\subsection{Compatibility intervals - is their interpretation conditional or not?}{ +\subsection{Compatibility intervals - is their interpretation "conditional" or not?}{ -The fact that the term "conditional" is used in different meanings, is -confusing and unfortunate. Thus, we would summarize the probabilistic -interpretation of compatibility intervals as follows: The intervals are built -from the data \emph{and} our modeling assumptions. The accuracy of the intervals -depends on our model assumptions. If a value is outside the interval, that -might be because (1) that parameter value isn't supported by the data, or -(2) the modeling assumptions are a poor fit for the situation. When we make -bad assumptions, the compatibility interval might be too wide or (more -commonly and seriously) too narrow, making us think we know more about the -parameter than is warranted. +The fact that the term "conditional" is used in different meanings in +statistics, is confusing and unfortunate. Thus, we would summarize the +(probabilistic) interpretation of compatibility intervals as follows: The +intervals are built from the data \emph{and} our modeling assumptions. The +accuracy of the intervals depends on our model assumptions. If a value is +outside the interval, that might be because (1) that parameter value isn't +supported by the data, or (2) the modeling assumptions are a poor fit for the +situation. When we make bad assumptions, the compatibility interval might be +too wide or (more commonly and seriously) too narrow, making us think we know +more about the parameter than is warranted. When we say "there is a 95\% chance the true value is in the interval", that is a statement of \emph{epistemic probability} (i.e. description of uncertainty related @@ -233,6 +299,31 @@ Frequentist inference is built on defining estimators with known \emph{aleatoric probability properties, from which we can draw \emph{epistemic} probabilistic statements of uncertainty (\emph{Schweder and Hjort 2016}). } + +\subsection{Functions in the parameters package to check for effect existence and significance}{ + +The \strong{parameters} package provides several options or functions to aid +statistical inference. Beyond \code{p_function()}, there are, for example: +\itemize{ +\item \code{\link[=equivalence_test.lm]{equivalence_test()}}, to compute the (conditional) +equivalence test for frequentist models +\item \code{\link[=p_significance.lm]{p_significance()}}, to compute the probability of +\emph{practical significance}, which can be conceptualized as a unidirectional +equivalence test +\item the \code{pd} argument (setting \code{pd = TRUE}) in \code{model_parameters()} includes +a column with the \emph{probability of direction}, i.e. the probability that a +parameter is strictly positive or negative. See \code{\link[bayestestR:p_direction]{bayestestR::p_direction()}} +for details. If plotting is desired, the \code{\link[=p_direction.lm]{p_direction()}} +function can be used, together with \code{plot()}. +\item the \code{s_value} argument (setting \code{s_value = TRUE}) in \code{model_parameters()} +replaces the p-values with their related \emph{S}-values (\emph{Rafi and Greenland 2020}) +\item finally, it is possible to generate distributions of model coefficients by +generating bootstrap-samples (setting \code{bootstrap = TRUE}) or simulating +draws from model coefficients using \code{\link[=simulate_model]{simulate_model()}}. These samples +can then be treated as "posterior samples" and used in many functions from +the \strong{bayestestR} package. +} +} } \note{ Curently, \code{p_function()} computes intervals based on Wald t- or z-statistic. @@ -256,10 +347,14 @@ plot(result) } \references{ \itemize{ +\item Altman DG, Bland JM. Absence of evidence is not evidence of absence. BMJ. +1995;311(7003):485. \doi{10.1136/bmj.311.7003.485} \item Amrhein V, Greenland S. Discuss practical importance of results based on interval estimates and p-value functions, not only on point estimates and null p-values. Journal of Information Technology 2022;37:316–20. \doi{10.1177/02683962221105904} +\item Cox DR, Hinkley DV. 1979. Theoretical Statistics. 6th edition. +Chapman and Hall/CRC \item Fraser DAS. The P-value function and statistical inference. The American Statistician. 2019;73(sup1):135-147. \doi{10.1080/00031305.2018.1556735} \item Gelman A, Greenland S. Are confidence intervals better termed "uncertainty @@ -267,6 +362,14 @@ intervals"? BMJ (2019)l5381. \doi{10.1136/bmj.l5381} \item Greenland S, Rafi Z, Matthews R, Higgs M. To Aid Scientific Inference, Emphasize Unconditional Compatibility Descriptions of Statistics. (2022) https://arxiv.org/abs/1909.08583v7 (Accessed November 10, 2022) +\item Greenland S, Senn SJ, Rothman KJ, Carlin JB, Poole C, Goodman SN, et al. +(2016). Statistical tests, P values, confidence intervals, and power: A +guide to misinterpretations. European Journal of Epidemiology. 31:337-350. +\doi{10.1007/s10654-016-0149-3} +\item Greenland S (2023). Divergence versus decision P-values: A distinction +worth making in theory and keeping in practice: Or, how divergence P-values +measure evidence even when decision P-values do not. Scand J Statist, 50(1), +54-88. \doi{doi.org/10.1111/sjos.12625} \item Rafi Z, Greenland S. Semantic and cognitive tools to aid statistical science: Replace confidence and significance by compatibility and surprise. BMC Medical Research Methodology. 2020;20(1):244. \doi{10.1186/s12874-020-01105-9} @@ -285,3 +388,7 @@ inference with confidence distributions. Cambridge University Press, 2016. Synthese 200, 89 (2022). \doi{10.1007/s11229-022-03560-x} } } +\seealso{ +See also \code{\link[=equivalence_test]{equivalence_test()}} and \code{\link[=p_significance]{p_significance()}} for +functions related to checking effect existence and significance. +} diff --git a/man/p_significance.lm.Rd b/man/p_significance.lm.Rd new file mode 100644 index 000000000..e4858e775 --- /dev/null +++ b/man/p_significance.lm.Rd @@ -0,0 +1,247 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/p_significance.R +\name{p_significance.lm} +\alias{p_significance.lm} +\title{Practical Significance (ps)} +\usage{ +\method{p_significance}{lm}( + x, + threshold = "default", + ci = 0.95, + vcov = NULL, + vcov_args = NULL, + verbose = TRUE, + ... +) +} +\arguments{ +\item{x}{A statistical model.} + +\item{threshold}{The threshold value that separates significant from +negligible effect, which can have following possible values: +\itemize{ +\item \code{"default"}, in which case the range is set to \code{0.1} if input is a vector, +and based on \code{\link[bayestestR:rope_range]{rope_range()}} if a (Bayesian) model is provided. +\item a single numeric value (e.g., 0.1), which is used as range around zero +(i.e. the threshold range is set to -0.1 and 0.1, i.e. reflects a symmetric +interval) +\item a numeric vector of length two (e.g., \code{c(-0.2, 0.1)}), useful for +asymmetric intervals +\item a list of numeric vectors, where each vector corresponds to a parameter +\item a list of \emph{named} numeric vectors, where names correspond to parameter +names. In this case, all parameters that have no matching name in \code{threshold} +will be set to \code{"default"}. +}} + +\item{ci}{Confidence Interval (CI) level. Default to \code{0.95} (\verb{95\%}).} + +\item{vcov}{Variance-covariance matrix used to compute uncertainty estimates +(e.g., for robust standard errors). This argument accepts a covariance matrix, +a function which returns a covariance matrix, or a string which identifies +the function to be used to compute the covariance matrix. +\itemize{ +\item A covariance matrix +\item A function which returns a covariance matrix (e.g., \code{stats::vcov()}) +\item A string which indicates the kind of uncertainty estimates to return. +\itemize{ +\item Heteroskedasticity-consistent: \code{"vcovHC"}, \code{"HC"}, \code{"HC0"}, \code{"HC1"}, +\code{"HC2"}, \code{"HC3"}, \code{"HC4"}, \code{"HC4m"}, \code{"HC5"}. See \code{?sandwich::vcovHC}. +\item Cluster-robust: \code{"vcovCR"}, \code{"CR0"}, \code{"CR1"}, \code{"CR1p"}, \code{"CR1S"}, +\code{"CR2"}, \code{"CR3"}. See \code{?clubSandwich::vcovCR}. +\item Bootstrap: \code{"vcovBS"}, \code{"xy"}, \code{"residual"}, \code{"wild"}, \code{"mammen"}, +\code{"webb"}. See \code{?sandwich::vcovBS}. +\item Other \code{sandwich} package functions: \code{"vcovHAC"}, \code{"vcovPC"}, \code{"vcovCL"}, +\code{"vcovPL"}. +} +}} + +\item{vcov_args}{List of arguments to be passed to the function identified by +the \code{vcov} argument. This function is typically supplied by the \strong{sandwich} +or \strong{clubSandwich} packages. Please refer to their documentation (e.g., +\code{?sandwich::vcovHAC}) to see the list of available arguments.} + +\item{verbose}{Toggle warnings and messages.} + +\item{...}{Arguments passed to other methods.} +} +\value{ +A data frame with columns for the parameter names, the confidence +intervals and the values for practical significance. Higher values indicate +more practical significance (upper bound is one). +} +\description{ +Compute the probability of \strong{Practical Significance} (\emph{ps}), +which can be conceptualized as a unidirectional equivalence test. It returns +the probability that an effect is above a given threshold corresponding to a +negligible effect in the median's direction, considering a parameter's \emph{full} +confidence interval. In other words, it returns the probability of a clear +direction of an effect, which is larger than the smallest effect size of +interest (e.g., a minimal important difference). Its theoretical range is +from zero to one, but the \emph{ps} is typically larger than 0.5 (to indicate +practical significance). + +In comparison the the \code{\link[=equivalence_test]{equivalence_test()}} function, where the \emph{SGPV} +(second generation p-value) describes the proportion of the \emph{full} confidence +interval that is \emph{inside} the ROPE, the value returned by \code{p_significance()} +describes the \emph{larger} proportion of the \emph{full} confidence interval that is +\emph{outside} the ROPE. This makes \code{p_significance()} comparable to +\code{\link[bayestestR:p_direction]{bayestestR::p_direction()}}, however, while \code{p_direction()} compares to a +point-null by default, \code{p_significance()} compares to a range-null. +} +\details{ +\code{p_significance()} returns the proportion of the \emph{full} confidence +interval range (assuming a normally or t-distributed, equal-tailed interval, +based on the model) that is outside a certain range (the negligible effect, +or ROPE, see argument \code{threshold}). If there are values of the distribution +both below and above the ROPE, \code{p_significance()} returns the higher +probability of a value being outside the ROPE. Typically, this value should +be larger than 0.5 to indicate practical significance. However, if the range +of the negligible effect is rather large compared to the range of the +confidence interval, \code{p_significance()} will be less than 0.5, which +indicates no clear practical significance. + +Note that the assumed interval, which is used to calculate the practical +significance, is an estimation of the \emph{full interval} based on the chosen +confidence level. For example, if the 95\% confidence interval of a +coefficient ranges from -1 to 1, the underlying \emph{full (normally or +t-distributed) interval} approximately ranges from -1.9 to 1.9, see also +following code: + +\if{html}{\out{
}}\preformatted{# simulate full normal distribution +out <- bayestestR::distribution_normal(10000, 0, 0.5) +# range of "full" distribution +range(out) +# range of 95\% CI +round(quantile(out, probs = c(0.025, 0.975)), 2) +}\if{html}{\out{
}} + +This ensures that the practical significance always refers to the general +compatible parameter space of coefficients. Therefore, the \emph{full interval} is +similar to a Bayesian posterior distribution of an equivalent Bayesian model, +see following code: + +\if{html}{\out{
}}\preformatted{library(bayestestR) +library(brms) +m <- lm(mpg ~ gear + wt + cyl + hp, data = mtcars) +m2 <- brm(mpg ~ gear + wt + cyl + hp, data = mtcars) +# probability of significance (ps) for frequentist model +p_significance(m) +# similar to ps of Bayesian models +p_significance(m2) +# similar to ps of simulated draws / bootstrap samples +p_significance(simulate_model(m)) +}\if{html}{\out{
}} +} +\note{ +There is also a \href{https://easystats.github.io/see/articles/bayestestR.html}{\code{plot()}-method} +implemented in the \href{https://easystats.github.io/see/}{\strong{see}-package}. +} +\section{Statistical inference - how to quantify evidence}{ + +There is no standardized approach to drawing conclusions based on the +available data and statistical models. A frequently chosen but also much +criticized approach is to evaluate results based on their statistical +significance (\emph{Amrhein et al. 2017}). + +A more sophisticated way would be to test whether estimated effects exceed +the "smallest effect size of interest", to avoid even the smallest effects +being considered relevant simply because they are statistically significant, +but clinically or practically irrelevant (\emph{Lakens et al. 2018, Lakens 2024}). + +A rather unconventional approach, which is nevertheless advocated by various +authors, is to interpret results from classical regression models either in +terms of probabilities, similar to the usual approach in Bayesian statistics +(\emph{Schweder 2018; Schweder and Hjort 2003; Vos 2022}) or in terms of relative +measure of "evidence" or "compatibility" with the data (\emph{Greenland et al. 2022; +Rafi and Greenland 2020}), which nevertheless comes close to a probabilistic +interpretation. + +A more detailed discussion of this topic is found in the documentation of +\code{\link[=p_function]{p_function()}}. + +The \strong{parameters} package provides several options or functions to aid +statistical inference. These are, for example: +\itemize{ +\item \code{\link[=equivalence_test.lm]{equivalence_test()}}, to compute the (conditional) +equivalence test for frequentist models +\item \code{\link[=p_significance.lm]{p_significance()}}, to compute the probability of +\emph{practical significance}, which can be conceptualized as a unidirectional +equivalence test +\item \code{\link[=p_function]{p_function()}}, or \emph{consonance function}, to compute p-values and +compatibility (confidence) intervals for statistical models +\item the \code{pd} argument (setting \code{pd = TRUE}) in \code{model_parameters()} includes +a column with the \emph{probability of direction}, i.e. the probability that a +parameter is strictly positive or negative. See \code{\link[bayestestR:p_direction]{bayestestR::p_direction()}} +for details. If plotting is desired, the \code{\link[=p_direction.lm]{p_direction()}} +function can be used, together with \code{plot()}. +\item the \code{s_value} argument (setting \code{s_value = TRUE}) in \code{model_parameters()} +replaces the p-values with their related \emph{S}-values (\emph{Rafi and Greenland 2020}) +\item finally, it is possible to generate distributions of model coefficients by +generating bootstrap-samples (setting \code{bootstrap = TRUE}) or simulating +draws from model coefficients using \code{\link[=simulate_model]{simulate_model()}}. These samples +can then be treated as "posterior samples" and used in many functions from +the \strong{bayestestR} package. +} + +Most of the above shown options or functions derive from methods originally +implemented for Bayesian models (\emph{Makowski et al. 2019}). However, assuming +that model assumptions are met (which means, the model fits well to the data, +the correct model is chosen that reflects the data generating process +(distributional model family) etc.), it seems appropriate to interpret +results from classical frequentist models in a "Bayesian way" (more details: +documentation in \code{\link[=p_function]{p_function()}}). +} + +\examples{ +\dontshow{if (requireNamespace("bayestestR") && packageVersion("bayestestR") > "0.14.0" && requireNamespace("sandwich")) (if (getRversion() >= "3.4") withAutoprint else force)(\{ # examplesIf} +data(qol_cancer) +model <- lm(QoL ~ time + age + education, data = qol_cancer) + +p_significance(model) +p_significance(model, threshold = c(-0.5, 1.5)) + +# based on heteroscedasticity-robust standard errors +p_significance(model, vcov = "HC3") + +if (require("see", quietly = TRUE)) { + result <- p_significance(model) + plot(result) +} +\dontshow{\}) # examplesIf} +} +\references{ +\itemize{ +\item Amrhein, V., Korner-Nievergelt, F., and Roth, T. (2017). The earth is +flat (p > 0.05): Significance thresholds and the crisis of unreplicable +research. PeerJ, 5, e3544. \doi{10.7717/peerj.3544} +\item Greenland S, Rafi Z, Matthews R, Higgs M. To Aid Scientific Inference, +Emphasize Unconditional Compatibility Descriptions of Statistics. (2022) +https://arxiv.org/abs/1909.08583v7 (Accessed November 10, 2022) +\item Lakens, D. (2024). Improving Your Statistical Inferences (Version v1.5.1). +Retrieved from https://lakens.github.io/statistical_inferences/. +\doi{10.5281/ZENODO.6409077} +\item Lakens, D., Scheel, A. M., and Isager, P. M. (2018). Equivalence Testing +for Psychological Research: A Tutorial. Advances in Methods and Practices +in Psychological Science, 1(2), 259–269. \doi{10.1177/2515245918770963} +\item Makowski, D., Ben-Shachar, M. S., Chen, S. H. A., and Lüdecke, D. (2019). +Indices of Effect Existence and Significance in the Bayesian Framework. +Frontiers in Psychology, 10, 2767. \doi{10.3389/fpsyg.2019.02767} +\item Rafi Z, Greenland S. Semantic and cognitive tools to aid statistical +science: replace confidence and significance by compatibility and surprise. +BMC Medical Research Methodology (2020) 20:244. +\item Schweder T. Confidence is epistemic probability for empirical science. +Journal of Statistical Planning and Inference (2018) 195:116–125. +\doi{10.1016/j.jspi.2017.09.016} +\item Schweder T, Hjort NL. Frequentist analogues of priors and posteriors. +In Stigum, B. (ed.), Econometrics and the Philosophy of Economics: Theory +Data Confrontation in Economics, pp. 285-217. Princeton University Press, +Princeton, NJ, 2003 +\item Vos P, Holbert D. Frequentist statistical inference without repeated sampling. +Synthese 200, 89 (2022). \doi{10.1007/s11229-022-03560-x} +} +} +\seealso{ +For more details, see \code{\link[bayestestR:p_significance]{bayestestR::p_significance()}}. See also +\code{\link[=equivalence_test]{equivalence_test()}}, \code{\link[=p_function]{p_function()}} and \code{\link[bayestestR:p_direction]{bayestestR::p_direction()}} +for functions related to checking effect existence and significance. +} diff --git a/man/p_value.Rd b/man/p_value.Rd index 9797e389f..d49b0390b 100644 --- a/man/p_value.Rd +++ b/man/p_value.Rd @@ -28,10 +28,9 @@ p_value(model, ...) \item{dof}{Number of degrees of freedom to be used when calculating confidence intervals. If \code{NULL} (default), the degrees of freedom are -retrieved by calling \code{\link[=degrees_of_freedom]{degrees_of_freedom()}} with -approximation method defined in \code{method}. If not \code{NULL}, use this argument -to override the default degrees of freedom used to compute confidence -intervals.} +retrieved by calling \code{\link[insight:get_df]{insight::get_df()}} with approximation method +defined in \code{method}. If not \code{NULL}, use this argument to override the +default degrees of freedom used to compute confidence intervals.} \item{method}{Method for computing degrees of freedom for confidence intervals (CI) and the related p-values. Allowed are following @@ -57,11 +56,12 @@ the function to be used to compute the covariance matrix. \itemize{ \item Heteroskedasticity-consistent: \code{"vcovHC"}, \code{"HC"}, \code{"HC0"}, \code{"HC1"}, \code{"HC2"}, \code{"HC3"}, \code{"HC4"}, \code{"HC4m"}, \code{"HC5"}. See \code{?sandwich::vcovHC}. -\item Cluster-robust: \code{"vcovCR"}, \code{"CR0"}, \code{"CR1"}, \code{"CR1p"}, \code{"CR1S"}, \code{"CR2"}, -\code{"CR3"}. See \code{?clubSandwich::vcovCR}. -\item Bootstrap: \code{"vcovBS"}, \code{"xy"}, \code{"residual"}, \code{"wild"}, \code{"mammen"}, \code{"webb"}. -See \code{?sandwich::vcovBS}. -\item Other \code{sandwich} package functions: \code{"vcovHAC"}, \code{"vcovPC"}, \code{"vcovCL"}, \code{"vcovPL"}. +\item Cluster-robust: \code{"vcovCR"}, \code{"CR0"}, \code{"CR1"}, \code{"CR1p"}, \code{"CR1S"}, +\code{"CR2"}, \code{"CR3"}. See \code{?clubSandwich::vcovCR}. +\item Bootstrap: \code{"vcovBS"}, \code{"xy"}, \code{"residual"}, \code{"wild"}, \code{"mammen"}, +\code{"webb"}. See \code{?sandwich::vcovBS}. +\item Other \code{sandwich} package functions: \code{"vcovHAC"}, \code{"vcovPC"}, \code{"vcovCL"}, +\code{"vcovPL"}. } }} diff --git a/man/p_value_betwithin.Rd b/man/p_value_betwithin.Rd index 17d814646..9f2c7069d 100644 --- a/man/p_value_betwithin.Rd +++ b/man/p_value_betwithin.Rd @@ -18,7 +18,10 @@ p_value_betwithin(model, dof = NULL, ...) \item{ci}{Confidence Interval (CI) level. Default to \code{0.95} (\verb{95\%}).} -\item{...}{Additional arguments} +\item{...}{Additional arguments passed down to the underlying functions. +E.g., arguments like \code{vcov} or \code{vcov_args} can be used to compute confidence +intervals using a specific variance-covariance matrix for the standard +errors.} \item{dof}{Degrees of Freedom.} } diff --git a/man/p_value_ml1.Rd b/man/p_value_ml1.Rd index 0fb9229f6..c272fe8d9 100644 --- a/man/p_value_ml1.Rd +++ b/man/p_value_ml1.Rd @@ -17,7 +17,10 @@ p_value_ml1(model, dof = NULL, ...) \item{ci}{Confidence Interval (CI) level. Default to \code{0.95} (\verb{95\%}).} -\item{...}{Additional arguments} +\item{...}{Additional arguments passed down to the underlying functions. +E.g., arguments like \code{vcov} or \code{vcov_args} can be used to compute confidence +intervals using a specific variance-covariance matrix for the standard +errors.} \item{dof}{Degrees of Freedom.} } diff --git a/man/p_value_satterthwaite.Rd b/man/p_value_satterthwaite.Rd index 5ac41192c..ebe3586b3 100644 --- a/man/p_value_satterthwaite.Rd +++ b/man/p_value_satterthwaite.Rd @@ -21,7 +21,10 @@ se_satterthwaite(model) \item{ci}{Confidence Interval (CI) level. Default to \code{0.95} (\verb{95\%}).} -\item{...}{Additional arguments} +\item{...}{Additional arguments passed down to the underlying functions. +E.g., arguments like \code{vcov} or \code{vcov_args} can be used to compute confidence +intervals using a specific variance-covariance matrix for the standard +errors.} \item{dof}{Degrees of Freedom.} } diff --git a/man/parameters-package.Rd b/man/parameters-package.Rd index ab8407b4f..b4e466b2c 100644 --- a/man/parameters-package.Rd +++ b/man/parameters-package.Rd @@ -32,25 +32,25 @@ Useful links: } \author{ -\strong{Maintainer}: Daniel Lüdecke \email{d.luedecke@uke.de} (\href{https://orcid.org/0000-0002-8895-3206}{ORCID}) (@strengejacke) +\strong{Maintainer}: Daniel Lüdecke \email{d.luedecke@uke.de} (\href{https://orcid.org/0000-0002-8895-3206}{ORCID}) Authors: \itemize{ - \item Dominique Makowski \email{dom.makowski@gmail.com} (\href{https://orcid.org/0000-0001-5375-9967}{ORCID}) (@Dom_Makowski) + \item Dominique Makowski \email{dom.makowski@gmail.com} (\href{https://orcid.org/0000-0001-5375-9967}{ORCID}) \item Mattan S. Ben-Shachar \email{matanshm@post.bgu.ac.il} (\href{https://orcid.org/0000-0002-4287-4801}{ORCID}) - \item Indrajeet Patil \email{patilindrajeet.science@gmail.com} (\href{https://orcid.org/0000-0003-1995-6531}{ORCID}) (@patilindrajeets) + \item Indrajeet Patil \email{patilindrajeet.science@gmail.com} (\href{https://orcid.org/0000-0003-1995-6531}{ORCID}) \item Søren Højsgaard \email{sorenh@math.aau.dk} - \item Brenton M. Wiernik \email{brenton@wiernik.org} (\href{https://orcid.org/0000-0001-9560-6336}{ORCID}) (@bmwiernik) + \item Brenton M. Wiernik \email{brenton@wiernik.org} (\href{https://orcid.org/0000-0001-9560-6336}{ORCID}) } Other contributors: \itemize{ \item Zen J. Lau \email{zenjuen.lau@ntu.edu.sg} [contributor] - \item Vincent Arel-Bundock \email{vincent.arel-bundock@umontreal.ca} (\href{https://orcid.org/0000-0003-1995-6531}{ORCID}) (@vincentab) [contributor] - \item Jeffrey Girard \email{me@jmgirard.com} (\href{https://orcid.org/0000-0002-7359-3746}{ORCID}) (@jeffreymgirard) [contributor] + \item Vincent Arel-Bundock \email{vincent.arel-bundock@umontreal.ca} (\href{https://orcid.org/0000-0003-2042-7063}{ORCID}) [contributor] + \item Jeffrey Girard \email{me@jmgirard.com} (\href{https://orcid.org/0000-0002-7359-3746}{ORCID}) [contributor] \item Christina Maimone \email{christina.maimone@northwestern.edu} [reviewer] \item Niels Ohlsen (@Niels_Bremen) [reviewer] - \item Douglas Ezra Morrison \email{dmorrison01@ucla.edu} (\href{https://orcid.org/0000-0002-7195-830X}{ORCID}) (@demstats1) [contributor] + \item Douglas Ezra Morrison \email{dmorrison01@ucla.edu} (\href{https://orcid.org/0000-0002-7195-830X}{ORCID}) [contributor] \item Joseph Luchman \email{jluchman@gmail.com} (\href{https://orcid.org/0000-0002-8886-9717}{ORCID}) [contributor] } diff --git a/man/pool_parameters.Rd b/man/pool_parameters.Rd index d677cd968..6b02889b0 100644 --- a/man/pool_parameters.Rd +++ b/man/pool_parameters.Rd @@ -8,7 +8,7 @@ pool_parameters( x, exponentiate = FALSE, effects = "fixed", - component = "conditional", + component = "all", verbose = TRUE, ... ) @@ -64,12 +64,10 @@ small samples (\emph{Barnard and Rubin, 1999}). } \note{ Models with multiple components, (for instance, models with zero-inflation, -where predictors appear in the count and zero-inflation part) may fail in -case of identical names for coefficients in the different model components, -since the coefficient table is grouped by coefficient names for pooling. In -such cases, coefficients of count and zero-inflation model parts would be -combined. Therefore, the \code{component} argument defaults to -\code{"conditional"} to avoid this. +where predictors appear in the count and zero-inflation part, or models with +dispersion component) may fail in rare situations. In this case, compute +the pooled parameters for components separately, using the \code{component} +argument. Some model objects do not return standard errors (e.g. objects of class \code{htest}). For these models, no pooled confidence intervals nor p-values diff --git a/man/principal_components.Rd b/man/principal_components.Rd index c0a644356..d851baa0c 100644 --- a/man/principal_components.Rd +++ b/man/principal_components.Rd @@ -106,7 +106,11 @@ frame.} with missing values from the original data, hence the number of rows of predicted data and original data is equal.} -\item{digits, labels}{Arguments for \code{print()}.} +\item{digits}{Argument for \code{print()}, indicates the number of digits +(rounding) to be used.} + +\item{labels}{Argument for \code{print()}, character vector of same length as +columns in \code{x}. If provided, adds an additional column with the labels.} } \value{ A data frame of loadings. @@ -220,6 +224,17 @@ principal_components(mtcars[, 1:7], n = "all", threshold = 0.2) # Automated number of components principal_components(mtcars[, 1:4], n = "auto") +# labels can be useful if variable names are not self-explanatory +print( + principal_components(mtcars[, 1:4], n = "auto"), + labels = c( + "Miles/(US) gallon", + "Number of cylinders", + "Displacement (cu.in.)", + "Gross horsepower" + ) +) + # Sparse PCA principal_components(mtcars[, 1:7], n = 4, sparse = TRUE) principal_components(mtcars[, 1:7], n = 4, sparse = "robust") diff --git a/man/print.compare_parameters.Rd b/man/print.compare_parameters.Rd new file mode 100644 index 000000000..d74c26307 --- /dev/null +++ b/man/print.compare_parameters.Rd @@ -0,0 +1,268 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/format.R, R/print.compare_parameters.R, +% R/print_html.R, R/print_md.R +\name{format.compare_parameters} +\alias{format.compare_parameters} +\alias{print.compare_parameters} +\alias{print_html.compare_parameters} +\alias{print_md.compare_parameters} +\title{Print comparisons of model parameters} +\usage{ +\method{format}{compare_parameters}( + x, + split_components = TRUE, + select = NULL, + digits = 2, + ci_digits = digits, + p_digits = 3, + ci_width = NULL, + ci_brackets = NULL, + zap_small = FALSE, + format = NULL, + groups = NULL, + engine = NULL, + ... +) + +\method{print}{compare_parameters}( + x, + split_components = TRUE, + caption = NULL, + subtitle = NULL, + footer = NULL, + digits = 2, + ci_digits = digits, + p_digits = 3, + zap_small = FALSE, + groups = NULL, + column_width = NULL, + ci_brackets = c("(", ")"), + select = NULL, + ... +) + +\method{print_html}{compare_parameters}( + x, + caption = NULL, + subtitle = NULL, + footer = NULL, + digits = 2, + ci_digits = digits, + p_digits = 3, + zap_small = FALSE, + groups = NULL, + select = NULL, + ci_brackets = c("(", ")"), + font_size = "100\%", + line_padding = 4, + column_labels = NULL, + engine = "gt", + ... +) + +\method{print_md}{compare_parameters}( + x, + digits = 2, + ci_digits = digits, + p_digits = 3, + caption = NULL, + subtitle = NULL, + footer = NULL, + select = NULL, + split_components = TRUE, + ci_brackets = c("(", ")"), + zap_small = FALSE, + groups = NULL, + engine = "tt", + ... +) +} +\arguments{ +\item{x}{An object returned by \code{\link[=compare_parameters]{compare_parameters()}}.} + +\item{split_components}{Logical, if \code{TRUE} (default), For models with +multiple components (zero-inflation, smooth terms, ...), each component is +printed in a separate table. If \code{FALSE}, model parameters are printed +in a single table and a \code{Component} column is added to the output.} + +\item{select}{Determines which columns and and which layout columns are +printed. There are three options for this argument: +\enumerate{ +\item Selecting columns by name or index +\cr +\code{select} can be a character vector (or numeric index) of column names that +should be printed. There are two pre-defined options for selecting columns: +\code{select = "minimal"} prints coefficients, confidence intervals and p-values, +while \code{select = "short"} prints coefficients, standard errors and p-values. +\item A string expression with layout pattern +\cr +\code{select} is a string with "tokens" enclosed in braces. These tokens will +be replaced by their associated columns, where the selected columns will +be collapsed into one column. However, it is possible to create multiple +columns as well. Following tokens are replaced by the related coefficients +or statistics: \code{{estimate}}, \code{{se}}, \code{{ci}} (or \code{{ci_low}} and \code{{ci_high}}), +\code{{p}} and \code{{stars}}. The token \code{{ci}} will be replaced by \verb{\{ci_low\}, \{ci_high\}}. +Furthermore, a \code{|} separates values into new cells/columns. If +\code{format = "html"}, a \verb{
} inserts a line break inside a cell. See +'Examples'. +\item A string indicating a pre-defined layout +\cr +\code{select} can be one of the following string values, to create one of the +following pre-defined column layouts: +\itemize{ +\item \code{"ci"}: Estimates and confidence intervals, no asterisks for p-values. +This is equivalent to \code{select = "{estimate} ({ci})"}. +\item \code{"se"}: Estimates and standard errors, no asterisks for p-values. This is +equivalent to \code{select = "{estimate} ({se})"}. +\item \code{"ci_p"}: Estimates, confidence intervals and asterisks for p-values. This +is equivalent to \code{select = "{estimate}{stars} ({ci})"}. +\item \code{"se_p"}: Estimates, standard errors and asterisks for p-values. This is +equivalent to \code{select = "{estimate}{stars} ({se})"}.. +\item \code{"ci_p2"}: Estimates, confidence intervals and numeric p-values, in two +columns. This is equivalent to \code{select = "{estimate} ({ci})|{p}"}. +\item \code{"se_p2"}: Estimate, standard errors and numeric p-values, in two columns. +This is equivalent to \code{select = "{estimate} ({se})|{p}"}. +} +} + +For \code{model_parameters()}, glue-like syntax is still experimental in the +case of more complex models (like mixed models) and may not return expected +results.} + +\item{digits, ci_digits, p_digits}{Number of digits for rounding or +significant figures. May also be \code{"signif"} to return significant +figures or \code{"scientific"} to return scientific notation. Control the +number of digits by adding the value as suffix, e.g. \code{digits = "scientific4"} +to have scientific notation with 4 decimal places, or \code{digits = "signif5"} +for 5 significant figures (see also \code{\link[=signif]{signif()}}).} + +\item{ci_width}{Minimum width of the returned string for confidence +intervals. If not \code{NULL} and width is larger than the string's length, +leading whitespaces are added to the string. If \code{width="auto"}, width +will be set to the length of the longest string.} + +\item{ci_brackets}{Logical, if \code{TRUE} (default), CI-values are +encompassed in square brackets (else in parentheses).} + +\item{zap_small}{Logical, if \code{TRUE}, small values are rounded after +\code{digits} decimal places. If \code{FALSE}, values with more decimal +places than \code{digits} are printed in scientific notation.} + +\item{format}{String, indicating the output format. Can be \code{"markdown"} +or \code{"html"}.} + +\item{groups}{Named list, can be used to group parameters in the printed output. +List elements may either be character vectors that match the name of those +parameters that belong to one group, or list elements can be row numbers +of those parameter rows that should belong to one group. The names of the +list elements will be used as group names, which will be inserted as "header +row". A possible use case might be to emphasize focal predictors and control +variables, see 'Examples'. Parameters will be re-ordered according to the +order used in \code{groups}, while all non-matching parameters will be added +to the end.} + +\item{engine}{Character string, naming the package or engine to be used for +printing into HTML or markdown format. Currently supported \code{"gt"} (or +\code{"default"}) to use the \emph{gt} package to print to HTML and the default easystats +engine to create markdown tables. If \code{engine = "tt"}, the \emph{tinytable} package +is used for printing to HTML or markdown. Not all \code{print()} methods support +the \code{"tt"} engine yet. If a specific \code{print()} method has no \code{engine} argument, +\code{insight::export_table()} is used, which uses \emph{gt} for HTML printing.} + +\item{...}{Arguments passed down to \code{\link[=format.parameters_model]{format.parameters_model()}}, +\code{\link[insight:format_table]{insight::format_table()}} and \code{\link[insight:export_table]{insight::export_table()}}} + +\item{caption}{Table caption as string. If \code{NULL}, depending on the model, +either a default caption or no table caption is printed. Use \code{caption = ""} +to suppress the table caption.} + +\item{subtitle}{Table title (same as caption) and subtitle, as strings. If \code{NULL}, +no title or subtitle is printed, unless it is stored as attributes (\code{table_title}, +or its alias \code{table_caption}, and \code{table_subtitle}). If \code{x} is a list of +data frames, \code{caption} may be a list of table captions, one for each table.} + +\item{footer}{Can either be \code{FALSE} or an empty string (i.e. \code{""}) to +suppress the footer, \code{NULL} to print the default footer, or a string. The +latter will combine the string value with the default footer.} + +\item{column_width}{Width of table columns. Can be either \code{NULL}, a named +numeric vector, or \code{"fixed"}. If \code{NULL}, the width for each table column is +adjusted to the minimum required width. If a named numeric vector, value +names are matched against column names, and for each match, the specified +width is used. If \code{"fixed"}, and table is split into multiple components, +columns across all table components are adjusted to have the same width.} + +\item{font_size}{For HTML tables, the font size.} + +\item{line_padding}{For HTML tables, the distance (in pixel) between lines.} + +\item{column_labels}{Labels of columns for HTML tables. If \code{NULL}, automatic +column names are generated. See 'Examples'.} +} +\value{ +Invisibly returns the original input object. +} +\description{ +A \code{print()}-method for objects from \code{\link[=compare_parameters]{compare_parameters()}}. +} +\section{Global Options to Customize Messages and Tables when Printing}{ + +The \code{verbose} argument can be used to display or silence messages and +warnings for the different functions in the \strong{parameters} package. However, +some messages providing additional information can be displayed or suppressed +using \code{options()}: +\itemize{ +\item \code{parameters_info}: \code{options(parameters_info = TRUE)} will override the +\code{include_info} argument in \code{model_parameters()} and always show the model +summary for non-mixed models. +\item \code{parameters_mixed_info}: \code{options(parameters_mixed_info = TRUE)} will +override the \code{include_info} argument in \code{model_parameters()} for mixed +models, and will then always show the model summary. +\item \code{parameters_cimethod}: \code{options(parameters_cimethod = TRUE)} will show the +additional information about the approximation method used to calculate +confidence intervals and p-values. Set to \code{FALSE} to hide this message when +printing \code{model_parameters()} objects. +\item \code{parameters_exponentiate}: \code{options(parameters_exponentiate = TRUE)} will +show the additional information on how to interpret coefficients of models +with log-transformed response variables or with log-/logit-links when the +\code{exponentiate} argument in \code{model_parameters()} is not \code{TRUE}. Set this option +to \code{FALSE} to hide this message when printing \code{model_parameters()} objects. +} + +There are further options that can be used to modify the default behaviour +for printed outputs: +\itemize{ +\item \code{parameters_labels}: \code{options(parameters_labels = TRUE)} will use variable +and value labels for pretty names, if data is labelled. If no labels +available, default pretty names are used. +\item \code{parameters_interaction}: \verb{options(parameters_interaction = )} +will replace the interaction mark (by default, \code{*}) with the related character. +\item \code{parameters_select}: \verb{options(parameters_select = )} will set the +default for the \code{select} argument. See argument's documentation for available +options. +\item \code{easystats_html_engine}: \code{options(easystats_html_engine = "gt")} will set +the default HTML engine for tables to \code{gt}, i.e. the \emph{gt} package is used to +create HTML tables. If set to \code{tt}, the \emph{tinytable} package is used. +\item \code{insight_use_symbols}: \code{options(insight_use_symbols = TRUE)} will try to +print unicode-chars for symbols as column names, wherever possible (e.g., +\ifelse{html}{\out{ω}}{\eqn{\omega}} instead of \code{Omega}). +} +} + +\examples{ +\dontshow{if (require("gt", quietly = TRUE)) (if (getRversion() >= "3.4") withAutoprint else force)(\{ # examplesIf} +\donttest{ +data(iris) +lm1 <- lm(Sepal.Length ~ Species, data = iris) +lm2 <- lm(Sepal.Length ~ Species + Petal.Length, data = iris) + +# custom style +result <- compare_parameters(lm1, lm2, select = "{estimate}{stars} ({se})") +print(result) + +# custom style, in HTML +result <- compare_parameters(lm1, lm2, select = "{estimate}
({se})|{p}") +print_html(result) +} +\dontshow{\}) # examplesIf} +} diff --git a/man/print.parameters_model.Rd b/man/print.parameters_model.Rd index 18bec59c7..d3038109c 100644 --- a/man/print.parameters_model.Rd +++ b/man/print.parameters_model.Rd @@ -1,10 +1,31 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/print.parameters_model.R -\name{print.parameters_model} +% Please edit documentation in R/format.R, R/print.parameters_model.R, +% R/print_html.R, R/print_md.R +\name{format.parameters_model} +\alias{format.parameters_model} \alias{print.parameters_model} \alias{summary.parameters_model} +\alias{print_html.parameters_model} +\alias{print_md.parameters_model} \title{Print model parameters} \usage{ +\method{format}{parameters_model}( + x, + pretty_names = TRUE, + split_components = TRUE, + select = NULL, + digits = 2, + ci_digits = digits, + p_digits = 3, + ci_width = NULL, + ci_brackets = NULL, + zap_small = FALSE, + format = NULL, + groups = NULL, + include_reference = FALSE, + ... +) + \method{print}{parameters_model}( x, pretty_names = TRUE, @@ -27,6 +48,55 @@ ) \method{summary}{parameters_model}(object, ...) + +\method{print_html}{parameters_model}( + x, + pretty_names = TRUE, + split_components = TRUE, + select = NULL, + caption = NULL, + subtitle = NULL, + footer = NULL, + align = NULL, + digits = 2, + ci_digits = digits, + p_digits = 3, + footer_digits = 3, + ci_brackets = c("(", ")"), + show_sigma = FALSE, + show_formula = FALSE, + zap_small = FALSE, + groups = NULL, + font_size = "100\%", + line_padding = 4, + column_labels = NULL, + include_reference = FALSE, + verbose = TRUE, + ... +) + +\method{print_md}{parameters_model}( + x, + pretty_names = TRUE, + split_components = TRUE, + select = NULL, + caption = NULL, + subtitle = NULL, + footer = NULL, + align = NULL, + digits = 2, + ci_digits = digits, + p_digits = 3, + footer_digits = 3, + ci_brackets = c("(", ")"), + show_sigma = FALSE, + show_formula = FALSE, + zap_small = FALSE, + groups = NULL, + include_reference = FALSE, + verbose = TRUE, + ... +) } \arguments{ \item{x, object}{An object returned by \code{\link[=model_parameters]{model_parameters()}}.} @@ -86,14 +156,6 @@ For \code{model_parameters()}, glue-like syntax is still experimental in the case of more complex models (like mixed models) and may not return expected results.} -\item{caption}{Table caption as string. If \code{NULL}, depending on the model, -either a default caption or no table caption is printed. Use \code{caption = ""} -to suppress the table caption.} - -\item{footer}{Can either be \code{FALSE} or an empty string (i.e. \code{""}) to -suppress the footer, \code{NULL} to print the default footer, or a string. The -latter will combine the string value with the default footer.} - \item{digits, ci_digits, p_digits}{Number of digits for rounding or significant figures. May also be \code{"signif"} to return significant figures or \code{"scientific"} to return scientific notation. Control the @@ -101,17 +163,21 @@ number of digits by adding the value as suffix, e.g. \code{digits = "scientific4 to have scientific notation with 4 decimal places, or \code{digits = "signif5"} for 5 significant figures (see also \code{\link[=signif]{signif()}}).} -\item{footer_digits}{Number of decimal places for values in the footer summary.} - -\item{show_sigma}{Logical, if \code{TRUE}, adds information about the residual -standard deviation.} +\item{ci_width}{Minimum width of the returned string for confidence +intervals. If not \code{NULL} and width is larger than the string's length, +leading whitespaces are added to the string. If \code{width="auto"}, width +will be set to the length of the longest string.} -\item{show_formula}{Logical, if \code{TRUE}, adds the model formula to the output.} +\item{ci_brackets}{Logical, if \code{TRUE} (default), CI-values are +encompassed in square brackets (else in parentheses).} \item{zap_small}{Logical, if \code{TRUE}, small values are rounded after \code{digits} decimal places. If \code{FALSE}, values with more decimal places than \code{digits} are printed in scientific notation.} +\item{format}{String, indicating the output format. Can be \code{"markdown"} +or \code{"html"}.} + \item{groups}{Named list, can be used to group parameters in the printed output. List elements may either be character vectors that match the name of those parameters that belong to one group, or list elements can be row numbers @@ -122,6 +188,30 @@ variables, see 'Examples'. Parameters will be re-ordered according to the order used in \code{groups}, while all non-matching parameters will be added to the end.} +\item{include_reference}{Logical, if \code{TRUE}, the reference level of factors will +be added to the parameters table. This is only relevant for models with +categorical predictors. The coefficient for the reference level is always +\code{0} (except when \code{exponentiate = TRUE}, then the coefficient will be \code{1}), +so this is just for completeness.} + +\item{...}{Arguments passed down to \code{\link[=format.parameters_model]{format.parameters_model()}}, +\code{\link[insight:format_table]{insight::format_table()}} and \code{\link[insight:export_table]{insight::export_table()}}} + +\item{caption}{Table caption as string. If \code{NULL}, depending on the model, +either a default caption or no table caption is printed. Use \code{caption = ""} +to suppress the table caption.} + +\item{footer}{Can either be \code{FALSE} or an empty string (i.e. \code{""}) to +suppress the footer, \code{NULL} to print the default footer, or a string. The +latter will combine the string value with the default footer.} + +\item{footer_digits}{Number of decimal places for values in the footer summary.} + +\item{show_sigma}{Logical, if \code{TRUE}, adds information about the residual +standard deviation.} + +\item{show_formula}{Logical, if \code{TRUE}, adds the model formula to the output.} + \item{column_width}{Width of table columns. Can be either \code{NULL}, a named numeric vector, or \code{"fixed"}. If \code{NULL}, the width for each table column is adjusted to the minimum required width. If a named numeric vector, value @@ -129,16 +219,22 @@ names are matched against column names, and for each match, the specified width is used. If \code{"fixed"}, and table is split into multiple components, columns across all table components are adjusted to have the same width.} -\item{ci_brackets}{Logical, if \code{TRUE} (default), CI-values are -encompassed in square brackets (else in parentheses).} +\item{subtitle}{Table title (same as caption) and subtitle, as strings. If \code{NULL}, +no title or subtitle is printed, unless it is stored as attributes (\code{table_title}, +or its alias \code{table_caption}, and \code{table_subtitle}). If \code{x} is a list of +data frames, \code{caption} may be a list of table captions, one for each table.} -\item{include_reference}{Logical, if \code{TRUE}, the reference level of factors will -be added to the parameters table. This is only relevant for models with -categorical predictors. The coefficient for the reference level is always -\code{0} (except when \code{exponentiate = TRUE}, then the coefficient will be \code{1}), -so this is just for completeness.} +\item{align}{Only applies to HTML tables. May be one of \code{"left"}, +\code{"right"} or \code{"center"}.} + +\item{font_size}{For HTML tables, the font size.} + +\item{line_padding}{For HTML tables, the distance (in pixel) between lines.} + +\item{column_labels}{Labels of columns for HTML tables. If \code{NULL}, automatic +column names are generated. See 'Examples'.} -\item{...}{Arguments passed to or from other methods.} +\item{verbose}{Toggle messages and warnings.} } \value{ Invisibly returns the original input object. @@ -157,12 +253,12 @@ warnings for the different functions in the \strong{parameters} package. However some messages providing additional information can be displayed or suppressed using \code{options()}: \itemize{ -\item \code{parameters_summary}: \code{options(parameters_summary = TRUE)} will override the -\code{summary} argument in \code{model_parameters()} and always show the model summary -for non-mixed models. -\item \code{parameters_mixed_summary}: \code{options(parameters_mixed_summary = TRUE)} will -override the \code{summary} argument in \code{model_parameters()} for mixed models, and -will then always show the model summary. +\item \code{parameters_info}: \code{options(parameters_info = TRUE)} will override the +\code{include_info} argument in \code{model_parameters()} and always show the model +summary for non-mixed models. +\item \code{parameters_mixed_info}: \code{options(parameters_mixed_info = TRUE)} will +override the \code{include_info} argument in \code{model_parameters()} for mixed +models, and will then always show the model summary. \item \code{parameters_cimethod}: \code{options(parameters_cimethod = TRUE)} will show the additional information about the approximation method used to calculate confidence intervals and p-values. Set to \code{FALSE} to hide this message when @@ -188,6 +284,9 @@ options. \item \code{easystats_html_engine}: \code{options(easystats_html_engine = "gt")} will set the default HTML engine for tables to \code{gt}, i.e. the \emph{gt} package is used to create HTML tables. If set to \code{tt}, the \emph{tinytable} package is used. +\item \code{insight_use_symbols}: \code{options(insight_use_symbols = TRUE)} will try to +print unicode-chars for symbols as column names, wherever possible (e.g., +\ifelse{html}{\out{ω}}{\eqn{\omega}} instead of \code{Omega}). } } @@ -195,7 +294,7 @@ create HTML tables. If set to \code{tt}, the \emph{tinytable} package is used. Note that the \emph{interpretation} of interaction terms depends on many characteristics of the model. The number of parameters, and overall -performance of the model, can differ \emph{or not} between \code{a * b} +performance of the model, can differ \emph{or not} between \code{a * b}, \code{a : b}, and \code{a / b}, suggesting that sometimes interaction terms give different parameterizations of the same model, but other times it gives completely different models (depending on \code{a} or \code{b} being factors @@ -297,7 +396,5 @@ print_html(result) \dontshow{\}) # examplesIf} } \seealso{ -There is a dedicated method to use inside rmarkdown files, -\code{\link[=print_md.parameters_model]{print_md()}}. See also -\code{\link[=display.parameters_model]{display()}}. +See also \code{\link[=display.parameters_model]{display()}}. } diff --git a/man/reexports.Rd b/man/reexports.Rd index 0dc0aba66..04c2b5645 100644 --- a/man/reexports.Rd +++ b/man/reexports.Rd @@ -1,12 +1,14 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/equivalence_test.R, R/methods_bayestestR.R, -% R/n_parameters.R, R/reexports.R +% R/n_parameters.R, R/p_direction.R, R/p_significance.R, R/reexports.R \docType{import} \name{reexports} \alias{reexports} \alias{equivalence_test} \alias{ci} \alias{n_parameters} +\alias{p_direction} +\alias{p_significance} \alias{standardize_names} \alias{supported_models} \alias{print_html} @@ -25,7 +27,7 @@ These objects are imported from other packages. Follow the links below to see their documentation. \describe{ - \item{bayestestR}{\code{\link[bayestestR]{ci}}, \code{\link[bayestestR]{equivalence_test}}} + \item{bayestestR}{\code{\link[bayestestR]{ci}}, \code{\link[bayestestR]{equivalence_test}}, \code{\link[bayestestR]{p_direction}}, \code{\link[bayestestR]{p_significance}}} \item{datawizard}{\code{\link[datawizard]{demean}}, \code{\link[datawizard]{describe_distribution}}, \code{\link[datawizard:skewness]{kurtosis}}, \code{\link[datawizard]{rescale_weights}}, \code{\link[datawizard]{skewness}}, \code{\link[datawizard]{visualisation_recipe}}} diff --git a/man/select_parameters.Rd b/man/select_parameters.Rd index 5fd2e981f..12a880eac 100644 --- a/man/select_parameters.Rd +++ b/man/select_parameters.Rd @@ -30,11 +30,9 @@ select_parameters(model, ...) process early. } -\item{k}{ - the multiple of the number of degrees of freedom used for the penalty. - Only \code{k = 2} gives the genuine AIC: \code{k = log(n)} is sometimes - referred to as BIC or SBC. - } +\item{k}{The multiple of the number of degrees of freedom used for the penalty. +Only \code{k = 2} gives the genuine AIC: \code{k = log(n)} is sometimes referred to as +BIC or SBC.} } \value{ The model refitted with optimal number of parameters. @@ -43,21 +41,22 @@ The model refitted with optimal number of parameters. This function performs an automated selection of the 'best' parameters, updating and returning the "best" model. } -\details{ -\subsection{Classical lm and glm}{ -For frequentist GLMs, \code{select_parameters()} performs an AIC-based -stepwise selection. -} +\section{Classical lm and glm}{ -\subsection{Mixed models}{ -For mixed-effects models of class \code{merMod}, stepwise selection is -based on \code{\link[cAIC4:stepcAIC]{cAIC4::stepcAIC()}}. This step function -only searches the "best" model based on the random-effects structure, -i.e. \code{select_parameters()} adds or excludes random-effects until -the cAIC can't be improved further. +For frequentist GLMs, \code{select_parameters()} performs an AIC-based stepwise +selection. } + +\section{Mixed models}{ + +For mixed-effects models of class \code{merMod}, stepwise selection is based on +\code{\link[cAIC4:stepcAIC]{cAIC4::stepcAIC()}}. This step function only searches the "best" model +based on the random-effects structure, i.e. \code{select_parameters()} adds or +excludes random-effects until the cAIC can't be improved further. } + \examples{ +\dontshow{if (requireNamespace("lme4")) (if (getRversion() >= "3.4") withAutoprint else force)(\{ # examplesIf} model <- lm(mpg ~ ., data = mtcars) select_parameters(model) @@ -65,13 +64,11 @@ model <- lm(mpg ~ cyl * disp * hp * wt, data = mtcars) select_parameters(model) \donttest{ # lme4 ------------------------------------------- -if (require("lme4")) { - model <- lmer( - Sepal.Width ~ Sepal.Length * Petal.Width * Petal.Length + (1 | Species), - data = iris - ) - select_parameters(model) -} +model <- lme4::lmer( + Sepal.Width ~ Sepal.Length * Petal.Width * Petal.Length + (1 | Species), + data = iris +) +select_parameters(model) } - +\dontshow{\}) # examplesIf} } diff --git a/man/standard_error.Rd b/man/standard_error.Rd index 3dc8d3410..bbe63709e 100644 --- a/man/standard_error.Rd +++ b/man/standard_error.Rd @@ -59,11 +59,12 @@ the function to be used to compute the covariance matrix. \itemize{ \item Heteroskedasticity-consistent: \code{"vcovHC"}, \code{"HC"}, \code{"HC0"}, \code{"HC1"}, \code{"HC2"}, \code{"HC3"}, \code{"HC4"}, \code{"HC4m"}, \code{"HC5"}. See \code{?sandwich::vcovHC}. -\item Cluster-robust: \code{"vcovCR"}, \code{"CR0"}, \code{"CR1"}, \code{"CR1p"}, \code{"CR1S"}, \code{"CR2"}, -\code{"CR3"}. See \code{?clubSandwich::vcovCR}. -\item Bootstrap: \code{"vcovBS"}, \code{"xy"}, \code{"residual"}, \code{"wild"}, \code{"mammen"}, \code{"webb"}. -See \code{?sandwich::vcovBS}. -\item Other \code{sandwich} package functions: \code{"vcovHAC"}, \code{"vcovPC"}, \code{"vcovCL"}, \code{"vcovPL"}. +\item Cluster-robust: \code{"vcovCR"}, \code{"CR0"}, \code{"CR1"}, \code{"CR1p"}, \code{"CR1S"}, +\code{"CR2"}, \code{"CR3"}. See \code{?clubSandwich::vcovCR}. +\item Bootstrap: \code{"vcovBS"}, \code{"xy"}, \code{"residual"}, \code{"wild"}, \code{"mammen"}, +\code{"webb"}. See \code{?sandwich::vcovBS}. +\item Other \code{sandwich} package functions: \code{"vcovHAC"}, \code{"vcovPC"}, \code{"vcovCL"}, +\code{"vcovPL"}. } }} @@ -109,15 +110,17 @@ For Bayesian models (from \strong{rstanarm} or \strong{brms}), the standard error is the SD of the posterior samples. } \examples{ +\dontshow{if (require("sandwich") && require("clubSandwich")) (if (getRversion() >= "3.4") withAutoprint else force)(\{ # examplesIf} model <- lm(Petal.Length ~ Sepal.Length * Species, data = iris) standard_error(model) -if (require("sandwich") && require("clubSandwich")) { - standard_error(model, vcov = "HC3") +# robust standard errors +standard_error(model, vcov = "HC3") - standard_error(model, - vcov = "vcovCL", - vcov_args = list(cluster = iris$Species) - ) -} +# cluster-robust standard errors +standard_error(model, + vcov = "vcovCL", + vcov_args = list(cluster = iris$Species) +) +\dontshow{\}) # examplesIf} } diff --git a/man/standardize_info.Rd b/man/standardize_info.Rd index 0bf36caa8..385af35d6 100644 --- a/man/standardize_info.Rd +++ b/man/standardize_info.Rd @@ -51,10 +51,12 @@ parameters. This function gives a window on how standardized are obtained, i.e., by what they are divided. The "basic" method of standardization uses. } \examples{ +\dontshow{if (insight::check_if_installed("datawizard", minimum_version = "0.12.0", quietly = TRUE)) (if (getRversion() >= "3.4") withAutoprint else force)(\{ # examplesIf} model <- lm(mpg ~ ., data = mtcars) standardize_info(model) standardize_info(model, robust = TRUE) standardize_info(model, two_sd = TRUE) +\dontshow{\}) # examplesIf} } \seealso{ Other standardize: diff --git a/man/standardize_parameters.Rd b/man/standardize_parameters.Rd index a0bd0eeaa..db5c3945a 100644 --- a/man/standardize_parameters.Rd +++ b/man/standardize_parameters.Rd @@ -84,7 +84,7 @@ models). This method is particularly recommended for complex models that include interactions or transformations (e.g., polynomial or spline terms). The \code{robust} (default to \code{FALSE}) argument enables a robust standardization of data, i.e., based on the \code{median} and \code{MAD} instead of the \code{mean} and -\code{SD}. \strong{See \code{\link[=standardize]{standardize()}} for more details.} +\code{SD}. \strong{See \code{\link[datawizard:standardize]{datawizard::standardize()}} for more details.} \itemize{ \item \strong{Note} that \code{standardize_parameters(method = "refit")} may not return the same results as fitting a model on data that has been standardized with @@ -148,8 +148,9 @@ When the model's formula contains transformations (e.g. \code{y ~ exp(X)}) \code equivalent to \code{exp(scale(X))}), the \code{"basic"} method standardizes the transformed data (e.g. equivalent to \code{scale(exp(X))}). \cr\cr -See the \emph{Transformed Variables} section in \code{\link[=standardize.default]{standardize.default()}} for more -details on how different transformations are dealt with when \code{method = "refit"}. +See the \emph{Transformed Variables} section in \code{\link[datawizard:standardize.default]{datawizard::standardize.default()}} +for more details on how different transformations are dealt with when +\code{method = "refit"}. } \subsection{Confidence Intervals}{ diff --git a/paper/paper.bib b/paper/paper.bib index e279f20b9..e9a408f58 100644 --- a/paper/paper.bib +++ b/paper/paper.bib @@ -10,8 +10,6 @@ @Article{makowski2019bayetestR journal = {Journal of Open Source Software} } - - @Article{ludecke2019insight, title = {{insight}: A Unified Interface to Access Information from Model Objects in {R}}, volume = {4}, @@ -23,7 +21,6 @@ @Article{ludecke2019insight pages = {1412} } - @Manual{rcore, title = {{R}: A Language and Environment for Statistical Computing}, author = {{R Core Team}}, @@ -33,7 +30,6 @@ @Manual{rcore url = {https://www.R-project.org/} } - @Article{zeileis2006, title = {Object-Oriented Computation of Sandwich Estimators}, author = {Achim Zeileis}, @@ -45,7 +41,6 @@ @Article{zeileis2006 doi = {10.18637/jss.v016.i09} } - @Manual{pustejovsky2020, title = {{clubSandwich}: Cluster-Robust (Sandwich) Variance Estimators with Small-Sample Corrections}, @@ -55,8 +50,6 @@ @Manual{pustejovsky2020 url = {https://CRAN.R-project.org/package=clubSandwich} } - - @article{lakens2020equivalence, title = {Equivalence Testing for Psychological Research: A Tutorial}, volume = {1}, @@ -72,7 +65,6 @@ @article{lakens2020equivalence pages = {259--269} } - @Article{luedecke2020performance, title = {{performance}: Assessment of Regression Models Performance}, author = {Daniel Lüdecke and Dominique Makowski and Philip Waggoner and Indrajeet Patil}, @@ -83,7 +75,6 @@ @Article{luedecke2020performance url = {https://easystats.github.io/performance} } - @Manual{robinson_broom_2020, title = {{broom}: Convert Statistical Objects into Tidy Tibbles}, author = {David Robinson and Alex Hayes and Simon Couch}, @@ -92,7 +83,6 @@ @Manual{robinson_broom_2020 url = {https://CRAN.R-project.org/package=broom} } - @Manual{hlavac_stargazer_2018, title = {{stargazer}: Well-Formatted Regression and Summary Statistics Tables}, author = {Marek Hlavac}, @@ -103,7 +93,6 @@ @Manual{hlavac_stargazer_2018 url = {https://CRAN.R-project.org/package=stargazer}, } - @Manual{harrison2020finalfit, title = {{finalfit}: Quickly Create Elegant Regression Results Tables and Plots when Modeling}, @@ -113,7 +102,6 @@ @Manual{harrison2020finalfit url = {https://CRAN.R-project.org/package=finalfit}, } - @Article{ludecke2020see, title = {{see}: Visualisation Toolbox for 'easystats' and Extra Geoms, Themes and Color Palettes for 'ggplot2'}, author = {Daniel Lüdecke and Mattan S. Ben-Shachar and Philip Waggoner and Dominique Makowski}, @@ -124,7 +112,6 @@ @Article{ludecke2020see url = {https://easystats.github.io/see} } - @Manual{revelle_psych_2019, title = {{psych}: Procedures for Psychological, Psychometric, and Personality Research}, author = {William Revelle}, @@ -135,7 +122,6 @@ @Manual{revelle_psych_2019 url = {https://CRAN.R-project.org/package=psych} } - @Article{saefken_caic4_2018, title = {Conditional Model Selection in Mixed-Effects Models with {cAIC4}}, author = {Benjamin Saefken and David Ruegamer and Thomas Kneib and Sonja Greven}, @@ -155,3 +141,120 @@ @Article{benshachar2020effecsize doi = {10.5281/zenodo.3952214}, url = {https://easystats.github.io/effectsize}, } + +@misc{lakens_improving_2022, + title = {Improving {Your} {Statistical} {Inferences}}, + copyright = {Creative Commons Attribution Non Commercial Share Alike 4.0 International, Open Access}, + url = {https://zenodo.org/record/6409077}, + urldate = {2024-09-03}, + publisher = {Zenodo}, + author = {Lakens, Daniël}, + month = apr, + year = {2024}, + doi = {10.5281/ZENODO.6409077} +} + +@article{amrhein_earth_2017, + title = {The earth is flat ( \textit{p} {\textgreater} 0.05): significance thresholds and the crisis of unreplicable research}, + volume = {5}, + copyright = {http://creativecommons.org/licenses/by/4.0/}, + issn = {2167-8359}, + shorttitle = {The earth is flat ( \textit{p} {\textgreater} 0.05)}, + url = {https://peerj.com/articles/3544}, + doi = {10.7717/peerj.3544}, + language = {en}, + urldate = {2024-09-03}, + journal = {PeerJ}, + author = {Amrhein, Valentin and Korner-Nievergelt, Fränzi and Roth, Tobias}, + month = jul, + year = {2017}, + pages = {e3544} +} + +@misc{greenland_aid_2022, + title = {To {Aid} {Scientific} {Inference}, {Emphasize} {Unconditional} {Compatibility} {Descriptions} of {Statistics}}, + url = {http://arxiv.org/abs/1909.08583}, + abstract = {All scientific interpretations of statistical outputs depend on background (auxiliary) assumptions that are rarely delineated or explicitly interrogated. These include not only the usual modeling assumptions, but also deeper assumptions about the data-generating mechanism that are implicit in conventional statistical interpretations yet are unrealistic in most health, medical and social research. We provide arguments and methods for reinterpreting statistics such as P-values and interval estimates in unconditional terms, which describe compatibility of observations with an entire set of underlying assumptions, rather than with a narrow target hypothesis conditional on the assumptions. Emphasizing unconditional interpretations helps avoid overconfident and misleading inferences in light of uncertainties about the assumptions used to arrive at the statistical results. These include not only mathematical assumptions, but also those about absence of systematic errors, protocol violations, and data corruption. Unconditional descriptions introduce assumption uncertainty directly into the primary statistical interpretations of results, rather than leaving it for the discussion of limitations after presentation of conditional interpretations. The unconditional approach does not entail different methods or calculations, only different interpretation of the usual results. We view use of unconditional description as a vital component of effective statistical training and presentation. By interpreting statistical outputs in unconditional terms, researchers can avoid making overconfident statements based on statistical outputs. Instead, reports should emphasize the compatibility of results with a range of plausible explanations, including assumption violations.}, + urldate = {2022-11-10}, + publisher = {arXiv}, + author = {Greenland, Sander and Rafi, Zad and Matthews, Robert and Higgs, Megan}, + month = jul, + year = {2022}, + note = {arXiv:1909.08583 [q-bio, stat]}, + keywords = {Quantitative Biology - Quantitative Methods, Statistics - Applications, Statistics - Methodology}, +} + +@article{rafi_semantic_2020, + title = {Semantic and cognitive tools to aid statistical science: replace confidence and significance by compatibility and surprise}, + volume = {20}, + issn = {1471-2288}, + shorttitle = {Semantic and cognitive tools to aid statistical science}, + url = {https://bmcmedresmethodol.biomedcentral.com/articles/10.1186/s12874-020-01105-9}, + doi = {10.1186/s12874-020-01105-9}, + language = {en}, + number = {1}, + urldate = {2023-03-22}, + journal = {BMC Medical Research Methodology}, + author = {Rafi, Zad and Greenland, Sander}, + month = dec, + year = {2020}, + pages = {244}, +} + +@article{schweder_confidence_2018, + title = {Confidence is epistemic probability for empirical science}, + volume = {195}, + issn = {03783758}, + url = {https://linkinghub.elsevier.com/retrieve/pii/S0378375817301738}, + doi = {10.1016/j.jspi.2017.09.016}, + language = {en}, + urldate = {2022-11-10}, + journal = {Journal of Statistical Planning and Inference}, + author = {Schweder, Tore}, + month = may, + year = {2018}, + pages = {116--125}, +} + +@incollection{schweder_frequentist_2003, + address = {Princeton}, + title = {Frequentist {Analogues} of {Priors} and {Posteriors}}, + url = {https://www.duo.uio.no/handle/10852/10425}, + language = {eng}, + urldate = {2024-09-03}, + booktitle = {Econometrics and the {Philosophy} of {Economics}: {Theory}-{Data} {Confrontations} in {Economics}}, + publisher = {Princeton University Press}, + author = {Schweder, Tore and Hjort, Nils Lid}, + editor = {Stigum, Bernt}, + year = {2003}, + pages = {285--217} +} + +@article{vos_frequentist_2022, + title = {Frequentist statistical inference without repeated sampling}, + volume = {200}, + issn = {0039-7857, 1573-0964}, + url = {https://link.springer.com/10.1007/s11229-022-03560-x}, + doi = {10.1007/s11229-022-03560-x}, + language = {en}, + number = {2}, + urldate = {2024-09-03}, + journal = {Synthese}, + author = {Vos, Paul and Holbert, Don}, + month = apr, + year = {2022}, + pages = {89} +} + +@article{makowski_indices_2019, + title = {Indices of {Effect} {Existence} and {Significance} in the {Bayesian} {Framework}}, + volume = {10}, + issn = {1664-1078}, + url = {https://www.frontiersin.org/article/10.3389/fpsyg.2019.02767}, + doi = {10.3389/fpsyg.2019.02767}, + abstract = {Turmoil has engulfed psychological science. Causes and consequences of the reproducibility crisis are in dispute. With the hope of addressing some of its aspects, Bayesian methods are gaining increasing attention in psychological science. Some of their advantages, as opposed to the frequentist framework, are the ability to describe parameters in probabilistic terms and explicitly incorporate prior knowledge about them into the model. These issues are crucial in particular regarding the current debate about statistical significance. Bayesian methods are not necessarily the only remedy against incorrect interpretations or wrong conclusions, but there is an increasing agreement that they are one of the keys to avoid such fallacies. Nevertheless, its flexible nature is its power and weakness, for there is no agreement about what indices of “significance” should be computed or reported. This lack of a consensual index or guidelines, such as the frequentist p-value, further contributes to the unnecessary opacity that many non-familiar readers perceive in Bayesian statistics. Thus, this study describes and compares several Bayesian indices, provide intuitive visual representation of their “behavior” in relationship with common sources of variance such as sample size, magnitude of effects and also frequentist significance. The results contribute to the development of an intuitive understanding of the values that researchers report, allowing to draw sensible recommendations for Bayesian statistics description, critical for the standardization of scientific reporting.}, + journal = {Frontiers in Psychology}, + author = {Makowski, Dominique and Ben-Shachar, Mattan S. and Chen, S. H. Annabel and Lüdecke, Daniel}, + year = {2019}, + pages = {2767} +} diff --git a/_pkgdown.yml b/pkgdown/_pkgdown.yml similarity index 97% rename from _pkgdown.yml rename to pkgdown/_pkgdown.yml index a6fef29f8..01bc03c9d 100644 --- a/_pkgdown.yml +++ b/pkgdown/_pkgdown.yml @@ -58,10 +58,11 @@ reference: - title: "Effect Existence and Significance" contents: - - equivalence_test - equivalence_test.lm - p_calibrate + - p_direction.lm - p_function + - p_significance.lm - title: "Parameter Sampling" contents: @@ -102,6 +103,7 @@ reference: - format_parameters - format_p_adjust - format_df_adjust + - format.compare_parameters - parameters_type - print_md diff --git a/pkgdown/favicon/apple-touch-icon-120x120.png b/pkgdown/favicon/apple-touch-icon-120x120.png new file mode 100644 index 000000000..3742d74c4 Binary files /dev/null and b/pkgdown/favicon/apple-touch-icon-120x120.png differ diff --git a/pkgdown/favicon/apple-touch-icon-60x60.png b/pkgdown/favicon/apple-touch-icon-60x60.png new file mode 100644 index 000000000..e7732e7cd Binary files /dev/null and b/pkgdown/favicon/apple-touch-icon-60x60.png differ diff --git a/pkgdown/favicon/apple-touch-icon-76x76.png b/pkgdown/favicon/apple-touch-icon-76x76.png new file mode 100644 index 000000000..692f76d90 Binary files /dev/null and b/pkgdown/favicon/apple-touch-icon-76x76.png differ diff --git a/pkgdown/favicon/apple-touch-icon.png b/pkgdown/favicon/apple-touch-icon.png new file mode 100644 index 000000000..5640c30bf Binary files /dev/null and b/pkgdown/favicon/apple-touch-icon.png differ diff --git a/pkgdown/favicon/favicon-16x16.png b/pkgdown/favicon/favicon-16x16.png new file mode 100644 index 000000000..5a20aa021 Binary files /dev/null and b/pkgdown/favicon/favicon-16x16.png differ diff --git a/pkgdown/favicon/favicon-32x32.png b/pkgdown/favicon/favicon-32x32.png new file mode 100644 index 000000000..18abcb872 Binary files /dev/null and b/pkgdown/favicon/favicon-32x32.png differ diff --git a/pkgdown/favicon/favicon.ico b/pkgdown/favicon/favicon.ico new file mode 100644 index 000000000..d46c291d1 Binary files /dev/null and b/pkgdown/favicon/favicon.ico differ diff --git a/tests/testthat/_snaps/brms.md b/tests/testthat/_snaps/brms.md new file mode 100644 index 000000000..18f94be4c --- /dev/null +++ b/tests/testthat/_snaps/brms.md @@ -0,0 +1,41 @@ +# mp, footer exp + + Code + print(out) + Output + # Fixed Effects + + Parameter | Median | 95% CI | pd | Rhat | ESS + ---------------------------------------------------------------------- + (Intercept) | -0.25 | [-1.28, 0.75] | 68.62% | 0.999 | 3459.00 + var_binom1 | -0.64 | [-2.09, 0.64] | 83.20% | 1.000 | 2820.00 + groupsb | -0.22 | [-1.35, 0.87] | 64.75% | 1.000 | 3332.00 + var_cont | -0.06 | [-0.14, 0.00] | 96.65% | 1.000 | 3528.00 + var_binom1:groupsb | 0.53 | [-1.70, 2.69] | 69.25% | 1.000 | 2699.00 + Message + + Uncertainty intervals (equal-tailed) and p-values (two-tailed) computed + using a MCMC distribution approximation. + + The model has a log- or logit-link. Consider using `exponentiate = + TRUE` to interpret coefficients as ratios. + +--- + + Code + print(out) + Output + # Fixed Effects + + Parameter | Median | 95% CI | pd | Rhat | ESS + ---------------------------------------------------------------------- + (Intercept) | 0.78 | [0.28, 2.11] | 68.62% | 0.999 | 3459.00 + var_binom1 | 0.53 | [0.12, 1.90] | 83.20% | 1.000 | 2820.00 + groupsb | 0.80 | [0.26, 2.38] | 64.75% | 1.000 | 3332.00 + var_cont | 0.94 | [0.87, 1.00] | 96.65% | 1.000 | 3528.00 + var_binom1:groupsb | 1.69 | [0.18, 14.80] | 69.25% | 1.000 | 2699.00 + Message + + Uncertainty intervals (equal-tailed) and p-values (two-tailed) computed + using a MCMC distribution approximation. + diff --git a/tests/testthat/_snaps/equivalence_test.md b/tests/testthat/_snaps/equivalence_test.md index 870079898..325858efa 100644 --- a/tests/testthat/_snaps/equivalence_test.md +++ b/tests/testthat/_snaps/equivalence_test.md @@ -10,8 +10,25 @@ Parameter | 90% CI | SGPV | Equivalence | p ------------------------------------------------------------ (Intercept) | [26.52, 46.86] | < .001 | Rejected | > .999 - gear | [-1.34, 2.07] | 0.354 | Undecided | 0.578 + gear | [-1.34, 2.07] | 0.475 | Undecided | 0.578 wt | [-4.47, -1.57] | < .001 | Rejected | 0.996 - cyl | [-1.94, 0.32] | 0.407 | Undecided | 0.644 + cyl | [-1.94, 0.32] | 0.351 | Undecided | 0.644 + hp | [-0.05, 0.01] | > .999 | Accepted | < .001 + +# equivalence_test, robust + + Code + print(x) + Output + # TOST-test for Practical Equivalence + + ROPE: [-0.60 0.60] + + Parameter | 90% CI | SGPV | Equivalence | p + ------------------------------------------------------------ + (Intercept) | [23.10, 50.28] | < .001 | Rejected | > .999 + gear | [-1.63, 2.36] | 0.421 | Undecided | 0.628 + wt | [-4.59, -1.45] | 0.001 | Rejected | 0.993 + cyl | [-2.24, 0.62] | 0.361 | Undecided | 0.649 hp | [-0.05, 0.01] | > .999 | Accepted | < .001 diff --git a/tests/testthat/_snaps/equivalence_test/equivalence-test-1.svg b/tests/testthat/_snaps/equivalence_test/equivalence-test-1.svg new file mode 100644 index 000000000..533976c27 --- /dev/null +++ b/tests/testthat/_snaps/equivalence_test/equivalence-test-1.svg @@ -0,0 +1,70 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +Speciesvirginica +Speciesversicolor + + + + + + +0.0 +0.5 +1.0 +1.5 + +Equivalence + + + +Rejected +Equivalence-Test 1 + + diff --git a/tests/testthat/_snaps/equivalence_test/equivalence-test-2.svg b/tests/testthat/_snaps/equivalence_test/equivalence-test-2.svg new file mode 100644 index 000000000..a987aae10 --- /dev/null +++ b/tests/testthat/_snaps/equivalence_test/equivalence-test-2.svg @@ -0,0 +1,73 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +Speciesvirginica +Speciesversicolor + + + + + + + +-100 +-75 +-50 +-25 +0 + +Equivalence + + + +Rejected +Equivalence-Test 2 + + diff --git a/tests/testthat/_snaps/equivalence_test/equivalence-test-3.svg b/tests/testthat/_snaps/equivalence_test/equivalence-test-3.svg new file mode 100644 index 000000000..f6d783bb3 --- /dev/null +++ b/tests/testthat/_snaps/equivalence_test/equivalence-test-3.svg @@ -0,0 +1,93 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +cyl8 +cyl6 +gear5 +gear4 +hp + + + + + + + + + +-5 +0 +5 +10 + +Equivalence + + + + + + + + + +Accepted +Rejected +Undecided +Equivalence-Test 3 + + diff --git a/tests/testthat/_snaps/equivalence_test/equivalence-test-4.svg b/tests/testthat/_snaps/equivalence_test/equivalence-test-4.svg new file mode 100644 index 000000000..6f6c286e7 --- /dev/null +++ b/tests/testthat/_snaps/equivalence_test/equivalence-test-4.svg @@ -0,0 +1,93 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +cyl8 +cyl6 +gear5 +gear4 +hp + + + + + + + + + +-5 +0 +5 +10 + +Equivalence + + + + + + + + + +Accepted +Rejected +Undecided +Equivalence-Test 4 + + diff --git a/tests/testthat/_snaps/equivalence_test/equivalence-test-5.svg b/tests/testthat/_snaps/equivalence_test/equivalence-test-5.svg new file mode 100644 index 000000000..5a9d29a42 --- /dev/null +++ b/tests/testthat/_snaps/equivalence_test/equivalence-test-5.svg @@ -0,0 +1,93 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +cyl8 +cyl6 +gear5 +gear4 +hp + + + + + + + + + +-5 +0 +5 +10 + +Equivalence + + + + + + + + + +Accepted +Rejected +Undecided +Equivalence-Test 5 + + diff --git a/tests/testthat/_snaps/model_parameters.fixest.md b/tests/testthat/_snaps/model_parameters.fixest.md index 6106b566f..c095a3fe0 100644 --- a/tests/testthat/_snaps/model_parameters.fixest.md +++ b/tests/testthat/_snaps/model_parameters.fixest.md @@ -1,7 +1,7 @@ # model_parameters.fixest Code - model_parameters(m1, summary = TRUE, verbose = FALSE) + model_parameters(m1, include_info = TRUE, verbose = FALSE) Output # Fixed Effects @@ -11,6 +11,7 @@ phq4 | -3.66 | 0.67 | [-4.98, -2.34] | -5.45 | < .001 Model: QoL ~ time + phq4 (564 Observations) - Residual standard deviation: 12.365 (df = 561) + Sigma: 12.365 (df = 561) r2: 0.743; ar2: 0.613; wr2: 0.180; war2: 0.175 + RMSE : 10.069 diff --git a/tests/testthat/_snaps/model_parameters.glm.md b/tests/testthat/_snaps/model_parameters.glm.md index c4b65f584..716d9eeb0 100644 --- a/tests/testthat/_snaps/model_parameters.glm.md +++ b/tests/testthat/_snaps/model_parameters.glm.md @@ -9,8 +9,9 @@ wt | -5.34 | 0.56 | [-6.49, -4.20] | -9.56 | < .001 Model: mpg ~ wt (32 Observations) - Residual standard deviation: 3.046 (df = 30) + Sigma: 3.046 (df = 30) R2: 0.753; adjusted R2: 0.745 + RMSE : 2.949 --- diff --git a/tests/testthat/_snaps/model_parameters.glmgee.md b/tests/testthat/_snaps/model_parameters.glmgee.md new file mode 100644 index 000000000..da1e47fb8 --- /dev/null +++ b/tests/testthat/_snaps/model_parameters.glmgee.md @@ -0,0 +1,20 @@ +# model_parameters.glmgee + + Code + print(out) + Output + # Fixed Effects + + Parameter | Log-Prevalence | SE | 95% CI | z | p + --------------------------------------------------------------------------------- + (Intercept) | 5.90 | 0.10 | [ 5.70, 6.11] | 56.30 | < .001 + days [1st degree] | 19.20 | 0.52 | [18.18, 20.22] | 37.03 | < .001 + days [2nd degree] | -2.86 | 0.21 | [-3.26, -2.45] | -13.88 | < .001 + days [3rd degree] | 5.42 | 0.18 | [ 5.06, 5.77] | 29.69 | < .001 + days [4th degree] | -3.57 | 0.12 | [-3.82, -3.33] | -28.64 | < .001 + treat [ozone-enriched] | -0.26 | 0.13 | [-0.51, -0.01] | -2.01 | 0.044 + Message + + Uncertainty intervals (equal-tailed) and p-values (two-tailed) computed + using a Wald z-distribution approximation. + diff --git a/tests/testthat/_snaps/model_parameters.mclogit.md b/tests/testthat/_snaps/model_parameters.mclogit.md index 40050f040..32415413a 100644 --- a/tests/testthat/_snaps/model_parameters.mclogit.md +++ b/tests/testthat/_snaps/model_parameters.mclogit.md @@ -45,3 +45,36 @@ Uncertainty intervals (equal-tailed) and p-values (two-tailed) computed using a Wald z-distribution approximation. +# simulate_parameters.mblogit + + Code + params + Output + # Medium response + + Parameter | Coefficient | 95% CI | p + ----------------------------------------------------- + (Intercept) | -0.42 | [-0.73, -0.09] | 0.020 + InflMedium | 0.44 | [ 0.17, 0.71] | < .001 + InflHigh | 0.66 | [ 0.31, 1.02] | < .001 + TypeApartment | -0.43 | [-0.78, -0.11] | 0.012 + TypeAtrium | 0.12 | [-0.28, 0.58] | 0.588 + TypeTerrace | -0.66 | [-1.07, -0.27] | 0.002 + ContHigh | 0.35 | [ 0.10, 0.60] | 0.002 + + # High response + + Parameter | Coefficient | 95% CI | p + ----------------------------------------------------- + (Intercept) | -0.13 | [-0.43, 0.18] | 0.390 + InflMedium | 0.74 | [ 0.46, 0.99] | < .001 + InflHigh | 1.61 | [ 1.31, 1.94] | < .001 + TypeApartment | -0.74 | [-1.04, -0.42] | < .001 + TypeAtrium | -0.41 | [-0.82, -0.01] | 0.048 + TypeTerrace | -1.42 | [-1.83, -1.04] | < .001 + ContHigh | 0.48 | [ 0.23, 0.72] | < .001 + Message + + Uncertainty intervals (equal-tailed) and p-values (two-tailed) computed + using a MCMC distribution approximation. + diff --git a/tests/testthat/_snaps/model_parameters.mixed.md b/tests/testthat/_snaps/model_parameters.mixed.md index 9955f33b9..c89fefb71 100644 --- a/tests/testthat/_snaps/model_parameters.mixed.md +++ b/tests/testthat/_snaps/model_parameters.mixed.md @@ -52,7 +52,7 @@ --- Code - model_parameters(m1, effects = "fixed", summary = TRUE) + model_parameters(m1, effects = "fixed", include_info = TRUE) Output # Fixed Effects @@ -62,8 +62,9 @@ cyl | 0.40 | 0.08 | [ 0.25, 0.56] | 5.29 | < .001 Model: wt ~ cyl (32 Observations) - Residual standard deviation: 0.594 (df = 28) + Sigma: 0.594 (df = 28) Conditional R2: 0.628; Marginal R2: 0.550 + RMSE : 0.564 Message Uncertainty intervals (equal-tailed) and p-values (two-tailed) computed diff --git a/tests/testthat/_snaps/p_direction.md b/tests/testthat/_snaps/p_direction.md new file mode 100644 index 000000000..8d61719ae --- /dev/null +++ b/tests/testthat/_snaps/p_direction.md @@ -0,0 +1,15 @@ +# p_direction + + Code + print(x) + Output + Probability of Direction (null: 0) + + Parameter | 95% CI | pd + ------------------------------------- + (Intercept) | [24.44, 48.94] | 100% + gear | [-1.69, 2.41] | 63.59% + wt | [-4.77, -1.28] | 99.92% + cyl | [-2.17, 0.55] | 88.20% + hp | [-0.05, 0.01] | 91.17% + diff --git a/tests/testthat/_snaps/p_significance.md b/tests/testthat/_snaps/p_significance.md new file mode 100644 index 000000000..81b4cb7ce --- /dev/null +++ b/tests/testthat/_snaps/p_significance.md @@ -0,0 +1,30 @@ +# p_significance + + Code + print(x) + Output + Practical Significance (threshold: -0.60, 0.60) + + Parameter | 95% CI | ps + ------------------------------------- + (Intercept) | [24.44, 48.94] | 100% + gear | [-1.69, 2.41] | 39.83% + wt | [-4.77, -1.28] | 99.59% + cyl | [-2.17, 0.55] | 61.88% + hp | [-0.05, 0.01] | 0.00% + +# p_significance, robust + + Code + print(x) + Output + Practical Significance (threshold: -0.60, 0.60) + + Parameter | 95% CI | ps + ------------------------------------- + (Intercept) | [20.32, 53.06] | 100% + gear | [-2.04, 2.77] | 41.23% + wt | [-4.91, -1.13] | 99.39% + cyl | [-2.53, 0.91] | 59.51% + hp | [-0.06, 0.01] | 0.00% + diff --git a/tests/testthat/_snaps/pca.md b/tests/testthat/_snaps/pca.md new file mode 100644 index 000000000..17cd547a4 --- /dev/null +++ b/tests/testthat/_snaps/pca.md @@ -0,0 +1,32 @@ +# print model_parameters pca + + Code + print(principal_components(mtcars[, 1:4], n = "auto")) + Output + # Loadings from Principal Component Analysis (no rotation) + + Variable | PC1 | Complexity + ----------------------------- + mpg | -0.93 | 1.00 + cyl | 0.96 | 1.00 + disp | 0.95 | 1.00 + hp | 0.91 | 1.00 + + The unique principal component accounted for 87.55% of the total variance of the original data. + +--- + + Code + print(principal_components(mtcars[, 1:4], n = "auto"), labels = c( + "Miles/(US) gallon", "Number of cylinders", "Displacement (cu.in.)", + "Gross horsepower")) + Output + # Loadings from Principal Component Analysis (no rotation) + + Variable | Label | PC1 | Complexity + ----------------------------------------------------- + mpg | Miles/(US) gallon | -0.93 | 1.00 + cyl | Number of cylinders | 0.96 | 1.00 + disp | Displacement (cu.in.) | 0.95 | 1.00 + hp | Gross horsepower | 0.91 | 1.00 + diff --git a/tests/testthat/_snaps/print_AER_labels.md b/tests/testthat/_snaps/print_AER_labels.md new file mode 100644 index 000000000..92b571b63 --- /dev/null +++ b/tests/testthat/_snaps/print_AER_labels.md @@ -0,0 +1,19 @@ +# templates + + Code + print(mp, pretty_names = "labels") + Output + # Fixed Effects + + Parameter | Coefficient | SE | 95% CI | z | p + ----------------------------------------------------------------------------------------------- + (Intercept) | 8.72 | 3.45 | [ 1.95, 15.48] | 2.52 | 0.012 + elder's dependency [slightly dependent] | -1.00 | 3.61 | [-8.08, 6.08] | -0.28 | 0.782 + elder's dependency [moderately dependent] | 2.68 | 3.06 | [-3.32, 8.68] | 0.88 | 0.381 + elder's dependency [severely dependent] | 3.88 | 3.00 | [-2.01, 9.77] | 1.29 | 0.197 + carer's level of education | 1.14 | 0.90 | [-0.62, 2.90] | 1.27 | 0.204 + Message + + Uncertainty intervals (equal-tailed) and p-values (two-tailed) computed + using a Wald z-distribution approximation. + diff --git a/tests/testthat/_snaps/printing.md b/tests/testthat/_snaps/printing.md index c3e657e4e..750751645 100644 --- a/tests/testthat/_snaps/printing.md +++ b/tests/testthat/_snaps/printing.md @@ -92,8 +92,9 @@ Species [virginica] * Petal Length | 0.45 | 0.29 | [-0.12, 1.03] | 1.56 | 0.120 Model: Sepal.Length ~ Species * Petal.Length (150 Observations) - Residual standard deviation: 0.336 (df = 144) + Sigma: 0.336 (df = 144) R2: 0.840; adjusted R2: 0.835 + RMSE : 0.330 Message Uncertainty intervals (equal-tailed) and p-values (two-tailed) computed diff --git a/tests/testthat/_snaps/standardize_parameters.md b/tests/testthat/_snaps/standardize_parameters.md new file mode 100644 index 000000000..52be9f09c --- /dev/null +++ b/tests/testthat/_snaps/standardize_parameters.md @@ -0,0 +1,13 @@ +# Preserve labels + + Code + print(out) + Output + # Standardization method: refit + + Parameter | Std. Coef. | 95% CI + -------------------------------------------------- + (Intercept) | -1.01 | [-1.18, -0.84] + Species [versicolor] | 1.12 | [ 0.88, 1.37] + Species [virginica] | 1.91 | [ 1.66, 2.16] + diff --git a/tests/testthat/_snaps/svylme.md b/tests/testthat/_snaps/svylme.md new file mode 100644 index 000000000..b00a05ce8 --- /dev/null +++ b/tests/testthat/_snaps/svylme.md @@ -0,0 +1,26 @@ +# model_parameters svylme + + Code + print(mp) + Output + # Fixed Effects + + Parameter | Coefficient | SE | 95% CI | t | p + -------------------------------------------------------------------- + (Intercept) | -60.98 | 34.48 | [-128.57, 6.61] | -1.77 | 0.077 + ell | 0.92 | 0.26 | [ 0.41, 1.42] | 3.56 | < .001 + mobility | -0.38 | 0.24 | [ -0.85, 0.08] | -1.60 | 0.109 + api99 | 1.10 | 0.03 | [ 1.03, 1.17] | 31.44 | < .001 + + # Random Effects + + Parameter | Coefficient + ----------------------------------- + SD (Intercept: dnum1) | 1.19 + SD (api99: dnum2) | 1.39e-03 + SD (Residual) | 20.00 + Message + + Uncertainty intervals (equal-tailed) and p-values (two-tailed) computed + using a Wald t-distribution approximation. + diff --git a/tests/testthat/_snaps/weightit.md b/tests/testthat/_snaps/weightit.md new file mode 100644 index 000000000..e9a7d0194 --- /dev/null +++ b/tests/testthat/_snaps/weightit.md @@ -0,0 +1,51 @@ +# weightit, multinom + + Code + print(model_parameters(fit4, exponentiate = TRUE), zap_small = TRUE) + Output + # Response level: 2 + + Parameter | Odds Ratio | SE | 95% CI | z | p + -------------------------------------------------------------- + (Intercept) | 1.00 | 0.62 | [0.30, 3.39] | 0.00 | 0.998 + treat | 1.08 | 0.25 | [0.68, 1.71] | 0.31 | 0.755 + age | 0.97 | 0.01 | [0.95, 0.99] | -2.38 | 0.018 + educ | 0.98 | 0.05 | [0.89, 1.08] | -0.33 | 0.738 + + # Response level: 3 + + Parameter | Odds Ratio | SE | 95% CI | z | p + --------------------------------------------------------------- + (Intercept) | 0.05 | 0.04 | [0.01, 0.20] | -4.23 | < .001 + treat | 1.18 | 0.29 | [0.73, 1.91] | 0.67 | 0.502 + age | 1.00 | 0.01 | [0.98, 1.02] | -0.01 | 0.989 + educ | 1.20 | 0.06 | [1.08, 1.33] | 3.51 | < .001 + Message + + Uncertainty intervals (equal-tailed) and p-values (two-tailed) computed + using a Wald z-distribution approximation. + +# weightit, ordinal + + Code + print(model_parameters(fit5, exponentiate = TRUE), zap_small = TRUE) + Output + # Fixed Effects + + Parameter | Odds Ratio | SE | 95% CI | z | p + ------------------------------------------------------------ + treat | 1.12 | 0.21 | [0.78, 1.61] | 0.60 | 0.549 + age | 0.99 | 0.01 | [0.97, 1.01] | -0.78 | 0.436 + educ | 1.11 | 0.04 | [1.03, 1.20] | 2.70 | 0.007 + + # Intercept + + Parameter | Odds Ratio | SE | 95% CI | z | p + ------------------------------------------------------------- + 1|2 | 3.28 | 1.70 | [1.19, 9.04] | 2.30 | 0.022 + 2|3 | 9.84 | 5.03 | [3.61, 26.81] | 4.47 | < .001 + Message + + Uncertainty intervals (equal-tailed) and p-values (two-tailed) computed + using a Wald z-distribution approximation. + diff --git a/tests/testthat/test-base.R b/tests/testthat/test-base.R index a8760d9a6..6f9e6cd87 100644 --- a/tests/testthat/test-base.R +++ b/tests/testthat/test-base.R @@ -11,6 +11,12 @@ test_that("model_parameters.data.frame as draws", { expect_identical(colnames(mp), c("Parameter", "Median", "CI_low", "CI_high", "pd")) }) +test_that("model_parameters.data.frame as draws, exponentiate", { + data(iris) + mp <- suppressWarnings(model_parameters(iris[1:4], as_draws = TRUE, exponentiate = TRUE)) + expect_equal(mp$Median, c(330.29956, 20.08554, 77.47846, 3.6693), tolerance = 1e-2, ignore_attr = TRUE) +}) + # require model input test_that("model_parameters", { expect_error(model_parameters()) diff --git a/tests/testthat/test-bootstrap_emmeans.R b/tests/testthat/test-bootstrap_emmeans.R index 3036c1a91..b1b8dd3fa 100644 --- a/tests/testthat/test-bootstrap_emmeans.R +++ b/tests/testthat/test-bootstrap_emmeans.R @@ -65,7 +65,7 @@ test_that("emmeans | glmmTMB", { skip_if_not_installed("emmeans") skip_if_not_installed("boot") skip_if_not_installed("lme4") - skip_if_not_installed("glmmTMB") + suppressWarnings(skip_if_not_installed("glmmTMB")) data(Salamanders, package = "glmmTMB") model <- glmmTMB::glmmTMB(count ~ spp + mined + (1 | site), family = glmmTMB::nbinom2, data = Salamanders) diff --git a/tests/testthat/test-brms.R b/tests/testthat/test-brms.R new file mode 100644 index 000000000..4bf31749e --- /dev/null +++ b/tests/testthat/test-brms.R @@ -0,0 +1,19 @@ +skip_on_cran() +skip_on_os("mac") +skip_if_not_installed("httr2") +skip_if_not_installed("curl") +skip_if_offline() +skip_if_not_installed("withr") +skip_if_not_installed("brms") +skip_if_not_installed("rstan") + +withr::with_options( + list(parameters_warning_exponentiate = TRUE), + test_that("mp, footer exp", { + m <- suppressWarnings(insight::download_model("brms_bernoulli_1")) + out <- parameters::model_parameters(m, exponentiate = FALSE) + expect_snapshot(print(out)) + out <- parameters::model_parameters(m, exponentiate = TRUE) + expect_snapshot(print(out)) + }) +) diff --git a/tests/testthat/test-compare_parameters.R b/tests/testthat/test-compare_parameters.R index ce299dc56..029f0cf29 100644 --- a/tests/testthat/test-compare_parameters.R +++ b/tests/testthat/test-compare_parameters.R @@ -96,7 +96,7 @@ withr::with_options( test_that("compare_parameters, correct random effects", { - skip_if_not_installed("glmmTMB") + suppressWarnings(skip_if_not_installed("glmmTMB")) skip_if_not(getRversion() >= "4.0.0") data("fish") diff --git a/tests/testthat/test-equivalence_test.R b/tests/testthat/test-equivalence_test.R index cd9ab72bb..e358b690d 100644 --- a/tests/testthat/test-equivalence_test.R +++ b/tests/testthat/test-equivalence_test.R @@ -1,3 +1,5 @@ +skip_if_not_installed("bayestestR") + test_that("equivalence_test", { data(mtcars) m <- lm(mpg ~ gear + wt + cyl + hp, data = mtcars) @@ -7,3 +9,111 @@ test_that("equivalence_test", { expect_type(capture.output(equivalence_test(m)), "character") expect_snapshot(print(x)) }) + +test_that("equivalence_test, robust", { + skip_if_not_installed("sandwich") + data(mtcars) + m <- lm(mpg ~ gear + wt + cyl + hp, data = mtcars) + x <- equivalence_test(m, vcov = "HC3") + expect_snapshot(print(x)) +}) + +test_that("equivalence_test, unequal rope-range", { + data(iris) + m <- lm(Sepal.Length ~ Species, data = iris) + rez <- equivalence_test(m, range = c(-Inf, 0.1)) + expect_identical(rez$ROPE_Equivalence, c("Rejected", "Rejected", "Rejected")) + expect_identical(rez$ROPE_low, c(-Inf, -Inf, -Inf)) + + rez <- equivalence_test(m, range = c(-99, 0.1)) + expect_identical(rez$ROPE_Equivalence, c("Rejected", "Rejected", "Rejected")) + expect_identical(rez$ROPE_low, c(-99, -99, -99)) + + data(mtcars) + mtcars[c("gear", "cyl")] <- lapply(mtcars[c("gear", "cyl")], as.factor) + m <- lm(mpg ~ hp + gear + cyl, data = mtcars) + + rez <- equivalence_test(m, range = c(-Inf, 0.5)) + expect_identical( + rez$ROPE_Equivalence, + c("Rejected", "Accepted", "Undecided", "Rejected", "Accepted", "Undecided") + ) + + # validate that range of CI equals approximated normal distribution + diff_ci <- abs(diff(c(rez$CI_low[3], rez$CI_high[3]))) + set.seed(123) + out <- bayestestR::distribution_normal( + n = 1000, + mean = rez$CI_high[3] - (diff_ci / 2), + sd = (diff_ci / 2) / 3.290525 + ) + expect_equal(range(out)[1], rez$CI_low[3], tolerance = 1e-4) + expect_equal(range(out)[2], rez$CI_high[3], tolerance = 1e-4) + # need procedure for SGP here... + diff_ci <- abs(diff(c(rez$CI_low[3], rez$CI_high[3]))) + z_value <- stats::qnorm((1 + 0.95) / 2) + sd_dist <- diff_ci / diff(c(-1 * z_value, z_value)) + set.seed(123) + out <- bayestestR::distribution_normal( + n = 10000, + mean = rez$CI_high[3] - (diff_ci / 2), + sd = sd_dist + ) + expect_equal( + rez$SGPV[3], + bayestestR::rope(out, range = c(-Inf, 0.5), ci = 1)$ROPE_Percentage, + tolerance = 1e-4 + ) + + rez <- equivalence_test(m, range = c(-0.5, 0.5)) + expect_identical( + rez$ROPE_Equivalence, + c("Rejected", "Accepted", "Undecided", "Rejected", "Rejected", "Undecided") + ) + + rez <- equivalence_test(m, range = c(-2, 2)) + expect_identical( + rez$ROPE_Equivalence, + c("Rejected", "Accepted", "Undecided", "Rejected", "Rejected", "Undecided") + ) +}) + +test_that("equivalence_test, unequal rope-range, plots", { + skip_on_cran() + skip_if_not_installed("vdiffr") + data(iris) + m <- lm(Sepal.Length ~ Species, data = iris) + rez <- equivalence_test(m, range = c(-Inf, 0.1)) + vdiffr::expect_doppelganger( + "Equivalence-Test 1", + plot(rez) + ) + + rez <- equivalence_test(m, range = c(-99, 0.1)) + vdiffr::expect_doppelganger( + "Equivalence-Test 2", + plot(rez) + ) + + data(mtcars) + mtcars[c("gear", "cyl")] <- lapply(mtcars[c("gear", "cyl")], as.factor) + m <- lm(mpg ~ hp + gear + cyl, data = mtcars) + + rez <- equivalence_test(m, range = c(-Inf, 0.5)) + vdiffr::expect_doppelganger( + "Equivalence-Test 3", + plot(rez) + ) + + rez <- equivalence_test(m, range = c(-0.5, 0.5)) + vdiffr::expect_doppelganger( + "Equivalence-Test 4", + plot(rez) + ) + + rez <- equivalence_test(m, range = c(-2, 2)) + vdiffr::expect_doppelganger( + "Equivalence-Test 5", + plot(rez) + ) +}) diff --git a/tests/testthat/test-glmmTMB.R b/tests/testthat/test-glmmTMB.R index a8d80751f..0ccb75779 100644 --- a/tests/testthat/test-glmmTMB.R +++ b/tests/testthat/test-glmmTMB.R @@ -683,5 +683,23 @@ withr::with_options( mp <- model_parameters(m1, effects = "all", verbose = FALSE) expect_snapshot(mp) }) + + test_that("print-model_parameters, random dispersion", { + data(Salamanders, package = "glmmTMB") + m <- glmmTMB::glmmTMB( + count ~ spp + cover + mined + (1 | site), + ziformula = ~ spp + mined, + dispformula = ~ DOY + (1 | site), + data = Salamanders, + family = glmmTMB::nbinom1() + ) + out <- as.data.frame(model_parameters(m, effects = "fixed", component = "all")) + expect_identical(nrow(out), 19L) + out <- as.data.frame(model_parameters(m, effects = "random", component = "all")) + expect_identical(nrow(out), 1L) + out <- as.data.frame(model_parameters(m, effects = "random", component = "all", group_level = TRUE)) + expect_identical(nrow(out), 46L) + expect_equal(out$Coefficient, unlist(glmmTMB::ranef(m)), ignore_attr = TRUE, tolerance = 1e-4) + }) } ) diff --git a/tests/testthat/test-helper.R b/tests/testthat/test-helper.R index e9d2728a0..8b39b20e0 100644 --- a/tests/testthat/test-helper.R +++ b/tests/testthat/test-helper.R @@ -1,7 +1,7 @@ skip_on_cran() skip_if_not_installed("withr") withr::with_options( - list(easystats_erros = TRUE), + list(easystats_errors = TRUE), test_that(".safe works with options", { expect_error(parameters:::.safe(mean(fd)), regex = "object 'fd' not found") expect_identical(parameters:::.safe(mean(fd), 1L), 1L) diff --git a/tests/testthat/test-marginaleffects.R b/tests/testthat/test-marginaleffects.R index 22853e264..538e85737 100644 --- a/tests/testthat/test-marginaleffects.R +++ b/tests/testthat/test-marginaleffects.R @@ -5,13 +5,11 @@ skip_if_not_installed("rstanarm") test_that("marginaleffects()", { # Frequentist x <- lm(Sepal.Width ~ Species * Petal.Length, data = iris) - model <- marginaleffects::avg_slopes(x, newdata = insight::get_datagrid(x, at = "Species"), variables = "Petal.Length") + model <- marginaleffects::avg_slopes(x, newdata = insight::get_datagrid(x, by = "Species"), variables = "Petal.Length") out <- parameters(model) expect_identical(nrow(out), 1L) - expect_named(out, c( - "Parameter", "Coefficient", "SE", "Statistic", - "p", "S", "CI", "CI_low", "CI_high" - )) + cols <- c("Parameter", "Comparison", "Coefficient", "SE", "Statistic", "p", "S", "CI", "CI_low", "CI_high") + expect_true(all(cols %in% colnames(out))) out <- model_parameters(model, exponentiate = TRUE) expect_equal(out$Coefficient, 1.394, tolerance = 1e-3) @@ -25,7 +23,7 @@ test_that("marginaleffects()", { chains = 1 ) ) - model <- marginaleffects::avg_slopes(x, newdata = insight::get_datagrid(x, at = "Species"), variables = "Petal.Length") + model <- marginaleffects::avg_slopes(x, newdata = insight::get_datagrid(x, by = "Species"), variables = "Petal.Length") expect_identical(nrow(parameters(model)), 1L) }) @@ -48,7 +46,7 @@ test_that("comparisons()", { data(iris) # Frequentist x <- lm(Sepal.Width ~ Species * Petal.Length, data = iris) - m <- marginaleffects::avg_comparisons(x, newdata = insight::get_datagrid(x, at = "Species"), variables = "Petal.Length") + m <- marginaleffects::avg_comparisons(x, newdata = insight::get_datagrid(x, by = "Species"), variables = "Petal.Length") expect_identical(nrow(parameters(m)), 1L) out <- parameters(m, exponentiate = TRUE) expect_equal(out$Coefficient, 1.393999, tolerance = 1e-4) @@ -65,7 +63,7 @@ test_that("comparisons()", { ) m <- marginaleffects::avg_slopes( x, - newdata = insight::get_datagrid(x, at = "Species"), + newdata = insight::get_datagrid(x, by = "Species"), variables = "Petal.Length" ) expect_identical(nrow(parameters(m)), 1L) @@ -87,7 +85,7 @@ test_that("multiple contrasts: Issue #779", { cmp <- suppressWarnings(marginaleffects::comparisons( mod, variables = c("gear", "cyl"), - newdata = insight::get_datagrid(mod, at = c("gear", "cyl")), + newdata = insight::get_datagrid(mod, by = c("gear", "cyl")), cross = TRUE )) cmp <- suppressWarnings(parameters(cmp)) diff --git a/tests/testthat/test-model_parameters.BFBayesFactor.R b/tests/testthat/test-model_parameters.BFBayesFactor.R index 6acabdb50..14dfb8474 100644 --- a/tests/testthat/test-model_parameters.BFBayesFactor.R +++ b/tests/testthat/test-model_parameters.BFBayesFactor.R @@ -84,7 +84,7 @@ test_that("model_parameters.BFBayesFactor", { centrality = "mean", dispersion = TRUE, verbose = FALSE, - effectsize_type = "cramers_v", + es_type = "cramers_v", adjust = TRUE, include_proportions = TRUE )) @@ -158,7 +158,7 @@ test_that("model_parameters.BFBayesFactor, with effectsize", { skip_if_not_installed("BayesFactor") set.seed(123) df_t_es <- as.data.frame( - parameters(BayesFactor::ttestBF(mtcars$wt, mu = 3), effectsize_type = "cohens_d") + parameters(BayesFactor::ttestBF(mtcars$wt, mu = 3), es_type = "cohens_d") ) # TODO: fix column order diff --git a/tests/testthat/test-model_parameters.anova.R b/tests/testthat/test-model_parameters.anova.R index 9533031d4..3573a7b2e 100644 --- a/tests/testthat/test-model_parameters.anova.R +++ b/tests/testthat/test-model_parameters.anova.R @@ -22,6 +22,15 @@ test_that("model_parameters.anova", { expect_equal(mp[["F"]], c(53.40138, 60.42944, 13.96887, NA), tolerance = 1e-3) }) +test_that("model_parameters.anova for mixed models", { + skip_if_not_installed("lme4") + skip_if_not_installed("lmerTest") + m <- lmerTest::lmer(mpg ~ wt + (1 | gear), data = mtcars) + out <- parameters::model_parameters(anova(m)) + expect_named(out, c("Parameter", "Sum_Squares", "df", "df_error", "Mean_Square", "F", "p")) + expect_equal(out$df_error, 21.92272, tolerance = 1e-4) +}) + test_that("linear hypothesis tests", { skip_if_not_installed("car") skip_if_not_installed("carData") @@ -39,12 +48,16 @@ test_that("linear hypothesis tests", { expect_equal(p1, p3, ignore_attr = TRUE) expect_equal(p1, p4, ignore_attr = TRUE) expect_identical(nrow(p1), 2L) - expect_identical(p1$Parameter, c("(Intercept) = 0", "repwt = 1")) + ## FIXME: this has changed since {car} 3.1.3 + # expect_identical(p1$Parameter, c("(Intercept) = 0", "repwt = 1")) + expect_identical(p1$Parameter, c("1", "2")) mod.duncan <- lm(prestige ~ income + education, data = Duncan) p <- parameters(car::linearHypothesis(mod.duncan, "1*income - 1*education + 1 = 1")) - expect_identical(nrow(p), 1L) - expect_identical(p$Parameter, "income - education = 0") + expect_identical(nrow(p), 2L) + ## FIXME: this has changed since {car} 3.1.3 + # expect_identical(p$Parameter, "income - education = 0") + expect_identical(p1$Parameter, c("1", "2")) }) test_that("print-model_parameters", { @@ -94,7 +107,7 @@ test_that("model_parameters_Anova-effectsize", { # parameters table including effect sizes mp <- model_parameters( model, - effectsize_type = "eta", + es_type = "eta", ci = 0.9, df_error = dof_satterthwaite(mm)[2:3] ) diff --git a/tests/testthat/test-model_parameters.aov.R b/tests/testthat/test-model_parameters.aov.R index 09e40803a..88ac9d790 100644 --- a/tests/testthat/test-model_parameters.aov.R +++ b/tests/testthat/test-model_parameters.aov.R @@ -1,14 +1,14 @@ skip_on_cran() -iris$Cat1 <- rep(c("X", "X", "Y"), length.out = nrow(iris)) -iris$Cat2 <- rep(c("A", "B"), length.out = nrow(iris)) +iris$Cat1 <- rep_len(c("X", "X", "Y"), nrow(iris)) +iris$Cat2 <- rep_len(c("A", "B"), nrow(iris)) # aov ---------------------------------- test_that("model_parameters.aov", { skip_if_not_installed("effectsize", minimum_version = "0.5.0") model <- aov(Sepal.Width ~ Species, data = iris) - mp <- suppressMessages(model_parameters(model, effectsize_type = c("omega", "eta", "epsilon"))) + mp <- suppressMessages(model_parameters(model, es_type = c("omega", "eta", "epsilon"))) expect_identical(mp$Parameter, c("Species", "Residuals")) expect_equal(mp$Sum_Squares, c(11.34493, 16.962), tolerance = 1e-3) }) @@ -16,7 +16,7 @@ test_that("model_parameters.aov", { test_that("model_parameters.aov", { skip_if_not_installed("effectsize", minimum_version = "0.5.0") model <- aov(Sepal.Width ~ Species, data = iris) - mp <- suppressMessages(model_parameters(model, effectsize_type = c("omega", "eta", "epsilon"))) + mp <- suppressMessages(model_parameters(model, es_type = c("omega", "eta", "epsilon"))) expect_identical(sum(mp$df), 149) expect_named(mp, c( "Parameter", "Sum_Squares", "df", "Mean_Square", "F", "p", @@ -24,7 +24,7 @@ test_that("model_parameters.aov", { )) model <- aov(Sepal.Length ~ Species * Cat1 * Cat2, data = iris) - expect_identical(sum(model_parameters(model, effectsize_type = c("omega", "eta", "epsilon"), verbose = FALSE)$df), 149) + expect_identical(sum(model_parameters(model, es_type = c("omega", "eta", "epsilon"), verbose = FALSE)$df), 149) model <- aov(Sepal.Length ~ Species / Cat1 * Cat2, data = iris) expect_identical(sum(model_parameters(model, verbose = FALSE)$df), 149) @@ -58,7 +58,7 @@ test_that("model_parameters.anova", { test_that("model_parameters.anova", { skip_if_not_installed("curl") skip_if_offline() - skip_if_not_installed("httr") + skip_if_not_installed("httr2") model <- insight::download_model("anova_3") expect_identical(sum(model_parameters(model, verbose = FALSE)$df), 149L) diff --git a/tests/testthat/test-model_parameters.aov_es_ci.R b/tests/testthat/test-model_parameters.aov_es_ci.R index 826f895f2..7beda64f4 100644 --- a/tests/testthat/test-model_parameters.aov_es_ci.R +++ b/tests/testthat/test-model_parameters.aov_es_ci.R @@ -1,5 +1,5 @@ -iris$Cat1 <- rep(c("X", "X", "Y"), length.out = nrow(iris)) -iris$Cat2 <- rep(c("A", "B"), length.out = nrow(iris)) +iris$Cat1 <- rep_len(c("X", "X", "Y"), nrow(iris)) +iris$Cat2 <- rep_len(c("A", "B"), nrow(iris)) # aov ---------------------------------- @@ -9,7 +9,7 @@ test_that("model_parameters.aov", { model <- aov(Sepal.Width ~ Species, data = iris) mp <- suppressMessages(model_parameters( model, - effectsize_type = c("omega", "eta", "epsilon"), + es_type = c("omega", "eta", "epsilon"), ci = 0.9, alternative = "greater" )) @@ -28,7 +28,7 @@ test_that("model_parameters.aov", { )) model <- aov(Sepal.Length ~ Species * Cat1 * Cat2, data = iris) - mp <- model_parameters(model, effectsize_type = "eta", ci = 0.9, partial = FALSE, alternative = "greater") + mp <- model_parameters(model, es_type = "eta", ci = 0.9, partial = FALSE, alternative = "greater") es <- effectsize::eta_squared(model, partial = FALSE, ci = 0.9) expect_equal(na.omit(mp$Eta2_CI_low), es$CI_low, tolerance = 1e-3, ignore_attr = TRUE) expect_equal(mp$Eta2_CI_low, c(0.5572, 0, 0, 0, 0, 0, 0, NA), tolerance = 1e-3, ignore_attr = TRUE) @@ -53,7 +53,7 @@ test_that("model_parameters.anova", { model <- anova(lm(Sepal.Length ~ Species * Cat1 * Cat2, data = iris)) mp <- model_parameters( model, - effectsize_type = c("omega", "eta", "epsilon"), + es_type = c("omega", "eta", "epsilon"), partial = TRUE, ci = 0.9, alternative = "greater" @@ -75,7 +75,7 @@ test_that("model_parameters.anova", { skip_if_not_installed("effectsize", minimum_version = "0.5.1") model <- aov(wt ~ cyl + Error(gear), data = mtcars) suppressWarnings({ - mp <- model_parameters(model, effectsize_type = c("omega", "eta", "epsilon"), partial = TRUE, ci = 0.9) + mp <- model_parameters(model, es_type = c("omega", "eta", "epsilon"), partial = TRUE, ci = 0.9) es <- effectsize::omega_squared(model, partial = TRUE, ci = 0.9, verbose = FALSE) }) expect_equal(na.omit(mp$Omega2_CI_low), es$CI_low[2], tolerance = 1e-3, ignore_attr = TRUE) @@ -107,7 +107,7 @@ test_that("model_parameters.car-anova", { contrasts = list(fcategory = contr.sum, partner.status = contr.sum) )) - mp <- model_parameters(model, effectsize_type = c("omega", "eta", "epsilon"), partial = TRUE, ci = 0.9) + mp <- model_parameters(model, es_type = c("omega", "eta", "epsilon"), partial = TRUE, ci = 0.9) es <- effectsize::omega_squared(model, partial = TRUE, ci = 0.9) expect_equal(na.omit(mp$Omega2_CI_low), es$CI_low, tolerance = 1e-3, ignore_attr = TRUE) expect_equal(mp$Omega2_CI_low, c(0, 0.05110, 0.00666, NA), tolerance = 1e-3, ignore_attr = TRUE) @@ -133,7 +133,7 @@ test_that("model_parameters.maov", { mp <- suppressMessages(model_parameters( model, - effectsize_type = c("omega", "eta", "epsilon"), + es_type = c("omega", "eta", "epsilon"), partial = TRUE, ci = 0.9 )) @@ -165,7 +165,7 @@ test_that("works with aov", { df_aov <- as.data.frame(parameters::model_parameters(npk.aov, ci = 0.95, - effectsize_type = c("eta", "omega"), + es_type = c("eta", "omega"), partial = FALSE )) @@ -271,7 +271,8 @@ test_that("works with manova", { set.seed(123) # fake a 2nd response variable - npk2 <- within(npk, foo <- rnorm(24)) + foo <- rnorm(24) + npk2 <- within(npk, foo) # model m <- manova(cbind(yield, foo) ~ block + N * P * K, npk2) @@ -280,7 +281,7 @@ test_that("works with manova", { df_manova <- as.data.frame(model_parameters(m, ci = 0.99, - effectsize_type = c("epsilon", "omega"), + es_type = c("epsilon", "omega"), partial = TRUE )) @@ -333,7 +334,7 @@ test_that("works with Gam", { df_Gam <- as.data.frame(model_parameters(g, ci = 0.50, - effectsize_type = "omega", + es_type = "omega", partial = TRUE )) @@ -345,7 +346,7 @@ test_that("works with Gam", { Sum_Squares = c(678.37287, 202.23503, 6.87905, 238.56023), df = c(1, 1, 1, 28), Mean_Square = c(678.37287, 202.23503, 6.87905, 8.52001), - `F` = c(79.62115, 23.73648, 0.8074, NA), + `F` = c(79.62115, 23.73648, 0.8074, NA), # nolint p = c(0, 4e-05, 0.37655, NA), Omega2_partial = c(0.71072, 0.41538, -0.00606, NA), Omega2_CI_low = c(0.70634, 0.41067, 0, NA), @@ -384,7 +385,7 @@ test_that("works with anova", { df_car <- as.data.frame(model_parameters(mod, ci = 0.89, - effectsize_type = c("eta", "epsilon"), + es_type = c("eta", "epsilon"), partial = FALSE )) diff --git a/tests/testthat/test-model_parameters.blmerMod.R b/tests/testthat/test-model_parameters.blmerMod.R index 77308e385..fde18e5ea 100644 --- a/tests/testthat/test-model_parameters.blmerMod.R +++ b/tests/testthat/test-model_parameters.blmerMod.R @@ -8,8 +8,8 @@ model <- blme::blmer(Reaction ~ Days + (1 + Days | Subject), data = sleepstudy, test_that("model_parameters.blmerMod", { params <- model_parameters(model, effects = "fixed") expect_equal(params$SE, c(6.8246, 1.54579), tolerance = 1e-3) - expect_equal( - colnames(params), + expect_named( + params, c("Parameter", "Coefficient", "SE", "CI", "CI_low", "CI_high", "t", "df_error", "p", "Effects") ) }) @@ -19,11 +19,11 @@ test_that("model_parameters.blmerMod-all", { params <- model_parameters(model, effects = "all") expect_equal(params$SE, c(6.8246, 1.54579, 5.83626, 1.24804, 0.31859, 1.50801), tolerance = 1e-3) expect_equal(params$Coefficient, c(251.4051, 10.46729, 24.74066, 5.92214, 0.06555, 25.5918), tolerance = 1e-3) - expect_equal( - colnames(params), + expect_named( + params, c("Parameter", "Coefficient", "SE", "CI", "CI_low", "CI_high", "t", "df_error", "p", "Effects", "Group") ) - expect_equal( + expect_identical( params$Parameter, c("(Intercept)", "Days", "SD (Intercept)", "SD (Days)", "Cor (Intercept~Days)", "SD (Observations)") ) diff --git a/tests/testthat/test-model_parameters.coxme.R b/tests/testthat/test-model_parameters.coxme.R index 6c2f1000b..e64af9d92 100644 --- a/tests/testthat/test-model_parameters.coxme.R +++ b/tests/testthat/test-model_parameters.coxme.R @@ -1,18 +1,21 @@ skip_on_cran() skip_if_not_installed("coxme") skip_if_not_installed("survival") +skip_if_not_installed("withr") # modelparameters ---------------------------------- -test_that("model_parameters.coxme", { - data(eortc, package = "coxme") - d <- coxme::eortc - d$surv <- survival::Surv(d$y, d$uncens) - m1 <- coxme::coxme(surv ~ trt + (1 | center), data = d) - out <- model_parameters(m1) - expect_named( - out, - c("Parameter", "Coefficient", "SE", "CI", "CI_low", "CI_high", "z", "df_error", "p") - ) - expect_equal(out$Coefficient, 0.7086127, tolerance = 1e-4) -}) +## TODO: works only interactively + +# test_that("model_parameters.coxme", { +# data(eortc, package = "coxme") +# d <- coxme::eortc +# d$surv <- survival::Surv(d$y, d$uncens) +# m1 <- coxme::coxme(surv ~ trt + (1 | center), data = d) +# out <- model_parameters(m1) +# expect_named( +# out, +# c("Parameter", "Coefficient", "SE", "CI", "CI_low", "CI_high", "z", "df_error", "p") +# ) +# expect_equal(out$Coefficient, 0.7086127, tolerance = 1e-4) +# }) diff --git a/tests/testthat/test-model_parameters.fixest.R b/tests/testthat/test-model_parameters.fixest.R index 87d32810c..567ba491f 100644 --- a/tests/testthat/test-model_parameters.fixest.R +++ b/tests/testthat/test-model_parameters.fixest.R @@ -16,7 +16,7 @@ test_that("model_parameters.fixest", { qol_cancer <- cbind( qol_cancer, - datawizard::demean(qol_cancer, select = c("phq4", "QoL"), group = "ID") + datawizard::demean(qol_cancer, select = c("phq4", "QoL"), by = "ID") ) m1 <- fixest::feols(QoL ~ time + phq4 | ID, data = qol_cancer) @@ -35,7 +35,7 @@ test_that("model_parameters.fixest", { # currently, a bug for fixest 10.4 on R >= 4.3 # skip_if_not(getRversion() < "4.2.0") expect_snapshot( - model_parameters(m1, summary = TRUE, verbose = FALSE) + model_parameters(m1, include_info = TRUE, verbose = FALSE) ) # Poission, df = Inf diff --git a/tests/testthat/test-model_parameters.glm.R b/tests/testthat/test-model_parameters.glm.R index c5cebbb75..969a7a6f3 100644 --- a/tests/testthat/test-model_parameters.glm.R +++ b/tests/testthat/test-model_parameters.glm.R @@ -36,10 +36,10 @@ test_that("print digits model_parameters.lm", { skip_if_not_installed("performance") model <- lm(mpg ~ wt, data = mtcars) - params <- model_parameters(model, summary = TRUE, verbose = FALSE) + params <- model_parameters(model, include_info = TRUE, verbose = FALSE) expect_snapshot(params) - params <- model_parameters(model, summary = FALSE, verbose = FALSE) + params <- model_parameters(model, include_info = FALSE, verbose = FALSE) expect_snapshot(params) }) diff --git a/tests/testthat/test-model_parameters.glmgee.R b/tests/testthat/test-model_parameters.glmgee.R new file mode 100644 index 000000000..8f9ec5607 --- /dev/null +++ b/tests/testthat/test-model_parameters.glmgee.R @@ -0,0 +1,19 @@ +skip_on_cran() +skip_if_not_installed("glmtoolbox") +skip_if_not_installed("withr") + +withr::with_options( + list(parameters_exponentiate = FALSE), + test_that("model_parameters.glmgee", { + data(spruces, package = "glmtoolbox") + fit1 <- glmtoolbox::glmgee( + size ~ poly(days, 4) + treat, + id = tree, + family = Gamma("log"), + corstr = "AR-M-dependent(1)", + data = spruces + ) + out <- model_parameters(fit1) + expect_snapshot(print(out)) + }) +) diff --git a/tests/testthat/test-model_parameters.htest.R b/tests/testthat/test-model_parameters.htest.R index 3e63d9c28..dad34b4b5 100644 --- a/tests/testthat/test-model_parameters.htest.R +++ b/tests/testthat/test-model_parameters.htest.R @@ -4,8 +4,8 @@ skip_if_not_installed("effectsize") test_that("model_parameters.htest", { params <- model_parameters(cor.test(mtcars$mpg, mtcars$cyl, method = "pearson")) - expect_equal( - colnames(params), + expect_named( + params, c( "Parameter1", "Parameter2", "r", "CI", "CI_low", "CI_high", "t", "df_error", "p", "Method", "Alternative" @@ -13,10 +13,14 @@ test_that("model_parameters.htest", { ) expect_equal(params$r, -0.852, tolerance = 0.05) - expect_warning(params <- model_parameters(cor.test(mtcars$mpg, mtcars$cyl, method = "spearman"))) + expect_warning({ + params <- model_parameters(cor.test(mtcars$mpg, mtcars$cyl, method = "spearman")) + }) expect_equal(params$rho, -0.9108, tolerance = 0.05) - expect_warning(params <- model_parameters(cor.test(mtcars$mpg, mtcars$cyl, method = "kendall"))) + expect_warning({ + params <- model_parameters(cor.test(mtcars$mpg, mtcars$cyl, method = "kendall")) + }) expect_equal(params$tau, -0.795, tolerance = 0.05) params <- model_parameters(t.test(iris$Sepal.Width, iris$Sepal.Length)) @@ -32,21 +36,21 @@ test_that("model_parameters.htest", { test_that("model_parameters.htest-2", { x <- c(A = 20, B = 15, C = 25) mp <- model_parameters(chisq.test(x)) - expect_equal(colnames(mp), c("Chi2", "df", "p", "Method")) + expect_named(mp, c("Chi2", "df", "p", "Method")) }) test_that("model_parameters-chisq-test NULL", { mp <- model_parameters(stats::chisq.test(table(mtcars$am))) expect_equal(mp$Chi2, 1.125, tolerance = 1e-3) - expect_equal(colnames(mp), c("Chi2", "df", "p", "Method")) + expect_named(mp, c("Chi2", "df", "p", "Method")) }) test_that("model_parameters-chisq-test two way table", { mp2 <- suppressWarnings(model_parameters(stats::chisq.test(table(mtcars$am, mtcars$cyl)))) expect_equal(mp2$Chi2, 8.740733, tolerance = 1e-3) - expect_equal(colnames(mp2), c("Chi2", "df", "p", "Method")) + expect_named(mp2, c("Chi2", "df", "p", "Method")) }) test_that("model_parameters-chisq-test works with `svychisq` objects", { @@ -59,21 +63,23 @@ test_that("model_parameters-chisq-test works with `svychisq` objects", { mp <- model_parameters(m) expect_equal(mp$F, 5.19337, tolerance = 1e-3) - expect_equal(names(mp), c("F", "df", "df_error", "p", "Method")) + expect_named(mp, c("F", "df", "df_error", "p", "Method")) }) test_that("model_parameters-chisq-test adjusted", { - expect_message(mp <- model_parameters(stats::chisq.test(table(mtcars$am)), effectsize_type = "phi", ci = 0.95)) + expect_message({ + mp <- model_parameters(stats::chisq.test(table(mtcars$am)), es_type = "phi", ci = 0.95) + }) expect_equal(mp$Chi2, 1.125, tolerance = 1e-3) - expect_equal(colnames(mp), c("Chi2", "df", "p", "Method")) + expect_named(mp, c("Chi2", "df", "p", "Method")) }) test_that("model_parameters-t-test standardized d", { - params <- model_parameters(t.test(iris$Sepal.Width, iris$Sepal.Length), effectsize_type = "cohens_d") + params <- model_parameters(t.test(iris$Sepal.Width, iris$Sepal.Length), es_type = "cohens_d") expect_equal(params$Cohens_d, -4.210417, tolerance = 0.05) expect_equal(params$d_CI_low, -4.655306, tolerance = 0.05) - expect_equal( - colnames(params), + expect_named( + params, c( "Parameter1", "Parameter2", "Mean_Parameter1", "Mean_Parameter2", "Difference", "CI", "CI_low", "CI_high", "Cohens_d", "d_CI_low", @@ -83,10 +89,10 @@ test_that("model_parameters-t-test standardized d", { }) test_that("model_parameters-t-test standardized d", { - mp <- model_parameters(t.test(mtcars$mpg ~ mtcars$vs), effectsize_type = "cohens_d", verbose = FALSE) + mp <- model_parameters(t.test(mtcars$mpg ~ mtcars$vs), es_type = "cohens_d", verbose = FALSE) expect_equal(mp$Cohens_d, -1.696032, tolerance = 1e-3) - expect_equal( - colnames(mp), + expect_named( + mp, c( "Parameter", "Group", "Mean_Group1", "Mean_Group2", "Difference", "CI", "CI_low", "CI_high", "Cohens_d", "d_CI_low", "d_CI_high", "t", "df_error", @@ -102,5 +108,21 @@ test_that("model_parameters-t-test reports the same unregarding of interface", { compare_only <- c("Difference", "CI", "CI_low", "CI_high", "t", "df_error", "p", "Method") default_ttest <- model_parameters(t.test(x = g1, y = g2))[compare_only] formula_ttest <- model_parameters(t.test(y ~ x, df))[compare_only] - expect_equal(default_ttest, formula_ttest) + expect_equal(default_ttest, formula_ttest, ignore_attr = TRUE) +}) + +test_that("model_parameters-Box.test works, and ignores partial matching", { + set.seed(123) + ts1 <- ts(rnorm(200, mean = 10, sd = 3)) + result1 <- Box.test(ts1, lag = 5, type = "Box-Pierce", fitdf = 2) + result2 <- Box.test(ts1, lag = 5, type = "Ljung-Box", fitdf = 2) + + out1 <- model_parameters(result1) + out2 <- model_parameters(result1, effects = "all") + expect_equal(out1, out2, ignore_attr = TRUE) + expect_named(out1, c("Parameter", "Chi2", "df_error", "p", "Method")) + + out1 <- model_parameters(result2) + out2 <- model_parameters(result2, effects = "all") + expect_equal(out1, out2, ignore_attr = TRUE) }) diff --git a/tests/testthat/test-model_parameters.mclogit.R b/tests/testthat/test-model_parameters.mclogit.R index 8d4b0384a..924baf4cc 100644 --- a/tests/testthat/test-model_parameters.mclogit.R +++ b/tests/testthat/test-model_parameters.mclogit.R @@ -31,5 +31,12 @@ withr::with_options( params <- model_parameters(m2) expect_snapshot(params) }) + + skip_on_os(c("mac", "linux")) + test_that("simulate_parameters.mblogit", { + set.seed(1234) + params <- simulate_parameters(m2) + expect_snapshot(params) + }) } ) diff --git a/tests/testthat/test-model_parameters.mixed.R b/tests/testthat/test-model_parameters.mixed.R index 355d5c183..4f7ddc432 100644 --- a/tests/testthat/test-model_parameters.mixed.R +++ b/tests/testthat/test-model_parameters.mixed.R @@ -108,7 +108,7 @@ test_that("model_parameters.mixed-all_pars", { data("qol_cancer") qol_cancer <- cbind( qol_cancer, - demean(qol_cancer, select = c("phq4", "QoL"), group = "ID") + demean(qol_cancer, select = c("phq4", "QoL"), by = "ID") ) model <- lme4::lmer( QoL ~ time + phq4_within + phq4_between + (1 | ID), @@ -129,5 +129,5 @@ test_that("print-model_parameters", { skip_if_not_installed("merDeriv") expect_snapshot(model_parameters(m1, effects = "all")) - expect_snapshot(model_parameters(m1, effects = "fixed", summary = TRUE)) + expect_snapshot(model_parameters(m1, effects = "fixed", include_info = TRUE)) }) diff --git a/tests/testthat/test-model_parameters_robust.R b/tests/testthat/test-model_parameters_robust.R index 2d4564cf5..c5a18e5bb 100644 --- a/tests/testthat/test-model_parameters_robust.R +++ b/tests/testthat/test-model_parameters_robust.R @@ -8,41 +8,31 @@ model <- lm(mpg ~ wt * am + cyl + gear, data = mtcars) test_that("model_parameters, robust CL", { params1 <- model_parameters( model, - robust = TRUE, - vcov_estimation = "CL", - vcov_type = "HC1", - verbose = FALSE - ) - params2 <- model_parameters( - model, - robust = TRUE, - vcov_estimation = "CL", + vcov = "CL", vcov_args = list(type = "HC1"), verbose = FALSE ) robust_se <- unname(sqrt(diag(sandwich::vcovCL(model)))) expect_equal(params1$SE, robust_se, tolerance = 1e-3) expect_equal(params1$p, c(0, 0.00695, 0.00322, 0.00435, 0.94471, 0.00176), tolerance = 1e-3) - expect_equal(params2$SE, robust_se, tolerance = 1e-3) - expect_equal(params2$p, c(0, 0.00695, 0.00322, 0.00435, 0.94471, 0.00176), tolerance = 1e-3) }) test_that("model_parameters, robust", { - params <- model_parameters(model, robust = TRUE, verbose = FALSE) + params <- model_parameters(model, vcov = "HC", verbose = FALSE) robust_se <- unname(sqrt(diag(sandwich::vcovHC(model)))) expect_equal(params$SE, robust_se, tolerance = 1e-3) expect_equal(params$p, c(0, 0.0259, 0.01478, 0.01197, 0.95238, 0.01165), tolerance = 1e-3) }) test_that("ci, robust", { - params <- ci(model, robust = TRUE, verbose = FALSE) + params <- ci(model, vcov = "HC", verbose = FALSE) robust_se <- unname(sqrt(diag(sandwich::vcovHC(model)))) upper_ci <- as.vector(coef(model) + qt(0.975, df.residual(model)) * robust_se) expect_equal(params$CI_high, upper_ci, tolerance = 1e-3, ignore_attr = TRUE) }) test_that("model_parameters, robust CL", { - params <- model_parameters(model, robust = TRUE, vcov_estimation = "CL", vcov_type = "HC1", verbose = FALSE) + params <- model_parameters(model, vcov = "vcovCL", verbose = FALSE) robust_se <- unname(sqrt(diag(sandwich::vcovCL(model)))) expect_equal(params$SE, robust_se, tolerance = 1e-3) expect_equal(params$p, c(0, 0.00695, 0.00322, 0.00435, 0.94471, 0.00176), tolerance = 1e-3) @@ -51,7 +41,7 @@ test_that("model_parameters, robust CL", { model2 <- lm(mpg ~ wt * am + cyl + gear, data = datawizard::standardize(mtcars)) test_that("model_parameters, robust", { - params <- model_parameters(model, standardize = "refit", robust = TRUE, verbose = FALSE) + params <- model_parameters(model, standardize = "refit", vcov = "HC", verbose = FALSE) robust_se <- unname(sqrt(diag(sandwich::vcovHC(model2)))) expect_equal(params$SE, robust_se, tolerance = 1e-3) expect_equal(params$p, c(0.28624, 0.0259, 0.43611, 0.01197, 0.95238, 0.01165), tolerance = 1e-3) @@ -67,8 +57,7 @@ test_that("model_parameters, robust CR", { params <- model_parameters( model, robust = TRUE, - vcov_estimation = "CR", - vcov_type = "CR1", + vcov = "CR1", vcov_args = list(cluster = iris$cluster), verbose = FALSE ) @@ -86,57 +75,55 @@ data(mtcars) mtcars$am <- as.factor(mtcars$am) model <- lm(mpg ~ wt * am + cyl + gear, data = mtcars) -if (packageVersion("parameters") >= "0.17.0") { - test_that("model_parameters, robust", { - expect_warning(expect_warning(expect_warning(model_parameters(model, robust = TRUE)))) - params <- model_parameters(model, vcov = "HC3") - robust_se <- unname(sqrt(diag(sandwich::vcovHC(model)))) - expect_equal(params$SE, robust_se, tolerance = 1e-3) - expect_equal(params$p, c(0, 0.0259, 0.01478, 0.01197, 0.95238, 0.01165), tolerance = 1e-3) - }) - - test_that("ci, robust", { - params <- ci(model, vcov = "HC3") - robust_se <- unname(sqrt(diag(sandwich::vcovHC(model)))) - upper_ci <- as.vector(coef(model) + qt(0.975, df.residual(model)) * robust_se) - expect_equal(params$CI_high, upper_ci, tolerance = 1e-3, ignore_attr = TRUE) - }) - - test_that("model_parameters, robust CL", { - params <- model_parameters(model, vcov = "vcovCL", vcov_args = list(type = "HC1")) - robust_se <- unname(sqrt(diag(sandwich::vcovCL(model)))) - expect_equal(params$SE, robust_se, tolerance = 1e-3) - expect_equal(params$p, c(0, 0.00695, 0.00322, 0.00435, 0.94471, 0.00176), tolerance = 1e-3) - }) - - d <- datawizard::standardize(mtcars) - model2 <- lm(mpg ~ wt * am + cyl + gear, data = d) - - test_that("model_parameters, robust", { - params <- model_parameters(model, standardize = "refit", vcov = "HC3") - robust_se <- unname(sqrt(diag(sandwich::vcovHC(model2)))) - expect_equal(params$SE, robust_se, tolerance = 1e-3) - expect_equal(params$p, c(0.28624, 0.0259, 0.43611, 0.01197, 0.95238, 0.01165), tolerance = 1e-3) - }) - - - # cluster-robust standard errors, using clubSandwich - data(iris) - model <- lm(Petal.Length ~ Sepal.Length * Species, data = iris) - iris$cluster <- factor(rep(LETTERS[1:8], length.out = nrow(iris))) - - test_that("model_parameters, robust CR", { - params <- model_parameters(model, vcov = "vcovCR", vcov_args = list(type = "CR1", cluster = iris$cluster)) - robust_se <- unname(sqrt(diag(clubSandwich::vcovCR(model, type = "CR1", cluster = iris$cluster)))) - expect_equal(params$SE, robust_se, tolerance = 1e-3) - expect_equal(params$p, c(0.01246, 0.04172, 0.18895, 0.57496, 0, 0), tolerance = 1e-3) - }) - - test_that("model_parameters, normal", { - params <- model_parameters(model) - expect_equal(params$p, c(0.13267, 0.21557, 0.36757, 0.77012, 3e-05, 0), tolerance = 1e-3) - }) -} +test_that("model_parameters, robust", { + expect_warning(expect_warning(expect_warning(model_parameters(model, robust = TRUE)))) + params <- model_parameters(model, vcov = "HC3") + robust_se <- unname(sqrt(diag(sandwich::vcovHC(model)))) + expect_equal(params$SE, robust_se, tolerance = 1e-3) + expect_equal(params$p, c(0, 0.0259, 0.01478, 0.01197, 0.95238, 0.01165), tolerance = 1e-3) +}) + +test_that("ci, robust", { + params <- ci(model, vcov = "HC3") + robust_se <- unname(sqrt(diag(sandwich::vcovHC(model)))) + upper_ci <- as.vector(coef(model) + qt(0.975, df.residual(model)) * robust_se) + expect_equal(params$CI_high, upper_ci, tolerance = 1e-3, ignore_attr = TRUE) +}) + +test_that("model_parameters, robust CL", { + params <- model_parameters(model, vcov = "vcovCL", vcov_args = list(type = "HC1")) + robust_se <- unname(sqrt(diag(sandwich::vcovCL(model)))) + expect_equal(params$SE, robust_se, tolerance = 1e-3) + expect_equal(params$p, c(0, 0.00695, 0.00322, 0.00435, 0.94471, 0.00176), tolerance = 1e-3) +}) + +d <- datawizard::standardize(mtcars) +model2 <- lm(mpg ~ wt * am + cyl + gear, data = d) + +test_that("model_parameters, robust", { + params <- model_parameters(model, standardize = "refit", vcov = "HC3") + robust_se <- unname(sqrt(diag(sandwich::vcovHC(model2)))) + expect_equal(params$SE, robust_se, tolerance = 1e-3) + expect_equal(params$p, c(0.28624, 0.0259, 0.43611, 0.01197, 0.95238, 0.01165), tolerance = 1e-3) +}) + + +# cluster-robust standard errors, using clubSandwich +data(iris) +model <- lm(Petal.Length ~ Sepal.Length * Species, data = iris) +iris$cluster <- factor(rep(LETTERS[1:8], length.out = nrow(iris))) + +test_that("model_parameters, robust CR", { + params <- model_parameters(model, vcov = "vcovCR", vcov_args = list(type = "CR1", cluster = iris$cluster)) + robust_se <- unname(sqrt(diag(clubSandwich::vcovCR(model, type = "CR1", cluster = iris$cluster)))) + expect_equal(params$SE, robust_se, tolerance = 1e-3) + expect_equal(params$p, c(0.01246, 0.04172, 0.18895, 0.57496, 0, 0), tolerance = 1e-3) +}) + +test_that("model_parameters, normal", { + params <- model_parameters(model) + expect_equal(params$p, c(0.13267, 0.21557, 0.36757, 0.77012, 3e-05, 0), tolerance = 1e-3) +}) test_that("ci_ml1, robust", { skip("TODO: this one actually is not correct.") diff --git a/tests/testthat/test-model_parameters_std_mixed.R b/tests/testthat/test-model_parameters_std_mixed.R index a4640037e..7aa2518a9 100644 --- a/tests/testthat/test-model_parameters_std_mixed.R +++ b/tests/testthat/test-model_parameters_std_mixed.R @@ -266,9 +266,8 @@ test_that("model_parameters, standardize-refit robust", { standardize = "refit", effects = "fixed", robust = TRUE, - vcov_estimation = "CR", - vcov_type = "CR1", - vcov_args = list(cluster = iris$grp), + vcov = "CR", + vcov_args = list(type = "CR1", cluster = iris$grp), verbose = FALSE ) expect_equal(c(nrow(params), ncol(params)), c(7, 10)) diff --git a/tests/testthat/test-p_adjust.R b/tests/testthat/test-p_adjust.R index aada4dacd..95496035b 100644 --- a/tests/testthat/test-p_adjust.R +++ b/tests/testthat/test-p_adjust.R @@ -23,7 +23,7 @@ test_that("model_parameters, p-adjust after keep/drop", { ) expect_message( - mp <- model_parameters(model, summary = TRUE, keep = c("wt", "hp"), p_adjust = "bonferroni"), + mp <- model_parameters(model, include_info = TRUE, keep = c("wt", "hp"), p_adjust = "bonferroni"), "more than 1 element" ) expect_equal( @@ -34,7 +34,7 @@ test_that("model_parameters, p-adjust after keep/drop", { ) expect_message( - mp <- model_parameters(model, summary = TRUE, keep = c("cyl", "gear"), p_adjust = "bonferroni"), + mp <- model_parameters(model, include_info = TRUE, keep = c("cyl", "gear"), p_adjust = "bonferroni"), "more than 1 element" ) expect_equal( diff --git a/tests/testthat/test-p_direction.R b/tests/testthat/test-p_direction.R new file mode 100644 index 000000000..724423156 --- /dev/null +++ b/tests/testthat/test-p_direction.R @@ -0,0 +1,56 @@ +skip_on_cran() +skip_if_not_installed("bayestestR") +skip_if_not_installed("distributional") + +test_that("p_direction", { + data(mtcars) + m <- lm(mpg ~ gear + wt + cyl + hp, data = mtcars) + set.seed(123) + x <- p_direction(m) + expect_identical(c(nrow(x), ncol(x)), c(5L, 5L)) + expect_named(x, c("Parameter", "CI", "CI_low", "CI_high", "pd")) + expect_snapshot(print(x)) + + set.seed(123) + x <- p_direction(m, ci = 0.8) + expect_equal(x$pd, c(1, 0.6359, 0.9992, 0.882, 0.9117), tolerance = 1e-3) + + set.seed(123) + x <- p_direction(m, null = 0.2) + expect_equal(x$pd, c(1, 0.5567, 0.9997, 0.9309, 1), tolerance = 1e-3) +}) + +test_that("p_direction", { + skip_if_not_installed("sandwich") + data(mtcars) + m <- lm(mpg ~ gear + wt + cyl + hp, data = mtcars) + + set.seed(123) + x <- p_direction(m, ci = 0.8, vcov = "HC3") + expect_equal(x$pd, c(1, 0.6162, 0.9984, 0.8323, 0.8962), tolerance = 1e-3) + + set.seed(123) + x <- p_direction(m, null = 0.2, vcov = "HC3") + expect_equal(x$pd, c(1, 0.5464, 0.9989, 0.88, 1), tolerance = 1e-3) +}) + +test_that("p_direction, glmmTMB", { + skip_if_not_installed("glmmTMB") + data(Salamanders, package = "glmmTMB") + m1 <- glmmTMB::glmmTMB(count ~ mined + cover + (1 | site), + zi = ~mined, + family = poisson, + data = Salamanders + ) + out <- p_direction(m1) + expect_identical(c(nrow(out), ncol(out)), c(5L, 6L)) + expect_named(out, c("Parameter", "CI", "CI_low", "CI_high", "pd", "Component")) + expect_equal(out$pd, c(0.8245, 1, 0.9974, 1, 1), tolerance = 1e-4) + expect_identical( + out$Parameter, + c( + "(Intercept)_cond", "minedno_cond", "cover_cond", "(Intercept)_zi", + "minedno_zi" + ) + ) +}) diff --git a/tests/testthat/test-p_function.R b/tests/testthat/test-p_function.R index 5f131431c..c1090a2cf 100644 --- a/tests/testthat/test-p_function.R +++ b/tests/testthat/test-p_function.R @@ -3,6 +3,14 @@ model <- lm(Sepal.Length ~ Species, data = iris) test_that("p_function ci-levels", { out <- p_function(model) + expect_equal( + out$CI_low, + c( + 4.982759, 0.897132, 1.549132, 4.956774, 0.860384, 1.512384, + 4.92192, 0.811093, 1.463093, 4.862126, 0.726531, 1.378531 + ), + tolerance = 1e-4 + ) expect_identical(dim(out), c(12L, 5L)) @@ -32,6 +40,17 @@ test_that("p_function ci-levels", { c(0.3, 0.3, 0.3, 0.6, 0.6, 0.6, 0.9, 0.9, 0.9), tolerance = 1e-4 ) + + skip_if_not_installed("sandwich") + out <- p_function(model, vcov = "HC3") + expect_equal( + out$CI_low, + c( + 4.989925, 0.901495, 1.548843, 4.971951, 0.869624, 1.511772, + 4.947844, 0.826875, 1.462047, 4.906485, 0.753538, 1.376742 + ), + tolerance = 1e-4 + ) }) diff --git a/tests/testthat/test-p_significance.R b/tests/testthat/test-p_significance.R new file mode 100644 index 000000000..a01f0d78e --- /dev/null +++ b/tests/testthat/test-p_significance.R @@ -0,0 +1,65 @@ +skip_on_cran() +skip_if_not_installed("bayestestR", minimum_version = "0.15.0") +skip_if_not_installed("distributional") +skip_if_not_installed("withr") + +withr::with_environment( + new.env(), + test_that("p_significance", { + data(mtcars) + m <<- lm(mpg ~ gear + wt + cyl + hp, data = mtcars) + set.seed(123) + x <- p_significance(m) + expect_identical(c(nrow(x), ncol(x)), c(5L, 5L)) + expect_named(x, c("Parameter", "CI", "CI_low", "CI_high", "ps")) + expect_snapshot(print(x)) + + mp <- model_parameters(m) + set.seed(123) + x2 <- p_significance(mp) + expect_equal(x$ps, x2$ps, tolerance = 1e-4) + + set.seed(123) + x <- p_significance(m, ci = 0.8) + expect_equal(x$ps, c(1, 0.3983, 0.9959, 0.6188, 0), tolerance = 1e-3) + + set.seed(123) + x <- p_significance(m, threshold = 0.5) + expect_equal(x$ps, c(1, 0.4393, 0.9969, 0.6803, 0), tolerance = 1e-4) + + set.seed(123) + # Test p_significance with custom thresholds for specific parameters + x <- p_significance(m, threshold = list(cyl = 0.5, wt = 0.7)) + expect_equal(x$ps, c(1, 0.5982, 0.9955, 0.6803, 1e-04), tolerance = 1e-4) + }) +) + +test_that("p_significance, glmmTMB", { + skip_if_not_installed("glmmTMB") + data(Salamanders, package = "glmmTMB") + m1 <- glmmTMB::glmmTMB(count ~ mined + cover + (1 | site), + zi = ~mined, + family = poisson, + data = Salamanders + ) + out <- p_significance(m1) + expect_identical(c(nrow(out), ncol(out)), c(5L, 6L)) + expect_named(out, c("Parameter", "CI", "CI_low", "CI_high", "ps", "Component")) + expect_equal(out$ps, c(0.6451, 1, 0.9015, 1, 1), tolerance = 1e-4) + expect_identical( + out$Parameter, + c( + "(Intercept)_cond", "minedno_cond", "cover_cond", "(Intercept)_zi", + "minedno_zi" + ) + ) +}) + +test_that("p_significance, robust", { + skip_if_not_installed("sandwich") + data(mtcars) + m <- lm(mpg ~ gear + wt + cyl + hp, data = mtcars) + set.seed(123) + x <- p_significance(m, vcov = "HC3") + expect_snapshot(print(x)) +}) diff --git a/tests/testthat/test-p_value.R b/tests/testthat/test-p_value.R index 44a93dcb3..551d3b2d9 100644 --- a/tests/testthat/test-p_value.R +++ b/tests/testthat/test-p_value.R @@ -16,7 +16,7 @@ skip_on_cran() test_that("p_value", { skip_if_not_installed("curl") skip_if_offline() - skip_if_not_installed("httr") + skip_if_not_installed("httr2") skip_if_not_installed("lme4") # h-tests diff --git a/tests/testthat/test-pca.R b/tests/testthat/test-pca.R index 014a3c102..9e1bd58e8 100644 --- a/tests/testthat/test-pca.R +++ b/tests/testthat/test-pca.R @@ -59,6 +59,23 @@ test_that("principal_components", { }) +# print ---- + +test_that("print model_parameters pca", { + data(mtcars) + expect_snapshot(print(principal_components(mtcars[, 1:4], n = "auto"))) + expect_snapshot(print( + principal_components(mtcars[, 1:4], n = "auto"), + labels = c( + "Miles/(US) gallon", + "Number of cylinders", + "Displacement (cu.in.)", + "Gross horsepower" + ) + )) +}) + + # predict ---------------------- # N.B tests will fail if `GPArotation` package is not installed diff --git a/tests/testthat/test-pool_parameters.R b/tests/testthat/test-pool_parameters.R index 0feb24009..b4f2dcd45 100644 --- a/tests/testthat/test-pool_parameters.R +++ b/tests/testthat/test-pool_parameters.R @@ -28,3 +28,151 @@ test_that("pooled parameters", { pp3 <- summary(mice::pool(m_mice)) expect_equal(pp2$df_error, pp3$df, tolerance = 1e-3) }) + +skip_on_cran() + +test_that("pooled parameters, glmmTMB, components", { + skip_if_not_installed("mice") + skip_if_not_installed("glmmTMB") + sim1 <- function(nfac = 4, nt = 10, facsd = 0.1, tsd = 0.15, mu = 0, residsd = 1) { + dat <- expand.grid(fac = factor(letters[1:nfac]), t = 1:nt) + n <- nrow(dat) + dat$REfac <- rnorm(nfac, sd = facsd)[dat$fac] + dat$REt <- rnorm(nt, sd = tsd)[dat$t] + dat$x <- rnorm(n, mean = mu, sd = residsd) + dat$REfac + dat$REt + dat + } + + set.seed(101) + d1 <- sim1(mu = 100, residsd = 10) + d2 <- sim1(mu = 200, residsd = 5) + d1$sd <- "ten" + d2$sd <- "five" + dat <- rbind(d1, d2) + + set.seed(101) + dat$REfac[sample.int(nrow(dat), 10)] <- NA + dat$x[sample.int(nrow(dat), 10)] <- NA + dat$sd[sample.int(nrow(dat), 10)] <- NA + + impdat <- suppressWarnings(mice::mice(dat, printFlag = FALSE)) + models <- lapply(1:5, function(i) { + glmmTMB::glmmTMB( + x ~ sd + (1 | t), + dispformula = ~sd, + data = mice::complete(impdat, action = i) + ) + }) + + out <- pool_parameters(models, component = "conditional") + expect_named( + out, + c( + "Parameter", "Coefficient", "SE", "CI_low", "CI_high", "Statistic", + "df_error", "p" + ) + ) + expect_equal(out$Coefficient, c(187.280225, -87.838969), tolerance = 1e-3) + + out <- pool_parameters(models, component = "all", effects = "all") + expect_named( + out, + c( + "Parameter", "Coefficient", "Effects", "SE", "CI_low", "CI_high", + "Statistic", "df_error", "p", "Component" + ) + ) + expect_equal( + out$Coefficient, + c(187.280225, -87.838969, 3.51576, -1.032665, 0.610992, NaN), + tolerance = 1e-3 + ) + + out <- pool_parameters(models, component = "all", effects = "fixed") + expect_named( + out, + c( + "Parameter", "Coefficient", "SE", "CI_low", "CI_high", + "Statistic", "df_error", "p", "Component" + ) + ) + expect_equal( + out$Coefficient, + c(187.280225, -87.838969, 3.51576, -1.032665), + tolerance = 1e-3 + ) +}) + + +test_that("pooled parameters, glmmTMB, zero-inflated", { + skip_if_not_installed("mice") + skip_if_not_installed("glmmTMB") + skip_if_not_installed("broom.mixed") + data(Salamanders, package = "glmmTMB") + set.seed(123) + Salamanders$cover[sample.int(nrow(Salamanders), 50)] <- NA + Salamanders$mined[sample.int(nrow(Salamanders), 10)] <- NA + + impdat <- suppressWarnings(mice::mice(Salamanders, printFlag = FALSE)) + models <- lapply(1:5, function(i) { + glmmTMB::glmmTMB( + count ~ mined + cover + (1 | site), + ziformula = ~mined, + family = poisson(), + data = mice::complete(impdat, action = i) + ) + }) + + out <- pool_parameters(models) + expect_named( + out, + c( + "Parameter", "Coefficient", "SE", "CI_low", "CI_high", "Statistic", + "df_error", "p", "Component" + ) + ) + expect_equal( + out$Coefficient, + c(0.13409, 1.198551, -0.181912, 1.253029, -1.844026), + tolerance = 1e-3 + ) + + # validate against mice --------------- + m_mice <- suppressWarnings(with(data = impdat, exp = glmmTMB::glmmTMB( + count ~ mined + cover + (1 | site), + ziformula = ~mined, + family = poisson() + ))) + mice_summ <- summary(mice::pool(m_mice, dfcom = Inf)) + expect_equal(out$Coefficient, mice_summ$estimate, tolerance = 1e-3) + expect_equal(out$SE, mice_summ$std.error, tolerance = 1e-3) + expect_equal(out$p, mice_summ$p.value, tolerance = 1e-3) + + out <- pool_parameters(models, component = "all", effects = "all") + expect_named( + out, + c( + "Parameter", "Coefficient", "Effects", "SE", "CI_low", "CI_high", + "Statistic", "df_error", "p", "Component" + ) + ) + expect_equal( + out$Coefficient, + c(0.13409, 1.198551, -0.181912, 1.253029, -1.844026, 0.158795), + tolerance = 1e-3 + ) + + out <- pool_parameters(models, component = "conditional", effects = "fixed") + expect_named( + out, + c( + "Parameter", "Coefficient", "SE", "CI_low", "CI_high", + "Statistic", "df_error", "p" + ) + ) + expect_equal( + out$Coefficient, + c(0.13409, 1.198551, -0.181912), + tolerance = 1e-3 + ) +}) diff --git a/tests/testthat/test-print_AER_labels.R b/tests/testthat/test-print_AER_labels.R new file mode 100644 index 000000000..7420cc2b0 --- /dev/null +++ b/tests/testthat/test-print_AER_labels.R @@ -0,0 +1,9 @@ +skip_if_not_installed("AER") +skip_if_not_installed("datawizard") + +test_that("templates", { + data(efc, package = "datawizard") + model <- AER::tobit(neg_c_7 ~ e42dep + c172code, data = efc) + mp <- model_parameters(model) + expect_snapshot(print(mp, pretty_names = "labels")) +}) diff --git a/tests/testthat/test-printing-stan.R b/tests/testthat/test-printing-stan.R index ab69dc859..4fa16d2ed 100644 --- a/tests/testthat/test-printing-stan.R +++ b/tests/testthat/test-printing-stan.R @@ -6,7 +6,7 @@ skip_if_not_installed("insight") skip_if_not_installed("withr") withr::with_options( - list("parameters_exponentiate" = FALSE), + list(parameters_exponentiate = FALSE), { test_that("print brms", { m1 <- insight::download_model("brms_1") diff --git a/tests/testthat/test-printing.R b/tests/testthat/test-printing.R index ceff6e642..462689fa7 100644 --- a/tests/testthat/test-printing.R +++ b/tests/testthat/test-printing.R @@ -25,7 +25,7 @@ withr::with_options( # snapshot breaks between R CMD check "classic" and "strict" skip_if_not_installed("performance") model <- lm(Sepal.Length ~ Species * Petal.Length, data = iris) - out <- model_parameters(model, summary = TRUE) + out <- model_parameters(model, include_info = TRUE) expect_snapshot(print(out)) }) diff --git a/tests/testthat/test-printing2.R b/tests/testthat/test-printing2.R index 70d0b8947..cbd9cd00f 100644 --- a/tests/testthat/test-printing2.R +++ b/tests/testthat/test-printing2.R @@ -2,7 +2,7 @@ skip_if_not_installed("withr") skip_if(getRversion() < "4.0.0") withr::with_options( - list("parameters_interaction" = "*"), + list(parameters_interaction = "*"), { lm1 <- lm(Sepal.Length ~ Species, data = iris) lm2 <- lm(Sepal.Length ~ Species + Petal.Length, data = iris) diff --git a/tests/testthat/test-rank_deficienty.R b/tests/testthat/test-rank_deficienty.R index 4234d7fc6..ade83e5d8 100644 --- a/tests/testthat/test-rank_deficienty.R +++ b/tests/testthat/test-rank_deficienty.R @@ -8,7 +8,7 @@ model <- test_that("model_parameters-rank_deficiency", { expect_message(model_parameters(model)) - params <- suppressMessages(model_parameters(model)) + params <- suppressWarnings(suppressMessages(model_parameters(model))) expect_equal(params$Parameter, c("(Intercept)", "am", "cyl", "vs", "am:cyl", "am:vs"), tolerance = 1e-3) expect_equal(params$Coefficient, c(2.28908, -1.37908, 0.22688, -0.26158, 0.08062, 0.14987), tolerance = 1e-3) }) diff --git a/tests/testthat/test-robust.R b/tests/testthat/test-robust.R index 23b7af317..ad84ff23f 100644 --- a/tests/testthat/test-robust.R +++ b/tests/testthat/test-robust.R @@ -354,7 +354,7 @@ skip_if_not_installed("lme4") test_that("robust-se lmer", { data(iris) set.seed(1234) - iris$grp <- as.factor(sample(1:3, nrow(iris), replace = TRUE)) + iris$grp <- as.factor(sample.int(3, nrow(iris), replace = TRUE)) m <- lme4::lmer( Sepal.Length ~ Species * Sepal.Width + Petal.Length + (1 | grp), @@ -368,7 +368,7 @@ test_that("robust-se lmer", { test_that("robust-p lmer", { data(iris) set.seed(1234) - iris$grp <- as.factor(sample(1:3, nrow(iris), replace = TRUE)) + iris$grp <- as.factor(sample.int(3, nrow(iris), replace = TRUE)) m <- lme4::lmer( Sepal.Length ~ Species * Sepal.Width + Petal.Length + (1 | grp), @@ -385,7 +385,7 @@ test_that("robust-p lmer", { test_that("robust-ci lmer", { data(iris) set.seed(1234) - iris$grp <- as.factor(sample(1:3, nrow(iris), replace = TRUE)) + iris$grp <- as.factor(sample.int(3, nrow(iris), replace = TRUE)) m <- lme4::lmer( Sepal.Length ~ Species * Sepal.Width + Petal.Length + (1 | grp), diff --git a/tests/testthat/test-rstanarm.R b/tests/testthat/test-rstanarm.R index 7cece5df7..706f6eb57 100644 --- a/tests/testthat/test-rstanarm.R +++ b/tests/testthat/test-rstanarm.R @@ -25,7 +25,7 @@ test_that("mp2", { data(pbcLong, package = "rstanarm") pbcLong$ybern <- as.integer(pbcLong$logBili >= mean(pbcLong$logBili)) set.seed(123) - invisible(capture.output( + invisible(capture.output({ model <- rstanarm::stan_mvmer( formula = list( ybern ~ year + (1 | id), @@ -35,7 +35,7 @@ test_that("mp2", { refresh = 0, seed = 123 ) - )) + })) mp <- suppressWarnings(model_parameters(model, centrality = "mean")) s <- summary(model) diff --git a/tests/testthat/test-serp.R b/tests/testthat/test-serp.R index 3069ce80f..3dbf04646 100644 --- a/tests/testthat/test-serp.R +++ b/tests/testthat/test-serp.R @@ -1,5 +1,5 @@ skip_if_not_installed("serp") -skip_if_not_installed("insight", minimum_version = "0.19.8.4") +skip_if_not_installed("insight", minimum_version = "0.20.0") skip_if_not_installed("withr") # make sure we have the correct interaction mark for tests diff --git a/tests/testthat/test-standardize_info.R b/tests/testthat/test-standardize_info.R index 02acc3cb3..9de1b38d4 100644 --- a/tests/testthat/test-standardize_info.R +++ b/tests/testthat/test-standardize_info.R @@ -1,4 +1,5 @@ test_that("standardize_info", { + skip_if_not_installed("datawizard", minimum_version = "0.12.0") skip_if_not_installed("nlme") skip_if_not_installed("lme4") fm1 <- nlme::lme(mpg ~ cyl, mtcars, random = ~ 1 | gear) diff --git a/tests/testthat/test-standardize_parameters.R b/tests/testthat/test-standardize_parameters.R index 5e4e62056..cb71e4e73 100644 --- a/tests/testthat/test-standardize_parameters.R +++ b/tests/testthat/test-standardize_parameters.R @@ -24,6 +24,12 @@ test_that("Robust post hoc", { expect_error(standardize_parameters(model, method = "basic", robust = TRUE, two_sd = TRUE), NA) }) +# Labels ------------------------------------------------------------------ +test_that("Preserve labels", { + fit <- lm(Sepal.Length ~ Species, data = iris) + out <- standardize_parameters(fit) + expect_snapshot(print(out)) +}) # model_parameters ------------------------------- test_that("standardize_parameters (model_parameters)", { @@ -150,7 +156,7 @@ test_that("standardize_parameters (lm with ci)", { # aov --------------------------------------------------------------------- test_that("standardize_parameters (aov)", { dat2 <- iris - dat2$Cat1 <- rep(c("A", "B"), length.out = nrow(dat2)) + dat2$Cat1 <- rep_len(c("A", "B"), nrow(dat2)) dat3 <<- dat2 m_aov <- aov(Sepal.Length ~ Species * Cat1, data = dat3) @@ -198,7 +204,9 @@ test_that("standardize_parameters (with functions / interactions)", { m1 <- lm(exp(cyl) ~ am + sqrt(mpg), mtcars) m2 <- lm(cyl_exp ~ am + mpg_sqrt, mtcars) - expect_message(stdX <- standardize_parameters(m1, method = "refit")) + expect_message({ + stdX <- standardize_parameters(m1, method = "refit") + }) expect_false(isTRUE(all.equal( stdX[[2]], standardize_parameters(m2, method = "refit")[[2]] @@ -258,7 +266,8 @@ test_that("standardize_parameters (exponentiate)", { ) expect_equal( mod_refit[[2]][-1], - exp(standardize_parameters(mod_b, method = "basic")[[2]])[-1] + exp(standardize_parameters(mod_b, method = "basic")[[2]])[-1], + tolerance = 1e-5 ) @@ -270,15 +279,18 @@ test_that("standardize_parameters (exponentiate)", { expect_equal( mod_refit[[2]][-1], - standardize_parameters(mod_b, method = "basic", exponentiate = TRUE)[[2]][-1] + standardize_parameters(mod_b, method = "basic", exponentiate = TRUE)[[2]][-1], + tolerance = 1e-5 ) expect_equal( mod_refit[[2]][-1], - standardize_parameters(mod_b, method = "posthoc", exponentiate = TRUE)[[2]][-1] + standardize_parameters(mod_b, method = "posthoc", exponentiate = TRUE)[[2]][-1], + tolerance = 1e-5 ) expect_equal( mod_refit[[2]][-1], - exp(standardize_parameters(mod_b, method = "basic")[[2]])[-1] + exp(standardize_parameters(mod_b, method = "basic")[[2]])[-1], + tolerance = 1e-5 ) }) @@ -289,33 +301,36 @@ test_that("standardize_parameters (Bayes)", { skip_if_not_installed("rstanarm") set.seed(1234) - suppressWarnings( + suppressWarnings({ model <- rstanarm::stan_glm(Sepal.Length ~ Species + Petal.Width, data = iris, iter = 500, refresh = 0 ) - ) + }) + set.seed(1234) expect_equal( suppressWarnings(standardize_parameters(model, method = "refit")$Std_Median[1:4]), - c(0.065, -0.094, -0.100, 0.862), - tolerance = 0.01 + c(0.03787, -0.06088, -0.04807, 0.84067), + tolerance = 0.1 ) + set.seed(1234) expect_equal( suppressWarnings(standardize_parameters(model, method = "posthoc")$Std_Median[1:4]), - c(0, -0.058, -0.053, 0.838), + c(0, -0.0586, -0.05258, 0.83883), tolerance = 0.01 ) posts <- standardize_posteriors(model, method = "posthoc") - expect_equal(dim(posts), c(1000, 4)) + expect_identical(dim(posts), c(1000L, 4L)) expect_s3_class(posts, "data.frame") }) # Pseudo - GLMM -------------------------------- test_that("standardize_parameters (Pseudo - GLMM)", { + skip_if_not_installed("datawizard", minimum_version = "0.12.0") skip_on_cran() skip_if_not_installed("lme4") set.seed(1) @@ -324,7 +339,7 @@ test_that("standardize_parameters (Pseudo - GLMM)", { X = rnorm(1000), Z = rnorm(1000), C = sample(letters[1:3], size = 1000, replace = TRUE), - ID = sort(rep(letters, length.out = 1000)) + ID = sort(rep_len(letters, 1000)) ) dat <- transform(dat, Y = X + Z + rnorm(1000)) dat <- cbind(dat, datawizard::demean(dat, c("X", "Z"), "ID")) @@ -340,7 +355,7 @@ test_that("standardize_parameters (Pseudo - GLMM)", { ## Correctly identify within and between terms dev_resp <- standardize_info(m, include_pseudo = TRUE)$Deviation_Response_Pseudo - expect_equal(insight::n_unique(dev_resp[c(2, 4, 5, 6)]), 1) + expect_identical(insight::n_unique(dev_resp[c(2, 4, 5, 6)]), 1L) expect_true(dev_resp[2] != dev_resp[3]) @@ -354,16 +369,18 @@ test_that("standardize_parameters (Pseudo - GLMM)", { m0 <- lme4::lmer(Y ~ 1 + (1 | ID), data = dat) m0v <- insight::get_variance(m0) - SD_y <- c(sqrt(m0v$var.residual), sqrt(m0v$var.intercept)) + SD_y <- sqrt(c(m0v$var.residual, m0v$var.intercept)) SD_y <- SD_y[c(1, 2, 1, 1, 1)] expect_equal( data.frame(Deviation_Response_Pseudo = c(SD_y[2], SD_y), Deviation_Pseudo = c(0, SD_x)), - standardize_info(m, include_pseudo = TRUE)[, c("Deviation_Response_Pseudo", "Deviation_Pseudo")] + standardize_info(m, include_pseudo = TRUE)[, c("Deviation_Response_Pseudo", "Deviation_Pseudo")], + tolerance = 1e-5 ) expect_equal( standardize_parameters(m, method = "pseudo")$Std_Coefficient[-1], - unname(b * SD_x / SD_y) + unname(b * SD_x / SD_y), + tolerance = 1e-5 ) @@ -463,8 +480,8 @@ test_that("include_response | (g)lm", { par_z2 <- standardize_parameters(m, method = "basic", include_response = FALSE) expect_equal(coef(m_z), par_z1$Std_Coefficient, ignore_attr = TRUE) - expect_equal(par_z1$Std_Coefficient[-1], par_z2$Std_Coefficient[-1]) - expect_equal(par_z0$Std_Coefficient * sd(iris$Sepal.Length), par_z2$Std_Coefficient) + expect_equal(par_z1$Std_Coefficient[-1], par_z2$Std_Coefficient[-1], tolerance = 1e-5) + expect_equal(par_z0$Std_Coefficient * sd(iris$Sepal.Length), par_z2$Std_Coefficient, tolerance = 1e-5) # glm --- m <- glm(am ~ mpg, mtcars, family = binomial()) @@ -485,14 +502,14 @@ test_that("include_response | parameters", { pars <- model_parameters(m, effects = "fixed") pars_z0 <- standardize_parameters(pars, method = "basic") pars_z1 <- standardize_parameters(pars, method = "basic", include_response = FALSE) - expect_equal(pars_z0$Std_Coefficient[-1] * sd(iris$Sepal.Length), pars_z1$Std_Coefficient[-1]) + expect_equal(pars_z0$Std_Coefficient[-1] * sd(iris$Sepal.Length), pars_z1$Std_Coefficient[-1], tolerance = 1e-5) # boot --- skip_if_not_installed("boot") pars <- bootstrap_parameters(m) pars_z0 <- standardize_parameters(pars, method = "basic") pars_z1 <- standardize_parameters(pars, method = "basic", include_response = FALSE) - expect_equal(pars_z0$Std_Coefficient[-1] * sd(iris$Sepal.Length), pars_z1$Std_Coefficient[-1]) + expect_equal(pars_z0$Std_Coefficient[-1] * sd(iris$Sepal.Length), pars_z1$Std_Coefficient[-1], tolerance = 1e-5) }) @@ -504,8 +521,12 @@ test_that("include_response | bayes", { iris$Sepal.Length <- iris$Sepal.Length * 5 m <- rstanarm::stan_glm(Sepal.Length ~ Petal.Length + Petal.Width, data = iris, refresh = 0) - expect_warning(m_z <- datawizard::standardize(m, include_response = FALSE)) - expect_warning(par_z1 <- standardize_posteriors(m, include_response = FALSE)) + expect_warning({ + m_z <- datawizard::standardize(m, include_response = FALSE) + }) + expect_warning({ + par_z1 <- standardize_posteriors(m, include_response = FALSE) + }) par_z0 <- standardize_posteriors(m, method = "basic") par_z2 <- standardize_posteriors(m, method = "basic", include_response = FALSE) diff --git a/tests/testthat/test-svylme.R b/tests/testthat/test-svylme.R new file mode 100644 index 000000000..f8a6bc470 --- /dev/null +++ b/tests/testthat/test-svylme.R @@ -0,0 +1,27 @@ +skip_on_cran() +skip_on_os(c("mac", "linux", "solaris")) + +skip_if_not_installed("withr") +skip_if_not_installed("survey") +skip_if_not_installed("lme4") +skip_if_not_installed("svylme") + +withr::with_environment( + new.env(), + test_that("model_parameters svylme", { + data(api, package = "survey") + # two-stage cluster sample + dclus2 <- survey::svydesign( + id = ~ dnum + snum, + fpc = ~ fpc1 + fpc2, + data = apiclus2 + ) + m <- svylme::svy2lme( + api00 ~ ell + mobility + api99 + (1 + api99 | dnum), + design = dclus2, + method = "nested" + ) + mp <- model_parameters(m) + expect_snapshot(print(mp)) + }) +) diff --git a/tests/testthat/test-weightit.R b/tests/testthat/test-weightit.R new file mode 100644 index 000000000..28ad84231 --- /dev/null +++ b/tests/testthat/test-weightit.R @@ -0,0 +1,44 @@ +skip_on_os("mac") +skip_if_not_installed("WeightIt", minimum_version = "1.2.0") +skip_if_not_installed("cobalt") +skip_if_not_installed("insight", minimum_version = "0.20.4") + +test_that("weightit, multinom", { + data("lalonde", package = "cobalt") + set.seed(1234) + # Logistic regression ATT weights + w.out <- WeightIt::weightit( + treat ~ age + educ + married + re74, + data = lalonde, + method = "glm", + estimand = "ATT" + ) + lalonde$re78_3 <- factor(findInterval(lalonde$re78, c(0, 5e3, 1e4))) + + fit4 <- WeightIt::multinom_weightit( + re78_3 ~ treat + age + educ, + data = lalonde, + weightit = w.out + ) + expect_snapshot(print(model_parameters(fit4, exponentiate = TRUE), zap_small = TRUE)) +}) + +test_that("weightit, ordinal", { + data("lalonde", package = "cobalt") + set.seed(1234) + # Logistic regression ATT weights + w.out <- WeightIt::weightit( + treat ~ age + educ + married + re74, + data = lalonde, + method = "glm", + estimand = "ATT" + ) + lalonde$re78_3 <- factor(findInterval(lalonde$re78, c(0, 5e3, 1e4))) + + fit5 <- WeightIt::ordinal_weightit( + ordered(re78_3) ~ treat + age + educ, + data = lalonde, + weightit = w.out + ) + expect_snapshot(print(model_parameters(fit5, exponentiate = TRUE), zap_small = TRUE)) +}) diff --git a/vignettes/demean.Rmd b/vignettes/demean.Rmd index d8d5a223f..fe64645e5 100644 --- a/vignettes/demean.Rmd +++ b/vignettes/demean.Rmd @@ -90,7 +90,7 @@ You can check if your model may suffer from heterogeneity bias using the ```{r} library(performance) -check_heterogeneity_bias(qol_cancer, select = c("phq4", "education"), group = "ID") +check_heterogeneity_bias(qol_cancer, select = c("phq4", "education"), by = "ID") ``` # Adressing heterogeneity bias: the Fixed Effects Regression (FE) approach @@ -112,7 +112,7 @@ and as such, FE avoids estimating a parameter for each higher-level unit. ```{r} qol_cancer <- cbind( qol_cancer, - datawizard::demean(qol_cancer, select = c("phq4", "QoL"), group = "ID") + datawizard::demean(qol_cancer, select = c("phq4", "QoL"), by = "ID") ) ``` @@ -354,7 +354,7 @@ d <- d %>% labs <- c("very slow", "slow", "average", "fast", "very fast") levels(d$grp) <- rev(labs) -d <- cbind(d, datawizard::demean(d, c("x", "y"), group = "grp")) +d <- cbind(d, datawizard::demean(d, c("x", "y"), by = "grp")) ``` Let's look at the raw data... @@ -374,7 +374,7 @@ speed. ```{r echo=FALSE} ggplot(d, aes(x, y)) + geom_point(colour = "#555555", size = 2.5, alpha = 0.5) + - geom_smooth(method = "lm", se = F, colour = "#555555") + + geom_smooth(method = "lm", se = FALSE, colour = "#555555") + see::theme_modern() + labs(x = "Typing Speed", y = "Typing Errors", colour = "Type Experience") ``` @@ -393,7 +393,7 @@ due to repeated measurements. ```{r echo=FALSE} ggplot(d, aes(x, y)) + geom_point(mapping = aes(colour = grp), size = 2.5, alpha = 0.5) + - geom_smooth(method = "lm", se = F, colour = "#555555") + + geom_smooth(method = "lm", se = FALSE, colour = "#555555") + see::scale_color_flat() + see::theme_modern() + labs(x = "Typing Speed", y = "Typing Errors", colour = "Type Experience") @@ -432,7 +432,7 @@ between-effect now. ```{r echo=FALSE} ggplot(d, aes(x, y)) + geom_point(mapping = aes(colour = grp), size = 2.2, alpha = 0.6) + - geom_smooth(mapping = aes(x = x_between, y = y_between), method = "lm", se = F, colour = "#444444") + + geom_smooth(mapping = aes(x = x_between, y = y_between), method = "lm", se = FALSE, colour = "#444444") + see::scale_color_flat() + see::theme_modern() + labs(x = "Typing Speed", y = "Typing Errors", colour = "Type Experience") @@ -455,7 +455,7 @@ within- and between-effects. ggplot(d, aes(x, y)) + geom_smooth(mapping = aes(colour = grp), method = "lm", se = FALSE) + geom_point(mapping = aes(colour = grp), size = 2.2, alpha = 0.6) + - geom_smooth(mapping = aes(x = x_between, y = y_between), method = "lm", se = F, colour = "#444444") + + geom_smooth(mapping = aes(x = x_between, y = y_between), method = "lm", se = FALSE, colour = "#444444") + see::scale_color_flat() + see::theme_modern() + labs(x = "Typing Speed", y = "Typing Errors", colour = "Type Experience") @@ -526,7 +526,7 @@ d <- d %>% labs <- c("very slow", "slow", "average", "fast", "very fast") levels(d$grp) <- rev(labs) -d <- cbind(d, datawizard::demean(d, c("x", "y"), group = "grp")) +d <- cbind(d, datawizard::demean(d, c("x", "y"), by = "grp")) # Between-subject effect of typing speed m1 <- lm(y ~ x_between, data = d) diff --git a/vignettes/model_parameters.Rmd b/vignettes/model_parameters.Rmd index 719ffb69c..28ba6f093 100644 --- a/vignettes/model_parameters.Rmd +++ b/vignettes/model_parameters.Rmd @@ -1,6 +1,6 @@ --- title: "Summary of Model Parameters" -output: +output: rmarkdown::html_vignette: toc: true fig_width: 10.08 @@ -10,7 +10,7 @@ vignette: > %\VignetteIndexEntry{Summary of Model Parameters} \usepackage[utf8]{inputenc} %\VignetteEngine{knitr::rmarkdown} -editor_options: +editor_options: chunk_output_type: console bibliography: bibliography.bib --- @@ -32,7 +32,8 @@ knitr::opts_chunk$set( pkgs <- c( "effectsize", "BayesFactor", "lme4", "metafor", "lavaan", "nFactors", "BH", - "EGAnet", "brms", "psych", "rstanarm", "glmmTMB", "GLMMadaptive", "FactoMineR" + "EGAnet", "brms", "psych", "rstanarm", "glmmTMB", "GLMMadaptive", "FactoMineR", + "RcppEigen" ) successfully_loaded <- vapply(pkgs, requireNamespace, TRUE, quietly = TRUE) @@ -106,7 +107,7 @@ summaries, including confidence intervals ```{r eval=successfully_loaded["effectsize"]} aov(Sepal.Length ~ Species, data = iris) |> - parameters(effectsize_type = c("omega", "eta", "epsilon")) + parameters(es_type = c("omega", "eta", "epsilon")) ``` Let's complicate things further with an interaction term: @@ -114,7 +115,7 @@ Let's complicate things further with an interaction term: ```{r eval=successfully_loaded["effectsize"]} aov(Sepal.Length ~ Species * Sepal.Width, data = iris) |> parameters( - effectsize_type = c("omega", "eta"), + es_type = c("omega", "eta"), ci = 0.8 ) ``` @@ -149,9 +150,9 @@ glm(vs ~ poly(mpg, 2) + cyl, data = mtcars, family = binomial()) |> ``` ```{r} -# show Odds Ratios and include model summary +# show Odds Ratios and include model info glm(vs ~ poly(mpg, 2) + cyl, data = mtcars, family = binomial()) |> - parameters(exponentiate = TRUE, summary = TRUE) + parameters(exponentiate = TRUE, include_info = TRUE) ``` ### Mixed Models @@ -268,7 +269,7 @@ parameters( The **parameters** package extends the support to structural models. -### Principal Component Analysis (PCA) and Exploratory Factor Analysis (EFA) +### Principal Component Analysis (PCA) and Exploratory Factor Analysis (EFA) ```{r eval=all(successfully_loaded[c("psych", "nFactors")])} psych::pca(mtcars, nfactors = 3) |> diff --git a/vignettes/model_parameters_print.Rmd b/vignettes/model_parameters_print.Rmd index ba23f8583..2a80f8f06 100644 --- a/vignettes/model_parameters_print.Rmd +++ b/vignettes/model_parameters_print.Rmd @@ -1,6 +1,6 @@ --- title: "Printing Model Parameters" -output: +output: rmarkdown::html_vignette: toc: true fig_width: 10.08 @@ -10,13 +10,12 @@ vignette: > %\VignetteIndexEntry{Printing Model Parameters} \usepackage[utf8]{inputenc} %\VignetteEngine{knitr::rmarkdown} -editor_options: +editor_options: chunk_output_type: console bibliography: bibliography.bib --- -```{r , include=FALSE} -library(knitr) +```{r, include=FALSE} options(knitr.kable.NA = "") options(digits = 2) @@ -25,19 +24,22 @@ knitr::opts_chunk$set( collapse = TRUE, warning = FALSE, message = FALSE, + eval = requireNamespace("gt", quietly = TRUE), comment = "#>", out.width = "100%", tidy.opts = list(width.cutoff = 100) ) -pkgs <- c("gt", "datawizard", "glmmTMB", "parameters") +# hard deps +library(parameters) +library(datawizard) +# soft deps +pkgs <- c("gt", "glmmTMB") successfully_loaded <- sapply(pkgs, requireNamespace, quietly = TRUE) - if (all(successfully_loaded)) { - library(parameters) - library(datawizard) library(glmmTMB) + library(gt) } set.seed(333) @@ -67,7 +69,7 @@ print(mp, pretty_names = FALSE) If data is [labelled](https://strengejacke.github.io/sjlabelled/articles/intro_sjlabelled.html), `pretty_names = "labels"` will use variable and value labels as pretty names. If data is not labelled, default pretty names will be used. -```{r eval=successfully_loaded["datawizard"]} +```{r} data(efc, package = "datawizard") model <- lm(neg_c_7 ~ e42dep + c172code, data = efc) @@ -120,13 +122,13 @@ mp <- model_parameters(model) print(mp, split_component = FALSE) ``` -## Adding model summaries +## Adding model information -A model summary can be added to the table when `summary = TRUE` in the call to `model_parameters()`: +A model summary can be added to the table when `include_info = TRUE` in the call to `model_parameters()`: ```{r} model <- lm(Sepal.Length ~ Species * Petal.Length, data = iris) -model_parameters(model, summary = TRUE) +model_parameters(model, include_info = TRUE) ``` ## Including the reference level of categorical variables @@ -212,9 +214,9 @@ Note that the parameters in the table summary are re-ordered according to the or ```{r} # group parameters, either by parameter name or position print(mp, groups = list( - "Engine" = c("cyl6", "cyl8", "vs", "hp"), - "Interactions" = c("gear4:vs", "gear5:vs"), - "Controls" = c(2, 3, 7) + Engine = c("cyl6", "cyl8", "vs", "hp"), + Interactions = c("gear4:vs", "gear5:vs"), + Controls = c(2, 3, 7) )) # gear 4 and 5, drat ``` @@ -225,9 +227,9 @@ If you prefer tables without vertical borders, use the `sep` argument to define print(mp, sep = " ", groups = list( - "Engine" = c("cyl6", "cyl8", "vs", "hp"), - "Interactions" = c("gear4:vs", "gear5:vs"), - "Controls" = c(2, 3, 7) + Engine = c("cyl6", "cyl8", "vs", "hp"), + Interactions = c("gear4:vs", "gear5:vs"), + Controls = c(2, 3, 7) ) ) ``` @@ -378,6 +380,6 @@ print(tab, table_width = 80) # More advances tables and markdown / HTML formatting -The `print_md()` as well as `print_html()` functions can be used to create markdown (for knitting to PDF or Word) and HTML tables. +The `print_md()` as well as `print_html()` functions can be used to create markdown (for knitting to PDF or Word) and HTML tables. Meanwhile, there are a lot of additional packages that allow users to have even more flexibility regarding table layouts. One package we can recommend is the [*modelsummary* package](https://vincentarelbundock.github.io/modelsummary/). diff --git a/vignettes/model_parameters_robust.Rmd b/vignettes/model_parameters_robust.Rmd index 86fbc1638..8718d01f5 100644 --- a/vignettes/model_parameters_robust.Rmd +++ b/vignettes/model_parameters_robust.Rmd @@ -1,6 +1,6 @@ --- title: "Robust Estimation of Standard Errors, Confidence Intervals, and p-values" -output: +output: rmarkdown::html_vignette: toc: true fig_width: 10.08 @@ -10,7 +10,7 @@ vignette: > %\VignetteIndexEntry{Robust Estimation of Standard Errors, Confidence Intervals, and p-values} \usepackage[utf8]{inputenc} %\VignetteEngine{knitr::rmarkdown} -editor_options: +editor_options: chunk_output_type: console bibliography: bibliography.bib --- @@ -72,12 +72,13 @@ There are two arguments (see [`?standard_error`](https://easystats.github.io/parameters/reference/standard_error.html) for further details) that allow for choosing different methods and options of robust estimation: + - `vcov` - `vcov_args` Let us start with a simple example, which uses a heteroskedasticity-consistent covariance matrix estimation with estimation-type "HC3" (i.e. -`sandwich::vcovHC(type = "HC3")`). +`sandwich::vcovHC(type = "HC3")`). First let's create a simple linear regression model, which we know violates homoscedasticity assumption, and thus robust estimation methods are to be @@ -92,8 +93,8 @@ check_heteroscedasticity(model) ``` We would extract model parameters both with and without robust estimation to -highlight the difference it makes to standard errors, confidence intervals, -*t*-statistic, and *p*-values. Also, note that the coefficient estimate remains +highlight the difference it makes to standard errors, confidence intervals, +*t*-statistic, and *p*-values. Also, note that the coefficient estimate remains unchanged. ```{r} @@ -115,7 +116,7 @@ If a different type of covariance matrix estimation is required, use the `vcov`-argument. This argument accepts the name of a function from the *sandwich* or *clubSandwich* packages as a string, such as `"vcovCL"` (or just its suffix `"CL"`). *parameters* will then call the corresponding function with -the content of `vcov_args` as arguments. +the content of `vcov_args` as arguments. The specific estimation type can be controlled by passing a `type` argument via `vcov_args`. See `?sandwich::vcovCL` for information about the different types of covariance matrices that this function can produce (`HC0` to `HC3`). In the next example, we use a clustered covariance matrix estimation with `HC1`-estimation @@ -231,7 +232,7 @@ model_parameters( ``` Notice that robust estimation returns different standard errors, confidence -intervals, test statistic and *p*-values compared to the standard estimation. +intervals, test statistic and *p*-values compared to the standard estimation. Also, note that the coefficient estimate remains unchanged. ### Robust Covariance Matrix Estimation on Standardized Mixed Model Parameters