[r-cran-afex] 05/09: Imported Upstream version 0.15-2
Jonathon Love
jon at thon.cc
Thu Apr 21 08:50:35 UTC 2016
This is an automated email from the git hooks/post-receive script.
jonathon-guest pushed a commit to branch master
in repository r-cran-afex.
commit f6b1f535d824cd463de602ab903f351244867510
Author: Jonathon Love <jon at thon.cc>
Date: Sat Dec 19 14:34:41 2015 +1100
Imported Upstream version 0.15-2
---
DESCRIPTION | 40 +-
MD5 | 77 +-
NAMESPACE | 1 +
NEWS | 956 +++++++-------
R/afex-package.R | 6 +-
R/allFit.R | 176 +--
R/aov_car.R | 778 ++++++------
R/compare.2.vectors.R | 186 +--
R/deprecated.R | 58 +-
R/ems.R | 214 ++--
R/helpers.R | 96 +-
R/ks2013.3-data.R | 56 +-
R/md_12.1-data.R | 90 +-
R/md_15.1-data.R | 122 +-
R/md_16.1-data.R | 68 +-
R/md_16.4-data.R | 68 +-
R/methods.afex_aov.R | 286 +++--
R/mixed.R | 1328 ++++++++++----------
R/nice.R | 286 ++---
R/obk.long-data.R | 92 +-
R/round_ps.R | 56 +-
R/set_contrasts.R | 90 +-
R/sk2011.1-data.R | 90 +-
R/sk2011.2-data.R | 64 +-
inst/doc/anova_posthoc.R | 2 +-
inst/doc/anova_posthoc.Rmd | 2 +-
inst/doc/anova_posthoc.html | 154 +--
man/afex-package.Rd | 6 +-
man/afex_aov-methods.Rd | 11 +-
man/mixed.Rd | 6 +-
man/nice.Rd | 11 +-
tests/testthat.R | 8 +-
tests/testthat/test-afex_aov.R | 106 +-
..._car-basic.car-basic.R => test-aov_car-basic.R} | 210 ++--
...ov_car-basic.car-bugs.R => test-aov_car-bugs.R} | 377 +++---
....car-structural.R => test-aov_car-structural.R} | 84 +-
tests/testthat/test-mixed-bugs.R | 11 +
tests/testthat/test-mixed-mw.R | 92 +-
tests/testthat/test-mixed-structure.R | 324 ++---
vignettes/anova_posthoc.Rmd | 2 +-
40 files changed, 3400 insertions(+), 3290 deletions(-)
diff --git a/DESCRIPTION b/DESCRIPTION
index 3e58188..85eb577 100644
--- a/DESCRIPTION
+++ b/DESCRIPTION
@@ -3,39 +3,37 @@ Type: Package
Title: Analysis of Factorial Experiments
Depends: R (>= 3.0.0), lme4 (>= 1.0.5), reshape2, lsmeans (>= 2.17)
Suggests: ascii, xtable, parallel, plyr, optimx, nloptr, knitr,
- lattice, multcomp, testthat, mlmRev
+ lattice, multcomp, testthat, mlmRev, dplyr
Imports: stringr, coin, Matrix, pbkrtest (>= 0.3-6), car, stats, utils,
methods
-Description: Provides convenience functions for analyzing factorial experiments using ANOVA or
- mixed models. aov_ez(), aov_car(), and aov_4() allow specification of between, within
- (i.e., repeated-measures), or mixed between-within (i.e., split-plot) ANOVAs for data in
- long format (i.e., one observation per row), potentially aggregating multiple
- observations per individual and cell of the design. mixed() fits mixed models using
- lme4::lmer() and computes p-values for all fixed effects using either Kenward-Roger
- approximation for degrees of freedom (LMM only), parametric bootstrap (LMMs and GLMMs),
- or likelihood ratio tests (LMMs and GLMMs). afex uses type 3 sums of squares as default
- (imitating commercial statistical software).
+Description: Provides convenience functions for analyzing factorial experiments using ANOVA or mixed models. aov_ez(),
+ aov_car(), and aov_4() allow specification of between, within (i.e., repeated-measures), or mixed between-within
+ (i.e., split-plot) ANOVAs for data in long format (i.e., one observation per row), potentially aggregating
+ multiple observations per individual and cell of the design. mixed() fits mixed models using lme4::lmer() and
+ computes p-values for all fixed effects using either Kenward-Roger approximation for degrees of freedom (LMM
+ only), parametric bootstrap (LMMs and GLMMs), or likelihood ratio tests (LMMs and GLMMs). afex uses type 3 sums
+ of squares as default (imitating commercial statistical software).
URL: https://github.com/singmann/afex
License: GPL (>= 3)
Encoding: UTF-8
VignetteBuilder: knitr
-Authors at R: c(person(given="Henrik", family="Singmann", role=c("aut", "cre"),
- email="singmann+afex at gmail.com"), person(given="Ben", family="Bolker", role=c("aut")),
- person(given="Jake", family="Westfall", role=c("aut")), person(given="Søren",
- family="Højsgaard", role=c("ctb")), person(given="John", family="Fox", role=c("ctb")),
- person(given="Michael A.", family="Lawrence", role=c("ctb")), person(given="Ulf",
- family="Mertens", role=c("ctb")) )
-Version: 0.14-2
-Date: 2015-08-17
+Authors at R: c(person(given="Henrik", family="Singmann", role=c("aut", "cre"), email="singmann+afex at gmail.com"),
+ person(given="Ben", family="Bolker", role=c("aut")), person(given="Jake", family="Westfall", role=c("aut")),
+ person(given="Søren", family="Højsgaard", role=c("ctb")), person(given="John", family="Fox", role=c("ctb")),
+ person(given="Michael A.", family="Lawrence", role=c("ctb")), person(given="Ulf", family="Mertens",
+ role=c("ctb")), person(given="Frederik", family="Aust", role=c("ctb")) )
+Version: 0.15-2
+Date: 2015-10-24
NeedsCompilation: no
-Packaged: 2015-08-17 19:52:07 UTC; henrik
+Packaged: 2015-10-24 21:30:01 UTC; henrik
Author: Henrik Singmann [aut, cre],
Ben Bolker [aut],
Jake Westfall [aut],
Søren Højsgaard [ctb],
John Fox [ctb],
Michael A. Lawrence [ctb],
- Ulf Mertens [ctb]
+ Ulf Mertens [ctb],
+ Frederik Aust [ctb]
Maintainer: Henrik Singmann <singmann+afex at gmail.com>
Repository: CRAN
-Date/Publication: 2015-08-17 23:11:37
+Date/Publication: 2015-10-25 00:22:33
diff --git a/MD5 b/MD5
index dc6a2d2..db64456 100644
--- a/MD5
+++ b/MD5
@@ -1,26 +1,26 @@
-54f8a104a4e6365a20eeb775248fa1ac *DESCRIPTION
-ac967c810673ed7bce05c079cffd252a *NAMESPACE
-b7a2af253bc01a08b09958162d7aa911 *NEWS
-c2b88089272c51282fd1be4f467eaa4b *R/afex-package.R
-22b309c59f2c63fa7f43cd0c015e308d *R/allFit.R
-bf2b98845831eb54534a002e439f4a37 *R/aov_car.R
-dd31aab58703c3bc918e4ccb4c1ba76a *R/compare.2.vectors.R
-ba6e83a7fd67f6e248417f47cb88dc72 *R/deprecated.R
-9d30fbd9aec277f5806d59497e57ba89 *R/ems.R
-dc08f73e417853fee70a0eac0c2f02cf *R/helpers.R
-f484a2891f769af0778d7295f6556e49 *R/ks2013.3-data.R
-ed8a50281ff47370a11a28ed3d061c61 *R/md_12.1-data.R
-7de7557aef96b1ba615bf51cef5201fd *R/md_15.1-data.R
-8761a7d8052bda59468c67683f595cb0 *R/md_16.1-data.R
-efd9ac90bf84f209488f73b82a47d1fa *R/md_16.4-data.R
-6df66a42ba78ca8078b694ba69e76798 *R/methods.afex_aov.R
-bfcf8884e88d78afa083bfab232c84a9 *R/mixed.R
-762cb45e5068b2451d1dbb9005596cfb *R/nice.R
-888c472b1d7dbb94259bdf6b0694cf30 *R/obk.long-data.R
-3f2f6ccb9a5797adb2ff966081db8898 *R/round_ps.R
-3e6998341b13fa93ce5d636c92ae771e *R/set_contrasts.R
-d508e06868b12ee1c150ae2bc4629db4 *R/sk2011.1-data.R
-50834454549aac18f646d46b2c9f338d *R/sk2011.2-data.R
+60b38a293c403e36a90d34341dd903cf *DESCRIPTION
+160258847a0a157239251c3f2f9dfd8a *NAMESPACE
+ac52367f70c85a636c2c0689b669682b *NEWS
+7bb865039d9dadd48badd0aa906d1c06 *R/afex-package.R
+e31ce0d5d4da04c14e2a30f6c6c75e6b *R/allFit.R
+8cbd1c613dfbe922989bc01bbba61b55 *R/aov_car.R
+03bb0e49814a31c17b98561e308c652a *R/compare.2.vectors.R
+9641356efdc58afcb325fd52536eb467 *R/deprecated.R
+87bf02eab351c8d2f1eb6cd081db6630 *R/ems.R
+fbb9cc1bede5cc2db4a8f9ab261d1d55 *R/helpers.R
+f35751ee0dfdeb49847da1c0e2ba6658 *R/ks2013.3-data.R
+d9a78c053bf03e0cf991c45584216bea *R/md_12.1-data.R
+37d9937eb76fd7c19d4cca73e39832b3 *R/md_15.1-data.R
+51eacd95f1dc5216b88df8e71eed8738 *R/md_16.1-data.R
+e727b7435149abb02c94bff9ce930edd *R/md_16.4-data.R
+1535623b79e79b2a3f5699951d99d61b *R/methods.afex_aov.R
+492a81a1b9b3b0df0b2e4ced083ac7bf *R/mixed.R
+e81f3c225e8838c5aff116cc3c76b4fd *R/nice.R
+6957d204d984fc4bc9fd8d9a171af7bc *R/obk.long-data.R
+f03bbeccea307b186df307433c31e455 *R/round_ps.R
+a63da9c14316068adbc27738bd2dd327 *R/set_contrasts.R
+8bb208f001aff1425bb8ebb5a4fb465e *R/sk2011.1-data.R
+9fe8b5e4ad58e9350525f1a88f300e37 *R/sk2011.2-data.R
05d70dfe85c65b258f18dd62cb3db36b *R/zzz.R
7adc8fd6a7eb8f38c8336b96c42bee56 *build/vignette.rds
dc520acd438387964b4561483968f18e *data/ks2013.3.rda
@@ -31,11 +31,11 @@ dbe295d0e59a0fd4cf4b73965ddfd16b *data/md_16.4.rda
387538b02807392eef5f8de5b6f55cd7 *data/obk.long.rda
87a9f9f971f46d20fb440385652b3771 *data/sk2011.1.rda
30d68b1cca41bab8e71a24b7b48489be *data/sk2011.2.rda
-37e4b7d26b83c546265a09f4f0f3e8fa *inst/doc/anova_posthoc.R
-6520acfa4d9a9cd374b24c24076d16bf *inst/doc/anova_posthoc.Rmd
-268b25d1a62904257efe1d2103d359af *inst/doc/anova_posthoc.html
-0e3ff4c4eb9720917aa2c58787c96efe *man/afex-package.Rd
-50b311949a00c3ebff4af202e1010739 *man/afex_aov-methods.Rd
+027e65f8b7a11dd648eb93b1f55d33d3 *inst/doc/anova_posthoc.R
+4364559dfa702f5231977f187a7bda97 *inst/doc/anova_posthoc.Rmd
+fba28f50137f002941ab4fc7d7c0e3c2 *inst/doc/anova_posthoc.html
+b12e57333793bdab7da8b887dca46ca1 *man/afex-package.Rd
+de67c42a49e6b7d295117ea5bcb59234 *man/afex_aov-methods.Rd
1806e552994252b6e21c68a96cedde26 *man/afex_options.Rd
0ff09ac2bb7983163cce41711bb352a2 *man/allFit.Rd
7eba0fd3eb67aece214c9dd996d11e17 *man/aov_car.Rd
@@ -47,20 +47,21 @@ e67065f167584eaa76213bf5ca74db3d *man/ks2013.3.Rd
c4315f524d2f432e26764644952fe243 *man/md_15.1.Rd
b0bf1c627ee56fca0024c8caeaa89e8f *man/md_16.1.Rd
46abbb31e2629f98b4ccc226fd858ee7 *man/md_16.4.Rd
-924b27ef0166619a0e7e734bd2117555 *man/mixed.Rd
-307b627d19000934e9f6bec17342daef *man/nice.Rd
+45e34ee8faac149515e08882355b10ae *man/mixed.Rd
+30460c25fef3a60976dc13dc45f3d3cb *man/nice.Rd
05611b26ef5504b3bcdcb537048e93b8 *man/obk.long.Rd
166500ffec6b75c0a22fc5def73c48f2 *man/round_ps.Rd
945c59d7b49801f33eaa82f924c9db12 *man/set_sum_contrasts.Rd
7be172f5999a2193bda6edd1ce39377c *man/sk2011.1.Rd
aed1a982e81e640dea0b383ee389c958 *man/sk2011.2.Rd
-24ef3ebe1b7dec6e3a22760eab1ab2f4 *tests/testthat.R
-a6b571dd594a014f8835f3eb992a1296 *tests/testthat/test-afex_aov.R
-1757a8700570ee08d6300166e620ccfe *tests/testthat/test-aov_car-basic.car-basic.R
-6331ba50a280df67435bf75af4eac77f *tests/testthat/test-aov_car-basic.car-bugs.R
-194247ac0b296c3b86b8749ea9edce63 *tests/testthat/test-aov_car-basic.car-structural.R
+2d343f0d270a71a9cf1a10b3c6bf200b *tests/testthat.R
+7499da384eba0654fa73adf761124e50 *tests/testthat/test-afex_aov.R
+e0643d83228db1d514e856d349cdc2fa *tests/testthat/test-aov_car-basic.R
+fad3cd44ee03f26c3bd9bdc0dbf016ea *tests/testthat/test-aov_car-bugs.R
+354f395ebba3da7cd2fe66dbf6658b4c *tests/testthat/test-aov_car-structural.R
552bc7ee76d8eac9745073052962a11f *tests/testthat/test-compare_2_vectors.R
a4d70d487b537c7bc34dc2641bf50f00 *tests/testthat/test-lsmeans-interface.R
-cd5b6a326f4fbd41a18b92b47a86c4c2 *tests/testthat/test-mixed-mw.R
-aede5fc36acd1ffbfb77bd90e5c3cdb3 *tests/testthat/test-mixed-structure.R
-6520acfa4d9a9cd374b24c24076d16bf *vignettes/anova_posthoc.Rmd
+8bfccda7b9c2b528eb2bad66eca19b50 *tests/testthat/test-mixed-bugs.R
+03f06b1890cd568eedd0001becfdede0 *tests/testthat/test-mixed-mw.R
+77f8ead26cccf055c9fcf14bcd3edae2 *tests/testthat/test-mixed-structure.R
+4364559dfa702f5231977f187a7bda97 *vignettes/anova_posthoc.Rmd
diff --git a/NAMESPACE b/NAMESPACE
index 5536e24..76944b4 100644
--- a/NAMESPACE
+++ b/NAMESPACE
@@ -69,6 +69,7 @@ importFrom(stats,coef)
importFrom(stats,logLik)
importFrom(stats,model.frame)
importFrom(stats,model.matrix)
+importFrom(stats,p.adjust)
importFrom(stats,setNames)
importFrom(stats,t.test)
importFrom(stats,terms)
diff --git a/NEWS b/NEWS
index 418fad4..107a5bd 100644
--- a/NEWS
+++ b/NEWS
@@ -1,463 +1,493 @@
- *************************
- ** afex VERSION 0.14-x **
- *************************
-
- Changes in afex Version 0.14-x
- Released August 2015
-
- Significant User Visible Changes and New Features
-
- o new default return argument for ANOVA functions, afex_aov,
- an S3 object containing the following:
- (1) ANOVA table of class "anova"
- (2) ANOVA fitted with base R's aov (can be passed to lsmeans
- for post-hoc tests)
- (3) output from car::Anova (for tests of effects),
- ANOVA table (1) is based on this model
- (4) lm object passed to car::Anova
- (5) data used for estimating (2) and (4)
-
- o added support for lsmeans: objects of class afex_aov can be
- passed to lsmeans directly. afex now depends on lsmeans.
-
- o added afex_options() functionality for setting options globally.
-
- o added expand_re argument to mixed which, if TRUE, correctly interprets
- the || notation in random effects with factors (i.e., suppresses
- estimation of correlation among random effects). lmer_alt is a wrapper
- for mixed which uses expand_re = TRUE, returns an object of class
- merMod (i.e., does not calculate p-values), and otherwise behaves
- like g/lmer (i.e., does not enforce certain contrasts)
-
- o added three new data sets (Singmann & Klauer, 2011; Klauer &
- Singmann, 2013) and a vignette showing how to calculate
- contrasts after ANOVA.
-
- o ANOVA functions renamed to aov_car, aov_ez, and aov_4. Old
- functions are now deprecated.
-
- o first element in mixed object renamed to anova_table.
-
- o nice.anova renamed to nice. nice() can be called for afex_aov
- and mixed objects and returns a nicely formatted (numbers
- converted to characters) results table (which is also the
- default print method for both objects).
-
- o anova() can be called for afex_aov and mixed objects and returns
- the numeric anova table (i.e., the first element of each object).
- There also exists print methods for those data.frames.
-
- o summary method for mixed objects now calls summary.merMod on
- full model.
-
- o afex does not depend on car package anymore, it is only imported.
-
- o afex is now hosted on github: https://github.com/singmann/afex
-
- Bugfixes
-
- o ANOVA: for "aov"-objects, contrasts are only set for factors.
-
- o compare.2.vector failed when the two means were exactly equal
- (due to an issue with median_test). This only throws a warning
- now.
-
- o compare.2.vector documentation updated for coin 1-1.0.
-
-
-
-
- *************************
- ** afex VERSION 0.13-x **
- *************************
-
- Changes in afex Version 0.13-x
- Released January 2015
-
- Significant User Visible Changes and New Features
-
- o added ems() function for deriving the expected values of the
- mean squares for factorial designs (contributed by Jake
- Westfall).
-
-
- Bugfixes
-
- o aov.car et al. stop with error message if a factor has only one
- level.
-
- o aov.car transforms id variable to factor which ensures that
- return = "aov" provides equivalent results.
-
- o changed regex for detecting "observed" variables to work with
- the new version of stringr which uses stringi.
-
-
-
-
- *************************
- ** afex VERSION 0.12-x **
- *************************
-
- Changes in afex Version 0.12-x
- Released November 2014
-
- Significant User Visible Changes and New Features
-
- o ANOVA functions give informative error if some parameters are
- not estimable (most likely due to structural missings, i.e.
- empty cells).
-
-
- Bugfixes
-
- o mixed(..., method = "PB") does not fail anymore when only
- having a single fixed effect (thanks to Kiyoshi Sasaki for
- reporting it).
-
- o aov.car() failed when a within-subject factor had empty levels.
- Unused factor levels are now dropped. This bug was probably
- introduced in Rev 126 as part of an attempt to solve a bug.
- (thanks to Will Bowditch for reporting it).
-
-
-
- *************************
- ** afex VERSION 0.11-x **
- *************************
-
- Changes in afex Version 0.11-x
- Released October 2014
-
- Significant User Visible Changes and New Features
-
- o added allFit() function (written by Ben Bolker).
-
- o mixed() gives warning if nested model provides worse fit
- (logLik) than full model (when fitted with ML).
-
- o print, summary, and anova method for mixed objects are now
- identical.
-
- o description of returned object from mixed() extended (Thanks
- to Ben Bolker, see http://stackoverflow.com/a/25612960/289572)
-
- o added return = "aov" to aov.car which returns the ANOVA
- fitted with aov (with correct Error strata) so that it can be
- passed to lsmeans for post-hoc tests or plotting (lsmip).
-
-
- Bugfixes
-
- o all required functions are now correctly imported avoiding
- CRAN warnings and better functioning.
-
- o data argument to lmer calls in mixed set correctly. Note that
- still contrasts added to the data in mixed may prohibit use of
- predict.merMod() or similar functions. It is recommended to
- set the contrasts globally to "contr.sum", e.g.,
- via set_sum_contrasts(), for correct functioning
- (disable via set.data.arg argument for mixed).
-
-
-
- ************************
- ** afex VERSION 0.10-x **
- ************************
-
- Changes in afex Version 0.10-x
- Released August 2014
-
- Significant User Visible Changes and New Features
-
- o afex does not change the global contrasts anymore when loading
- the package (due to popular demand).
-
- o new functions to globally set contrasts: set_sum_contrasts &
- set_treatment_contrasts (and some more wrappers).
-
- o Added more mixed model examples from Maxwell & Delaney, Chapter
- 15 ("Multilevel Models for within subjects designs"), see ?mixed
- and ?md_15.1. Thanks to Ulf Mertens.
-
- Bugfixes
-
- o removed bug when factor levels of within-subject factors
- contained "+" or "-" and were not converted correctly. Added
- tests for known bugs in aov.car.
-
-
- ************************
- ** afex VERSION 0.9-x **
- ************************
-
- Changes in afex Version 0.9-x
- Released April 2014
-
- Significant User Visible Changes and New Features
-
- o added function aov4: another wrapper of car::Anova for ANOVA
- models specified via lme4::lmer syntax.
-
- o added return="marginal" to aov.car which returns the marginal
- means of all effects (i.e., grand mean and mean of main
- effects and interactions). Is also returned if return="full".
-
- o testing the intercept in mixed models in now only optional.
- The default is that the new argument test.intercept = FALSE.
-
- o removed return="lme4" from aov.car.
-
- o added argument intercept to nice.anova (default FALSE) which
- allows to selective display the intercept in an ANOVA table.
-
- o added method = "F" to mixed() which only returns the F-value
- but no ddf (and hence no p-value). Experimental, not documented.
-
- o renamed colname "stat" to "F" when method = "KR" (mixed).
-
- o added tests (currently mainly for mixed()) via pkg testthat,
- see tests/testthat.
-
- Bugfixes
-
- o increased requirement of R version and lme4 version.
-
- o print.mixed should now propagate all warnings from lme4 (i.e.,
- also the new convergence warnings).
-
- o lme4 is now loaded at worker nodes for mixed (default,
- turn of via check.contrasts)
-
-
-
- ************************
- ** afex VERSION 0.8-x **
- ************************
-
- Changes in afex Version 0.8-x
- Released February 2014
-
- Significant User Visible Changes and New Features
-
- o removed renaming of within subject factor levels to names
- with length 1 (which was introduced in 0.6).
-
- o helper function round_ps which nicely rounds p-values
- is now exported.
-
- o warning about numerical non-centered variables in mixed
- is now a message only.
-
- o added examples data sets from Maxwell & Delaney (2004) for
- within-subjects ANOVA and mixed models.
-
- o reshape2 is now again in depends but coin only imported.
-
- Bugfixes
-
- o the default effect size (ges: generalized eta-squared) was
- calculated wrong (the error term for the intercept was not
- included). Sorry. This is now corrected (with new examples).
-
- o removed bug that aov.car didn't work when running some ANCOVAs
- (thanks to Gang Chen for reporting this).
-
-
-
- ************************
- ** afex VERSION 0.7-x **
- ************************
-
- Changes in afex Version 0.7-x
- Released December 2013
-
- Significant User Visible Changes and New Features
-
- o nicer output of print.mixed
-
- Bugfixes
-
- o mixed() correctly converts all non-formula arguments to
- formula correctly to a formula (gave error if formula
- was a different object and not-available on cluster nodes).
- Prints message if formula is converted to a formula.
-
- o Using multicore for fitting the models prodcued erroneous
- results (did not use correct contrasts at nodes). Now the
- current contrasts are also set at the nodes.
-
- o mixed() sets REML = FALSE if method = "LRT" and no
- family argument is present (i.e., for LMMs) as LRTs
- for models fitted with REML are not recommended.
-
- o on the cluster nodes now only the lme4 namespace is
- loaded (instead of using library) to avoid a CRAN note.
-
-
- ************************
- ** afex VERSION 0.6-x **
- ************************
-
- Changes in afex Version 0.6-x
- Released September 2013
-
- Significant User Visible Changes and New Features
-
- o added LRT tests to mixed() which should replicate
- the recommended test by Barr et al. (2013, JML).
-
- o multicore estimation of (g)lmer models now available
- through package parallel (argument cl) for mixed().
-
- o added experimental "lme4" return method for
- aov.car and ez.glm (which fits the data using lmer).
-
- o reshape2 and stringr are not any more loaded when
- loading afex (are now only imported via Imports)
-
- Bugfixes
-
- o Type 2 tests of mixed() were implemented incorrectly (i.e.,
- they did not give what they should have given according
- to the description in the help file).
-
- o aov.car() and ez.glm() now convert factor levels of within
- subjects factors to be of length one so that long levels
- do not lead to problems when constructing the call to lm.
- Thanks to Isaac Schwabacher for noticing this, see also:
- https://bugs.r-project.org/bugzilla3/show_bug.cgi?id=15377
-
- o mixed should now work with missing values as it construes
- a new data object if the model.matrix from which the
- different versions are fitted has nrow different to
- nrow(data) (with warning). Thanks to Daniel Bunker
- for reporting this.
-
- o mixed should work with the newest version of lme4 (>= 1.0.4)
- and the newst version of pbkrtest (>= 0.3-5.1), but not
- with older versions (due to CRAN policy to disallow :::).
-
-
- ************************
- ** afex VERSION 0.5-x **
- ************************
-
- Changes in afex Version 0.5-x
- Released May 2013
-
- Significant User Visible Changes and New Features
-
- o added argument factorize (default: TRUE) to aov.car and ez.glm:
- all variables are now factorized per default. (now it is
- necessary to set factorize=FALSE for ANCOVAs!)
-
- o added argument per.parameter to mixed() which allows to specify
- variables for which each parameter is tested (not only the
- overall effect). Can be useful to test for ordered factors.
- (only implemented for "Type 3" tests)
-
- o added more informative startup message (thanks to Robert Volcic
- and Lars Konieczny)
-
- o mixed, ez.glm and aov.car now check for correct contrasts and set
- factors to contr.sum if other contrasts are found (can be tunred
- off via check.contrasts argument). Resetting the default contrast
- to contr.treatment should therefore not interfere with afex.
- (this is not intensly tested, so please report anything)
-
- o mixed checks numeric variables if they are centered on 0 (and
- gives warning if not).
-
- Bugfixes
-
- o checks if observed variable is in the data and throws
- an error if not (nice.anova)
-
-
- ************************
- ** afex VERSION 0.4-x **
- ************************
-
- Changes in afex Version 0.4-x
- Released February 2013
-
- Significant User Visible Changes and New Features
-
- o added generalized and partial eta-squared effect
- sizes to nice.anova (this also included adding
- observed arguments to aov.car, ez.glm, nice.anova)
-
- o added new return arguments to aov.car and ez.glm
- (nice, lm, data).
-
- o changed default return value of aov.car and ez.glm
- to "nice" which now returns a nice ANOVA table
- (nice.anova)
-
- o mixed has method = "PB" for obtaining parametric
- bootstrapped p-values (e.g., for GLMMs)
-
- o added alternative argument to compare.2.vectors.
-
- o aov.car (and ez.glm) now give a warning if
- observations are missing on within-subject factors.
- (As before, cases with missing values are simply
- excluded from the analysis)
-
- o had to disable saving of the previous contrasts and
- resetting those after detaching afex due to
- CRAN policies (no assignment in global environment).
-
- Bugfixes
-
- o Bug when running mixed() inside a function and
- handing the data.frame over as an argument fixed
- (thanks, again, to Florent Duyme). See
- bugs/eval.scoping.bug.R
-
- o nice.anova did not work with a model with only one
- within-subjects factor.
-
-
-
- ************************
- ** afex VERSION 0.3-x **
- ************************
-
- Changes in afex Version 0.3-x
- Released August/September 2012
-
- Significant User Visible Changes and New Features
-
- o added function compare.2.vectors().
-
- o Name of function univariate() changed to univ(), as
- a function with this name is part of package multcomp.
- This may leed to problems. Thanks to Florent Duyme for
- spotting this.
-
- o added return argument to aov.car() and ez.glm().
-
- o added rather dubious Type 2 tests to mixed().
-
- o aov.car checks if each id is only present in one
- cell of the between subjects design.
-
- Bugfixes
-
- o aov.car now uses do.call when calling lm() to avoid local
- variables in the call to lm() which could led to problems when
- working with the lm model.
-
- o mixed() now passes ... (further arguments to lmer) correctly.
- (Now mixed uses match.call and eval on the call instead of
- invoking lmer directly.)
-
- o corrected bug that was introduced by pbkrtest v3.2 when
- invoking the print method to an object of class mixed
- (again thanks to Florent Duyme for spotting this).
-
- o removed bug when factor levels of within-subject factors
- were non-legal names (solution uses make.names).
-
+ *************************
+ ** afex VERSION 0.15-x **
+ *************************
+
+ Changes in afex Version 0.15-x
+ Released October 2015
+
+ Significant User Visible Changes and New Features
+
+ o added p.adjust.method argument for ANOVA functions (anova and nice
+ methods). Can be used to control for multiple comparisons in
+ exploratory ANOVAs (see Cramer, et al., 2015; PB&R). Functionality
+ contributed by Frederik Aust (https://github.com/singmann/afex/pull/3).
+
+ Bugfixes
+
+ o ANOVA functions work with dplyr data.frames now (data is transformed
+ via as.data.frame). See: https://github.com/singmann/afex/issues/6
+
+ o formulas for mixed can now be of a maximum length of 500 characters
+ (was 60 chars previously): https://github.com/singmann/afex/issues/5
+
+ o aov_car et al. did not work with within-subject factors that were also
+ included outside the Error term. This was caused by the use of regular
+ expressions not appropriate for the new stringi backend of stringr.
+ Thanks to Tom Wenseleers for reporting this bug.
+
+
+
+
+ *************************
+ ** afex VERSION 0.14-x **
+ *************************
+
+ Changes in afex Version 0.14-x
+ Released August 2015
+
+ Significant User Visible Changes and New Features
+
+ o new default return argument for ANOVA functions, afex_aov,
+ an S3 object containing the following:
+ (1) ANOVA table of class "anova"
+ (2) ANOVA fitted with base R's aov (can be passed to lsmeans
+ for post-hoc tests)
+ (3) output from car::Anova (for tests of effects),
+ ANOVA table (1) is based on this model
+ (4) lm object passed to car::Anova
+ (5) data used for estimating (2) and (4)
+
+ o added support for lsmeans: objects of class afex_aov can be
+ passed to lsmeans directly. afex now depends on lsmeans.
+
+ o added afex_options() functionality for setting options globally.
+
+ o added expand_re argument to mixed which, if TRUE, correctly interprets
+ the || notation in random effects with factors (i.e., suppresses
+ estimation of correlation among random effects). lmer_alt is a wrapper
+ for mixed which uses expand_re = TRUE, returns an object of class
+ merMod (i.e., does not calculate p-values), and otherwise behaves
+ like g/lmer (i.e., does not enforce certain contrasts)
+
+ o added three new data sets (Singmann & Klauer, 2011; Klauer &
+ Singmann, 2013) and a vignette showing how to calculate
+ contrasts after ANOVA.
+
+ o ANOVA functions renamed to aov_car, aov_ez, and aov_4. Old
+ functions are now deprecated.
+
+ o first element in mixed object renamed to anova_table.
+
+ o nice.anova renamed to nice. nice() can be called for afex_aov
+ and mixed objects and returns a nicely formatted (numbers
+ converted to characters) results table (which is also the
+ default print method for both objects).
+
+ o anova() can be called for afex_aov and mixed objects and returns
+ the numeric anova table (i.e., the first element of each object).
+ There also exists print methods for those data.frames.
+
+ o summary method for mixed objects now calls summary.merMod on
+ full model.
+
+ o afex does not depend on car package anymore, it is only imported.
+
+ o afex is now hosted on github: https://github.com/singmann/afex
+
+ Bugfixes
+
+ o ANOVA: for "aov"-objects, contrasts are only set for factors.
+
+ o compare.2.vector failed when the two means were exactly equal
+ (due to an issue with median_test). This only throws a warning
+ now.
+
+ o compare.2.vector documentation updated for coin 1-1.0.
+
+
+
+
+ *************************
+ ** afex VERSION 0.13-x **
+ *************************
+
+ Changes in afex Version 0.13-x
+ Released January 2015
+
+ Significant User Visible Changes and New Features
+
+ o added ems() function for deriving the expected values of the
+ mean squares for factorial designs (contributed by Jake
+ Westfall).
+
+
+ Bugfixes
+
+ o aov.car et al. stop with error message if a factor has only one
+ level.
+
+ o aov.car transforms id variable to factor which ensures that
+ return = "aov" provides equivalent results.
+
+ o changed regex for detecting "observed" variables to work with
+ the new version of stringr which uses stringi.
+
+
+
+
+ *************************
+ ** afex VERSION 0.12-x **
+ *************************
+
+ Changes in afex Version 0.12-x
+ Released November 2014
+
+ Significant User Visible Changes and New Features
+
+ o ANOVA functions give informative error if some parameters are
+ not estimable (most likely due to structural missings, i.e.
+ empty cells).
+
+
+ Bugfixes
+
+ o mixed(..., method = "PB") does not fail anymore when only
+ having a single fixed effect (thanks to Kiyoshi Sasaki for
+ reporting it).
+
+ o aov.car() failed when a within-subject factor had empty levels.
+ Unused factor levels are now dropped. This bug was probably
+ introduced in Rev 126 as part of an attempt to solve a bug.
+ (thanks to Will Bowditch for reporting it).
+
+
+
+ *************************
+ ** afex VERSION 0.11-x **
+ *************************
+
+ Changes in afex Version 0.11-x
+ Released October 2014
+
+ Significant User Visible Changes and New Features
+
+ o added allFit() function (written by Ben Bolker).
+
+ o mixed() gives warning if nested model provides worse fit
+ (logLik) than full model (when fitted with ML).
+
+ o print, summary, and anova method for mixed objects are now
+ identical.
+
+ o description of returned object from mixed() extended (Thanks
+ to Ben Bolker, see http://stackoverflow.com/a/25612960/289572)
+
+ o added return = "aov" to aov.car which returns the ANOVA
+ fitted with aov (with correct Error strata) so that it can be
+ passed to lsmeans for post-hoc tests or plotting (lsmip).
+
+
+ Bugfixes
+
+ o all required functions are now correctly imported avoiding
+ CRAN warnings and better functioning.
+
+ o data argument to lmer calls in mixed set correctly. Note that
+ still contrasts added to the data in mixed may prohibit use of
+ predict.merMod() or similar functions. It is recommended to
+ set the contrasts globally to "contr.sum", e.g.,
+ via set_sum_contrasts(), for correct functioning
+ (disable via set.data.arg argument for mixed).
+
+
+
+ ************************
+ ** afex VERSION 0.10-x **
+ ************************
+
+ Changes in afex Version 0.10-x
+ Released August 2014
+
+ Significant User Visible Changes and New Features
+
+ o afex does not change the global contrasts anymore when loading
+ the package (due to popular demand).
+
+ o new functions to globally set contrasts: set_sum_contrasts &
+ set_treatment_contrasts (and some more wrappers).
+
+ o Added more mixed model examples from Maxwell & Delaney, Chapter
+ 15 ("Multilevel Models for within subjects designs"), see ?mixed
+ and ?md_15.1. Thanks to Ulf Mertens.
+
+ Bugfixes
+
+ o removed bug when factor levels of within-subject factors
+ contained "+" or "-" and were not converted correctly. Added
+ tests for known bugs in aov.car.
+
+
+ ************************
+ ** afex VERSION 0.9-x **
+ ************************
+
+ Changes in afex Version 0.9-x
+ Released April 2014
+
+ Significant User Visible Changes and New Features
+
+ o added function aov4: another wrapper of car::Anova for ANOVA
+ models specified via lme4::lmer syntax.
+
+ o added return="marginal" to aov.car which returns the marginal
+ means of all effects (i.e., grand mean and mean of main
+ effects and interactions). Is also returned if return="full".
+
+ o testing the intercept in mixed models in now only optional.
+ The default is that the new argument test.intercept = FALSE.
+
+ o removed return="lme4" from aov.car.
+
+ o added argument intercept to nice.anova (default FALSE) which
+ allows to selective display the intercept in an ANOVA table.
+
+ o added method = "F" to mixed() which only returns the F-value
+ but no ddf (and hence no p-value). Experimental, not documented.
+
+ o renamed colname "stat" to "F" when method = "KR" (mixed).
+
+ o added tests (currently mainly for mixed()) via pkg testthat,
+ see tests/testthat.
+
+ Bugfixes
+
+ o increased requirement of R version and lme4 version.
+
+ o print.mixed should now propagate all warnings from lme4 (i.e.,
+ also the new convergence warnings).
+
+ o lme4 is now loaded at worker nodes for mixed (default,
+ turn of via check.contrasts)
+
+
+
+ ************************
+ ** afex VERSION 0.8-x **
+ ************************
+
+ Changes in afex Version 0.8-x
+ Released February 2014
+
+ Significant User Visible Changes and New Features
+
+ o removed renaming of within subject factor levels to names
+ with length 1 (which was introduced in 0.6).
+
+ o helper function round_ps which nicely rounds p-values
+ is now exported.
+
+ o warning about numerical non-centered variables in mixed
+ is now a message only.
+
+ o added examples data sets from Maxwell & Delaney (2004) for
+ within-subjects ANOVA and mixed models.
+
+ o reshape2 is now again in depends but coin only imported.
+
+ Bugfixes
+
+ o the default effect size (ges: generalized eta-squared) was
+ calculated wrong (the error term for the intercept was not
+ included). Sorry. This is now corrected (with new examples).
+
+ o removed bug that aov.car didn't work when running some ANCOVAs
+ (thanks to Gang Chen for reporting this).
+
+
+
+ ************************
+ ** afex VERSION 0.7-x **
+ ************************
+
+ Changes in afex Version 0.7-x
+ Released December 2013
+
+ Significant User Visible Changes and New Features
+
+ o nicer output of print.mixed
+
+ Bugfixes
+
+ o mixed() correctly converts all non-formula arguments to
+ formula correctly to a formula (gave error if formula
+ was a different object and not-available on cluster nodes).
+ Prints message if formula is converted to a formula.
+
+ o Using multicore for fitting the models prodcued erroneous
+ results (did not use correct contrasts at nodes). Now the
+ current contrasts are also set at the nodes.
+
+ o mixed() sets REML = FALSE if method = "LRT" and no
+ family argument is present (i.e., for LMMs) as LRTs
+ for models fitted with REML are not recommended.
+
+ o on the cluster nodes now only the lme4 namespace is
+ loaded (instead of using library) to avoid a CRAN note.
+
+
+ ************************
+ ** afex VERSION 0.6-x **
+ ************************
+
+ Changes in afex Version 0.6-x
+ Released September 2013
+
+ Significant User Visible Changes and New Features
+
+ o added LRT tests to mixed() which should replicate
+ the recommended test by Barr et al. (2013, JML).
+
+ o multicore estimation of (g)lmer models now available
+ through package parallel (argument cl) for mixed().
+
+ o added experimental "lme4" return method for
+ aov.car and ez.glm (which fits the data using lmer).
+
+ o reshape2 and stringr are not any more loaded when
+ loading afex (are now only imported via Imports)
+
+ Bugfixes
+
+ o Type 2 tests of mixed() were implemented incorrectly (i.e.,
+ they did not give what they should have given according
+ to the description in the help file).
+
+ o aov.car() and ez.glm() now convert factor levels of within
+ subjects factors to be of length one so that long levels
+ do not lead to problems when constructing the call to lm.
+ Thanks to Isaac Schwabacher for noticing this, see also:
+ https://bugs.r-project.org/bugzilla3/show_bug.cgi?id=15377
+
+ o mixed should now work with missing values as it construes
+ a new data object if the model.matrix from which the
+ different versions are fitted has nrow different to
+ nrow(data) (with warning). Thanks to Daniel Bunker
+ for reporting this.
+
+ o mixed should work with the newest version of lme4 (>= 1.0.4)
+ and the newst version of pbkrtest (>= 0.3-5.1), but not
+ with older versions (due to CRAN policy to disallow :::).
+
+
+ ************************
+ ** afex VERSION 0.5-x **
+ ************************
+
+ Changes in afex Version 0.5-x
+ Released May 2013
+
+ Significant User Visible Changes and New Features
+
+ o added argument factorize (default: TRUE) to aov.car and ez.glm:
+ all variables are now factorized per default. (now it is
+ necessary to set factorize=FALSE for ANCOVAs!)
+
+ o added argument per.parameter to mixed() which allows to specify
+ variables for which each parameter is tested (not only the
+ overall effect). Can be useful to test for ordered factors.
+ (only implemented for "Type 3" tests)
+
+ o added more informative startup message (thanks to Robert Volcic
+ and Lars Konieczny)
+
+ o mixed, ez.glm and aov.car now check for correct contrasts and set
+ factors to contr.sum if other contrasts are found (can be tunred
+ off via check.contrasts argument). Resetting the default contrast
+ to contr.treatment should therefore not interfere with afex.
+ (this is not intensly tested, so please report anything)
+
+ o mixed checks numeric variables if they are centered on 0 (and
+ gives warning if not).
+
+ Bugfixes
+
+ o checks if observed variable is in the data and throws
+ an error if not (nice.anova)
+
+
+ ************************
+ ** afex VERSION 0.4-x **
+ ************************
+
+ Changes in afex Version 0.4-x
+ Released February 2013
+
+ Significant User Visible Changes and New Features
+
+ o added generalized and partial eta-squared effect
+ sizes to nice.anova (this also included adding
+ observed arguments to aov.car, ez.glm, nice.anova)
+
+ o added new return arguments to aov.car and ez.glm
+ (nice, lm, data).
+
+ o changed default return value of aov.car and ez.glm
+ to "nice" which now returns a nice ANOVA table
+ (nice.anova)
+
+ o mixed has method = "PB" for obtaining parametric
+ bootstrapped p-values (e.g., for GLMMs)
+
+ o added alternative argument to compare.2.vectors.
+
+ o aov.car (and ez.glm) now give a warning if
+ observations are missing on within-subject factors.
+ (As before, cases with missing values are simply
+ excluded from the analysis)
+
+ o had to disable saving of the previous contrasts and
+ resetting those after detaching afex due to
+ CRAN policies (no assignment in global environment).
+
+ Bugfixes
+
+ o Bug when running mixed() inside a function and
+ handing the data.frame over as an argument fixed
+ (thanks, again, to Florent Duyme). See
+ bugs/eval.scoping.bug.R
+
+ o nice.anova did not work with a model with only one
+ within-subjects factor.
+
+
+
+ ************************
+ ** afex VERSION 0.3-x **
+ ************************
+
+ Changes in afex Version 0.3-x
+ Released August/September 2012
+
+ Significant User Visible Changes and New Features
+
+ o added function compare.2.vectors().
+
+ o Name of function univariate() changed to univ(), as
+ a function with this name is part of package multcomp.
+ This may leed to problems. Thanks to Florent Duyme for
+ spotting this.
+
+ o added return argument to aov.car() and ez.glm().
+
+ o added rather dubious Type 2 tests to mixed().
+
+ o aov.car checks if each id is only present in one
+ cell of the between subjects design.
+
+ Bugfixes
+
+ o aov.car now uses do.call when calling lm() to avoid local
+ variables in the call to lm() which could led to problems when
+ working with the lm model.
+
+ o mixed() now passes ... (further arguments to lmer) correctly.
+ (Now mixed uses match.call and eval on the call instead of
+ invoking lmer directly.)
+
+ o corrected bug that was introduced by pbkrtest v3.2 when
+ invoking the print method to an object of class mixed
+ (again thanks to Florent Duyme for spotting this).
+
+ o removed bug when factor levels of within-subject factors
+ were non-legal names (solution uses make.names).
+
diff --git a/R/afex-package.R b/R/afex-package.R
index fcce516..6f2c160 100644
--- a/R/afex-package.R
+++ b/R/afex-package.R
@@ -3,8 +3,8 @@
#' \tabular{ll}{
#' Package: \tab afex\cr
#' Type: \tab Package\cr
-#' Version: \tab 0.14-2\cr
-#' Date: \tab 2015-08-17\cr
+#' Version: \tab 0.15-2\cr
+#' Date: \tab 2015-10-24\cr
#' Depends: \tab R (>= 3.0.0), lme4 (>= 1.0.5), reshape2, lsmeans (>= 2.17)\cr
#' Encoding: \tab UTF-8\cr
#' License: \tab GPL (>=3)\cr
@@ -17,6 +17,6 @@
#' @name afex-package
#' @docType package
#' @title The afex Package
-#' @author Henrik Singmann, Ben Bolker, Jake Westfall, with contributions from Søren Højsgaard, John Fox, Michael A. Lawrence, Ulf Mertens
+#' @author Henrik Singmann, Ben Bolker, Jake Westfall, with contributions from Søren Højsgaard, John Fox, Michael A. Lawrence, Ulf Mertens, Frederik Aust
#' @keywords package
NULL
diff --git a/R/allFit.R b/R/allFit.R
index c0d7b2f..7794493 100644
--- a/R/allFit.R
+++ b/R/allFit.R
@@ -1,89 +1,89 @@
-#' Refit \code{lmer} model using multiple optimizers
-#'
-#' Attempt to re-fit a [g]lmer model with a range of optimizers.
-#' The default is to use all known optimizers for R that satisfy the
-#' requirements (do not require explicit gradients, allow
-#' box constraints), in three categories; (i) built-in
-#' (\code{minqa::bobyqa}, \code{lme4::Nelder_Mead}), (ii) wrapped via optimx
-#' (most of optimx's optimizers that allow box constraints require
-#' an explicit gradient function to be specified; the two provided
-#' here are really base R functions that can be accessed via optimx,
-#' (iii) wrapped via nloptr.
-#'
-#' @param m a fitted model with \code{lmer}
-#' @param meth.tab a matrix (or data.frame) with columns
-#' - method the name of a specific optimization method to pass to the optimizer
-#' (leave blank for built-in optimizers)
-#' - optimizer the \code{optimizer} function to use
-#' @param verbose print progress messages?
-#' @param maxfun number of iterations to allow for the optimization rountine.
-#' @param ... further arguments passed to \code{\link{update.merMod}} such as data.
-#'
-#' @details Needs packages \pkg{nloptr} and \pkg{optimx} to try out all optimizers. \pkg{optimx} needs to be loaded explicitly using \code{library} or \code{require}.
-#'
-#' @return a list of fitted \code{merMod} objects
-#' @seealso slice, slice2D in the bbmle package
-#' @author Ben Bolker
-#' @export
-#' @importFrom lme4 isGLMM lmerControl glmerControl
-#' @importFrom stats setNames update
-#' @examples
-#' \dontrun{
-#' require(optimx)
-#' gm1 <- glmer(cbind(incidence, size - incidence) ~ period + (1 | herd),
-#' data = cbpp, family = binomial)
-#' gm_all <- allFit(gm1)
-#' t(sapply(gm_all,fixef)) ## extract fixed effects
-#' sapply(gm_all,logLik) ## log-likelihoods
-#' sapply(gm_all,getME,"theta") ## theta parameters
-#' !sapply(gm_all,inherits,"try-error") ## was fit OK?
-#' }
-#'
-allFit <- function(m, meth.tab = cbind(optimizer=rep(c("bobyqa","Nelder_Mead", "optimx", "nloptwrap"), c( 1, 1, 2, 2)),method= c("", "", "nlminb","L-BFGS-B","NLOPT_LN_NELDERMEAD", "NLOPT_LN_BOBYQA")),verbose=TRUE,maxfun=1e5, ...)
-{
- stopifnot(length(dm <- dim(meth.tab)) == 2, dm[1] >= 1, dm[2] >= 2,
- is.character(optimizer <- meth.tab[,"optimizer"]),
- is.character(method <- meth.tab[,"method"]))
- fit.names <- paste(optimizer, method, sep=".")
- res <- setNames(as.list(fit.names), fit.names)
- for (i in seq_along(fit.names)) {
- if (verbose) cat(fit.names[i],": ")
- ctrl <- list(optimizer=optimizer[i])
- ctrl$optCtrl <- switch(optimizer[i],
- optimx = list(method = method[i]),
- nloptWrap = list(algorithm= method[i]),
- list(maxfun=maxfun))
- ctrl <- do.call(if(isGLMM(m)) glmerControl else lmerControl, ctrl)
- tt <- system.time(rr <- tryCatch(update(m, control = ctrl, ...), error = function(e) e))
- attr(rr, "optCtrl") <- ctrl$optCtrl # contains crucial info here
- attr(rr, "time") <- tt # store timing info
- res[[i]] <- rr
- if (verbose) cat("[OK]\n")
- }
- ##
- res
-}
-
-# #' @export
-# summary.allfit <- function(object, ...) {
-# which.OK <- !sapply(object,is,"error")
-# msgs <- lapply(object[which.OK],function(x) x at optinfo$conv$lme4$messages)
-# fixef <- t(sapply(object[which.OK],fixef))
-# llik <- sapply(object[which.OK],logLik)
-# times <- t(sapply(object[which.OK],attr,"time"))
-# feval <- sapply(object[which.OK],function(x) x at optinfo$feval)
-# sdcor <- t(sapply(object[which.OK],function(x) {
-# aa <- as.data.frame(VarCorr(x))
-# setNames(aa[,"sdcor"],c(lme4:::tnames(object[which.OK][[1]]),
-# if (isLMM(object[[1]])) "sigma" else NULL))
-# }))
-# namedList(which.OK,msgs,fixef,llik,sdcor,times,feval)
-# }
-#
-# #' @export
-# print.summary.allfit <- function(object,...) {
-# if (!which.OK==seq(length(object))) {
-# cat("some optimizers failed: ",
-# paste(names(object)[!which.OK],collapse=","),"\n")
-# }
+#' Refit \code{lmer} model using multiple optimizers
+#'
+#' Attempt to re-fit a [g]lmer model with a range of optimizers.
+#' The default is to use all known optimizers for R that satisfy the
+#' requirements (do not require explicit gradients, allow
+#' box constraints), in three categories; (i) built-in
+#' (\code{minqa::bobyqa}, \code{lme4::Nelder_Mead}), (ii) wrapped via optimx
+#' (most of optimx's optimizers that allow box constraints require
+#' an explicit gradient function to be specified; the two provided
+#' here are really base R functions that can be accessed via optimx,
+#' (iii) wrapped via nloptr.
+#'
+#' @param m a fitted model with \code{lmer}
+#' @param meth.tab a matrix (or data.frame) with columns
+#' - method the name of a specific optimization method to pass to the optimizer
+#' (leave blank for built-in optimizers)
+#' - optimizer the \code{optimizer} function to use
+#' @param verbose print progress messages?
+#' @param maxfun number of iterations to allow for the optimization rountine.
+#' @param ... further arguments passed to \code{\link{update.merMod}} such as data.
+#'
+#' @details Needs packages \pkg{nloptr} and \pkg{optimx} to try out all optimizers. \pkg{optimx} needs to be loaded explicitly using \code{library} or \code{require}.
+#'
+#' @return a list of fitted \code{merMod} objects
+#' @seealso slice, slice2D in the bbmle package
+#' @author Ben Bolker
+#' @export
+#' @importFrom lme4 isGLMM lmerControl glmerControl
+#' @importFrom stats setNames update
+#' @examples
+#' \dontrun{
+#' require(optimx)
+#' gm1 <- glmer(cbind(incidence, size - incidence) ~ period + (1 | herd),
+#' data = cbpp, family = binomial)
+#' gm_all <- allFit(gm1)
+#' t(sapply(gm_all,fixef)) ## extract fixed effects
+#' sapply(gm_all,logLik) ## log-likelihoods
+#' sapply(gm_all,getME,"theta") ## theta parameters
+#' !sapply(gm_all,inherits,"try-error") ## was fit OK?
+#' }
+#'
+allFit <- function(m, meth.tab = cbind(optimizer=rep(c("bobyqa","Nelder_Mead", "optimx", "nloptwrap"), c( 1, 1, 2, 2)),method= c("", "", "nlminb","L-BFGS-B","NLOPT_LN_NELDERMEAD", "NLOPT_LN_BOBYQA")),verbose=TRUE,maxfun=1e5, ...)
+{
+ stopifnot(length(dm <- dim(meth.tab)) == 2, dm[1] >= 1, dm[2] >= 2,
+ is.character(optimizer <- meth.tab[,"optimizer"]),
+ is.character(method <- meth.tab[,"method"]))
+ fit.names <- paste(optimizer, method, sep=".")
+ res <- setNames(as.list(fit.names), fit.names)
+ for (i in seq_along(fit.names)) {
+ if (verbose) cat(fit.names[i],": ")
+ ctrl <- list(optimizer=optimizer[i])
+ ctrl$optCtrl <- switch(optimizer[i],
+ optimx = list(method = method[i]),
+ nloptWrap = list(algorithm= method[i]),
+ list(maxfun=maxfun))
+ ctrl <- do.call(if(isGLMM(m)) glmerControl else lmerControl, ctrl)
+ tt <- system.time(rr <- tryCatch(update(m, control = ctrl, ...), error = function(e) e))
+ attr(rr, "optCtrl") <- ctrl$optCtrl # contains crucial info here
+ attr(rr, "time") <- tt # store timing info
+ res[[i]] <- rr
+ if (verbose) cat("[OK]\n")
+ }
+ ##
+ res
+}
+
+# #' @export
+# summary.allfit <- function(object, ...) {
+# which.OK <- !sapply(object,is,"error")
+# msgs <- lapply(object[which.OK],function(x) x at optinfo$conv$lme4$messages)
+# fixef <- t(sapply(object[which.OK],fixef))
+# llik <- sapply(object[which.OK],logLik)
+# times <- t(sapply(object[which.OK],attr,"time"))
+# feval <- sapply(object[which.OK],function(x) x at optinfo$feval)
+# sdcor <- t(sapply(object[which.OK],function(x) {
+# aa <- as.data.frame(VarCorr(x))
+# setNames(aa[,"sdcor"],c(lme4:::tnames(object[which.OK][[1]]),
+# if (isLMM(object[[1]])) "sigma" else NULL))
+# }))
+# namedList(which.OK,msgs,fixef,llik,sdcor,times,feval)
+# }
+#
+# #' @export
+# print.summary.allfit <- function(object,...) {
+# if (!which.OK==seq(length(object))) {
+# cat("some optimizers failed: ",
+# paste(names(object)[!which.OK],collapse=","),"\n")
+# }
# }
\ No newline at end of file
diff --git a/R/aov_car.R b/R/aov_car.R
index 9170f6a..e063d82 100644
--- a/R/aov_car.R
+++ b/R/aov_car.R
@@ -1,388 +1,390 @@
-#' Convenient ANOVA estimation for factorial designs
-#'
-#' These functions allow convenient specification of any type of ANOVAs (i.e., purely within-subjects ANOVAs, purely between-subjects ANOVAs, and mixed between-within or split-plot ANOVAs) for data in the \strong{long} format (i.e., one observation per row). If the data has more than one observation per individual and cell of the design (e.g., multiple responses per condition), the data will by automatically aggregated. The default settings reproduce results from commercial statistical p [...]
-#'
-#' @usage
-#' aov_ez(id, dv, data, between = NULL, within = NULL, covariate = NULL,
-#' observed = NULL, fun.aggregate = NULL, type = afex_options("type"),
-#' factorize = afex_options("factorize"),
-#' check.contrasts = afex_options("check.contrasts"),
-#' return = afex_options("return_aov"),
-#' anova_table = list(), ..., print.formula = FALSE)
-#'
-#' aov_car(formula, data, fun.aggregate = NULL, type = afex_options("type"),
-#' factorize = afex_options("factorize"),
-#' check.contrasts = afex_options("check.contrasts"),
-#' return = afex_options("return_aov"), observed = NULL,
-#' anova_table = list(), ...)
-#'
-#' aov_4(formula, data, observed = NULL, fun.aggregate = NULL, type = afex_options("type"),
-#' factorize = afex_options("factorize"),
-#' check.contrasts = afex_options("check.contrasts"),
-#' return = afex_options("return_aov"),
-#' anova_table = list(), ..., print.formula = FALSE)
-#'
-#'
-#' @param id \code{character} vector (of length 1) indicating the subject identifier column in \code{data}.
-#' @param dv \code{character} vector (of length 1) indicating the column containing the \strong{dependent variable} in \code{data}.
-#' @param between \code{character} vector indicating the \strong{between}-subject(s) factor(s)/column(s) in \code{data}. Default is \code{NULL} indicating no between-subjects factors.
-#' @param within \code{character} vector indicating the \strong{within}-subject(s)(or repeated-measures) factor(s)/column(s) in \code{data}. Default is \code{NULL} indicating no within-subjects factors.
-#' @param covariate \code{character} vector indicating the between-subject(s) covariate(s) (i.e., column(s)) in \code{data}. Default is \code{NULL} indicating no covariates.
-#' @param observed \code{character} vector indicating which of the variables are observed (i.e, measured) as compared to experimentally manipulated. The default effect size reported (generalized eta-squared) requires correct specification of the obsered (in contrast to manipulated) variables.
-#' @param formula A formula specifying the ANOVA model similar to \code{\link{aov}} (for \code{aov_car} or similar to \code{lme4:lmer} for \code{aov_4}). Should include an error term (i.e., \code{Error(id/...)} for \code{aov_car} or \code{(...|id)} for \code{aov_4}). Note that the within-subject factors do not need to be outside the Error term (this contrasts with \code{aov}). See Details.
-#' @param data A \code{data.frame} containing the data. Mandatory.
-#' @param fun.aggregate The function for aggregating the data before running the ANOVA if there is more than one observation per individual and cell of the design. The default \code{NULL} issues a warning if aggregation is necessary and uses \code{\link{mean}}. Pass \code{mean} directly to avoid the warning.
-#' @param type The type of sums of squares for the ANOVA. The default is given by \code{afex_options("type")}, which is \strong{initially set to 3}. Passed to \code{\link[car]{Anova}}. Possible values are \code{"II"}, \code{"III"}, \code{2}, or \code{3}.
-#' @param factorize logical. Should between subject factors be factorized (with note) before running the analysis. he default is given by \code{afex_options("factorize")}, which is initially \code{TRUE}. If one wants to run an ANCOVA, needs to be set to \code{FALSE} (in which case centering on 0 is checked on numeric variables).
-#' @param check.contrasts \code{logical}. Should contrasts for between-subject factors be checked and (if necessary) changed to be \code{"contr.sum"}. See details. The default is given by \code{afex_options("check.contrasts")}, which is initially \code{TRUE}.
-#' @param print.formula \code{aov_ez} and \code{aov_4} are wrapper for \code{aov_car}. This boolean argument indicates whether the formula in the call to \code{car.aov} should be printed.
-#' @param return What should be returned? The default is given by \code{afex_options("return_aov")}, which is initially \code{"afex_aov"}, returning an S3 object of class \code{afex_aov} for which various \link[=afex_aov-methods]{methods} exist (see there and below for more details). To avoid the (potentially costly) computation via \code{aov} set \code{return} to \code{"nice"} in which case only the nice ANOVA table is returned (produced by \code{\link{nice}}, this was the previous defa [...]
-# Possible values are \code{c("Anova", "lm", "data", "nice", "full", "all", "univariate", "marginal", "aov")} (possibly abbreviated).
-#' @param anova_table \code{list} of further arguments passed to function producing the ANOVA table. Arguments such as \code{es} (effect size) or \code{correction} are passed to either \code{anova.afex_aov} or \code{nice}. Note that those settings can also be changed once an object of class \code{afex_aov} is created by invoking the \code{anova} method directly.
-#' @param ... Further arguments passed to \code{fun.aggregate}.
-#'
-#' @return \code{aov_car}, \code{aov_4}, and \code{aov_ez} are wrappers for \code{\link[car]{Anova}} and \code{\link{aov}}, the return value is dependent on the \code{return} argument. Per default, an S3 object of class \code{"afex_aov"} is returned containing the following slots:
-#'
-#' \describe{
-#' \item{\code{"anova_table"}}{An ANOVA table of class \code{c("anova", "data.frame")}.}
-#' \item{\code{"aov"}}{\code{aov} object returned from \code{\link{aov}} (should not be used to evaluate significance of effects, but can be passed to \code{lsmeans} for post-hoc tests).}
-#' \item{\code{"Anova"}}{object returned from \code{\link[car]{Anova}}, an object of class \code{"Anova.mlm"} (if within-subjects factors are present) or of class \code{c("anova", "data.frame")}.}
-#' \item{\code{"lm"}}{the object fitted with \code{lm} and passed to \code{Anova} (i.e., an object of class \code{"lm"} or \code{"mlm"}). Also returned if \code{return = "lm"}.}
-#' \item{\code{"data"}}{a list containing: (1) \code{long} (the possibly aggregated data in long format used for \code{aov}), \code{wide} (the data used to fit the \code{lm} object), and \code{idata} (if within-subject factors are present, the \code{idata} argument passed to \code{car::Anova}). Also returned if \code{return = "data"}.}
-#' }
-#' In addition, the object has the following attributes: \code{"dv"}, \code{"id"}, \code{"within"}, \code{"between"}, and \code{"type"}.
-#'
-#' The \link[=afex_aov-methods]{print} method for \code{afex_aov} objects (invisibly) returns (and prints) the same as if \code{return} is \code{"nice"}: a nice ANOVA table (produced by \code{\link{nice}}) with the following columns: \code{Effect}, \code{df}, \code{MSE} (mean-squared errors), \code{F} (potentially with significant symbols), \code{ges} (generalized eta-squared), \code{p}.
-#'
-#' @details
-#'
-#' \subsection{Details of ANOVA Specification}{
-#' \code{aov_ez} will concatenate all between-subject factors using \code{*} (i.e., producing all main effects and interactions) and all covariates by \code{+} (i.e., adding only the main effects to the existing between-subject factors). The within-subject factors do fully interact with all between-subject factors and covariates. This is essentially identical to the behavior of SPSS's \code{glm} function.
-#'
-#' The \code{formula}s for \code{aov_car} or \code{aov_4} must contain a single \code{Error} term specifying the \code{ID} column and potential within-subject factors (you can use \code{\link{mixed}} for running mixed-effects models with multiple error terms). Factors outside the \code{Error} term are treated as between-subject factors (the within-subject factors specified in the \code{Error} term are ignored outside the \code{Error} term; in other words, it is not necessary to specify t [...]
-#' Suppressing the intercept (i.e, via \code{0 +} or \code{- 1}) is ignored. Specific specifications of effects (e.g., excluding terms with \code{-} or using \code{^}) could be okay but is not tested. Using the \code{\link{I}} or \code{\link{poly}} function within the formula is not tested and not supported!
-#'
-#' To run an ANCOVA you need to set \code{factorize = FALSE} and make sure that all variables have the correct type (i.e., factors are factors and numeric variables are numeric and centered).
-#'
-#' Note that the default behavior is to include calculation of the effect size generalized eta-squared for which \strong{all non-manipluated (i.e., observed)} variables need to be specified via the \code{observed} argument to obtain correct results. When changing the effect size to \code{"pes"} (partial eta-squared) or \code{"none"} via \code{anova_table} this becomes unnecessary.
-#'
-#' If \code{check.contrasts = TRUE}, contrasts will be set to \code{"contr.sum"} for all between-subject factors if default contrasts are not equal to \code{"contr.sum"} or \code{attrib(factor, "contrasts") != "contr.sum"}. (within-subject factors are hard-coded \code{"contr.sum"}.)
-#' }
-#'
-#' \subsection{Statistical Issues}{
-#' \strong{Type 3 sums of squares are default in \pkg{afex}.} While some authors argue that so-called type 3 sums of squares are dangerous and/or problematic (most notably Venables, 2000), they are the default in many commercial statistical application such as SPSS or SAS. Furthermore, statisticians with an applied perspective recommend type 3 tests (e.g., Maxwell and Delaney, 2004). Consequently, they are the default for the ANOVA functions described here. For some more discussion on th [...]
-#'
-#' Note that lower order effects (e.g., main effects) in type 3 ANOVAs are only meaningful with \href{http://www.ats.ucla.edu/stat/mult_pkg/faq/general/effect.htm}{effects coding}. That is, contrasts should be set to \code{\link{contr.sum}} to obtain meaningful results. This is imposed automatically for the functions discussed here as long as \code{check.contrasts} is \code{TRUE} (the default). I nevertheless recommend to set the contrasts globally to \code{contr.sum} via running \code{\ [...]
-#' }
-#'
-#' \subsection{Follow-Up Contrasts and Post-Hoc Tests}{
-#' The S3 object returned per default can be directly passed to \code{lsmeans::lsmeans} for further analysis. This allows to test any type of contrasts that might be of interest independent of whether or not this contrast involves between-subject variables, within-subject variables, or a combination thereof. The general procedure to run those contrasts is the following (see Examples for a full example):
-#'
-#' \enumerate{
-#' \item Estimate an \code{afex_aov} object with the function returned here. For example: \code{x <- aov_car(dv ~ a*b + (id/c), d)}
-#' \item Obtain a \code{\link[lsmeans]{ref.grid}} object by running \code{\link[lsmeans]{lsmeans}} on the \code{afex_aov} object from step 1 using the factors involved in the contrast. For example: \code{r <- lsmeans(x, ~a:c)}
-#' \item Create a list containing the desired contrasts on the reference grid object from step 2. For example: \code{con1 <- list(a_x = c(-1, 1, 0, 0, 0, 0), b_x = c(0, 0, -0.5, -0.5, 0, 1))}
-#' \item Test the contrast on the reference grid using \code{\link[lsmeans]{contrast}}. For example: \code{contrast(r, con1)}
-#' \item To control for multiple testing p-value adjustments can be specified. For example the Bonferroni-Holm correction: \code{contrast(r, con1, adjust = "holm")}
-#' }
-#'
-#' Note that \pkg{lsmeans} allows for a variety of advanced settings and simplifiations, for example: all pairwise comparison of a single factor using one command (e.g., \code{lsmeans(x, "a", contr = "pairwise")}) or advanced control for multiple testing by passing objects to \pkg{multcomp}. A comprehensive overview of the functionality is provided in the accompanying vignettes (see \href{http://cran.r-project.org/package=lsmeans}{here}).
-#'
-#' A caveat regarding the use of \pkg{lsmeans} concerns the assumption of sphericity for ANOVAs including within-subjects/repeated-measures factors (with more than two levels). While the ANOVA tables per default report results using the Greenhousse-Geisser correction, no such correction is available when using \pkg{lsmeans}. This may result in anti-conservative tests.
-#'
-#' \pkg{lsmeans} is loaded/attached automatically when loading \pkg{afex} via \code{library} or \code{require}.
-#' }
-#'
-#' \subsection{Methods for \code{afex_aov} Objects}{
-#' A full overview over the methods provided for \code{afex_aov} objects is provided in the corresponding help page: \code{\link{afex_aov-methods}}. The probably most important ones for end-users are \code{summary} and \code{anova}.
-#'
-#' The \code{summary} method returns, for ANOVAs containing within-subject (repeated-measures) factors with more than two levels, the complete univariate analysis: Results without df-correction, the Greenhouse-Geisser corrected results, the Hyunh-Feldt corrected results, and the results of the Mauchly test for sphericity.
-#'
-#' The \code{anova} method returns a \code{data.frame} of class \code{"anova"} containing the ANOVA table in numeric form (i.e., the one in slot \code{anova_table} of a \code{afex_aov}). This method has arguments such as \code{correction} and \code{es} and can be used to obtain an ANOVA table with different correction than the one initially specified.
-#' }
-#'
-#' @author Henrik Singmann
-#'
-#' The design of these functions was influenced by \code{\link[ez]{ezANOVA}} from package \pkg{ez}.
-#'
-#' @note Calculation of ANOVA models via \code{aov} (which is done per default) can be comparatively slow and produce comparatively large objects for ANOVAs with many within-subjects factors or levels. To avoid this calculation set the return argument to \code{"nice"}. This can also be done globally via \code{afex_options(return_aov = "nice")}. \code{return = "nice"} also produces the default output of previous versions of afex (versions 0.13 and earlier).
-#'
-#' The id variable and variables entered as within-subjects (i.e., repeated-measures) factors are silently converted to factors. Levels of within-subject factors are converted to valid variable names using \code{\link{make.names}(...,unique=TRUE)}. Unused factor levels are silently dropped on all variables.
-#'
-#' Contrasts attached to a factor as an attribute are probably not preserved and not supported.
-#'
-#' The workhorse is \code{aov_car}. \code{aov_4} and \code{aov_ez} only construe and pass an appropriate formula to \code{aov_car}. Use \code{print.formula = TRUE} to view this formula.
-#'
-#' In contrast to \code{\link{aov}} \code{aov_car} assumes that all factors to the right of \code{/} in the \code{Error} term are belonging together. Consequently, \code{Error(id/(a*b))} and \code{Error(id/a*b)} are identical (which is not true for \code{\link{aov}}).
-#'
-#' @seealso Various methods for objects of class \code{afex_aov} are available: \code{\link{afex_aov-methods}}
-#'
-#' \code{\link{nice}} creates the nice ANOVA tables which is by default printed. See also there for a slightly longer discussion of the available effect sizes.
-#'
-#' \code{\link{mixed}} provides a (formula) interface for obtaining p-values for mixed-models via \pkg{lme4}.
-#'
-#' @references Maxwell, S. E., & Delaney, H. D. (2004). \emph{Designing Experiments and Analyzing Data: A Model-Comparisons Perspective}. Mahwah, N.J.: Lawrence Erlbaum Associates.
-#'
-#' Venables, W.N. (2000). \emph{Exegeses on linear models}. Paper presented to the S-Plus User's Conference, Washington DC, 8-9 October 1998, Washington, DC. Available from: \url{http://www.stats.ox.ac.uk/pub/MASS3/Exegeses.pdf}
-#'
-#' @name aov_car
-#' @aliases aov_ez aov_car aov_4
-#' @export aov_ez aov_car aov_4
-#' @importFrom car Anova
-#' @importFrom stringr str_c str_detect str_replace_all str_extract
-#' @importFrom reshape2 dcast
-#' @importFrom lme4 findbars nobars
-#' @importFrom stats terms as.formula xtabs contrasts<- coef
-#'
-#' @example examples/examples.aov_car.R
-#'
-#'
-#' @encoding UTF-8
-#'
-
-
-
-
-aov_car <- function(formula, data, fun.aggregate = NULL, type = afex_options("type"), factorize = afex_options("factorize"), check.contrasts = afex_options("check.contrasts"), return = afex_options("return_aov"), observed = NULL, anova_table = list(), ...) {
- return <- match.arg(return, c("Anova", "lm", "data", "nice", "afex_aov", "univariate", "marginal", "aov"))
- # stuff copied from aov:
- Terms <- terms(formula, "Error", data = data)
- indError <- attr(Terms, "specials")$Error
- if (length(indError) > 1L)
- stop(sprintf(ngettext(length(indError), "there are %d Error terms: only 1 is allowed",
- "there are %d Error terms: only 1 is allowed"), length(indError)),
- domain = NA)
- # from here, code by Henrik Singmann:
- vars <- all.vars(formula)
- dv <- vars[1]
- #chec if dv is numeric:
- if (!is.numeric(data[,dv])) stop("dv needs to be numeric.")
- vars <- vars[-1]
- parts <- attr(terms(formula, "Error", data = data), "term.labels")
- error.term <- parts[str_detect(parts, "^Error\\(")]
- id <- all.vars(parse(text = error.term))[1]
- within <- all.vars(parse(text = error.term))[-1]
- between <- vars[!(vars %in% c(id, within))]
- effect.parts <- parts[!str_detect(parts, "^Error\\(")]
- effect.parts.no.within <- effect.parts[!str_detect(effect.parts, str_c("\\<",within,"\\>", collapse = "|"))]
- data <- droplevels(data) #remove empty levels.
- # make id and within variables to factors:
- if (!(is.factor(data[,id]))) data[,id] <- factor(data[,id])
- # factorize if necessary
- if (factorize) {
- if (any(!vapply(data[, between, drop = FALSE], is.factor, TRUE))) {
- to.factor <- between[!vapply(data[,between, drop = FALSE], is.factor, TRUE)]
- message(str_c("Converting to factor: ", str_c(to.factor, collapse = ", ")))
- for (tmp.c in to.factor) {
- data[,tmp.c] <- factor(data[,tmp.c])
- }
- }
- } else {
- # check if numeric variables are centered.
- c.ns <- between[vapply(data[, between, drop = FALSE], is.numeric, TRUE)]
- if (length(c.ns) > 0) {
- non.null <- c.ns[!abs(vapply(data[, c.ns, drop = FALSE], mean, 0)) < .Machine$double.eps ^ 0.5]
- if (length(non.null) > 0) warning(str_c("Numerical variables NOT centered on 0 (i.e., likely bogus results): ", str_c(non.null, collapse = ", ")))
- }
- }
- for (i in c(between, within)) {
- if (is.factor(data[,i]) && length(unique(data[,i])) == 1) stop(paste0("Factor \"", i, "\" consists of one level only. Remove factor from model?"))
- }
- # make formulas
- rh2 <- if (length(between) > 0) str_c(effect.parts.no.within, collapse = "+") else "1"
- lh1 <- str_c(id, if (length(between) > 0) str_c(between, collapse = "+") else NULL, sep = "+")
- rh1 <- str_c(within, collapse = "+")
- rh3 <- str_c(within, collapse = "*")
- # converting all within subject factors to factors and adding a leading charcter (x) if starting with a digit.
- for (within.factor in within) {
- if (is.factor(data[,within.factor])) levels(data[,within.factor]) <- make.names(levels(data[,within.factor]), unique = TRUE)
- else data[,within.factor] <- factor(as.character(data[,within.factor]), levels = unique(as.character(data[,within.factor])), labels = make.names(unique(as.character(data[,within.factor])), unique=TRUE))
- }
- # Check if each id is in only one between subjects cell.
- between.factors <- between[vapply(data[, between, drop = FALSE], is.factor, TRUE)]
- if (length(between.factors) > 0) {
- split.data <- split(data, lapply(between.factors, function(x) data[,x]))
- ids.per.condition <- lapply(split.data, function(x) unique(as.character(x[,id])))
- ids.in.more.condition <- unique(unlist(lapply(seq_along(ids.per.condition), function(x) unique(unlist(lapply(ids.per.condition[-x], function(y, z = ids.per.condition[[x]]) intersect(z, y)))))))
- if (length(ids.in.more.condition) > 0) stop(str_c("Following ids are in more than one between subjects condition:\n", str_c(ids.in.more.condition, collapse = ", ")))
- }
- # Is fun.aggregate NULL and aggregation necessary?
- if (is.null(fun.aggregate)) {
- if (any(xtabs(as.formula(str_c("~", id, if (length(within) > 0) "+", rh1)), data = data) > 1)) {
- warning("More than one observation per cell, aggregating the data using mean (i.e, fun.aggregate = mean)!")
- fun.aggregate <- mean
- }
- }
- # if return = "lme4" return the (aggregated) data fitted with lmer!
- # if (return == "lme4") {
- # warning("lme4 return is experimental!\nAlso: Missing values and contrasts not checked for return = 'lme4'!")
- # n.dat <- dcast(data, formula = as.formula(str_c(lh1, if (length(within) > 0) paste0("+", rh1) else "", "~ .", sep = "")), fun.aggregate = fun.aggregate, ..., value.var = dv)
- # colnames(n.dat)[length(colnames(n.dat))] <- "value"
- # f.within.new <- str_replace_all(rh1, pattern="\\+", replacement="*")
- # return(lmer(as.formula(str_c("value~", rh2, if (length(within) > 0) paste0("*", f.within.new) else "", "+ (1", if (length(within) > 0) paste0("+", f.within.new) else "", "|", id, ")" , sep = "")), data = n.dat))
- # }
- # prepare the data:
- tmp.dat <- dcast(data, formula = as.formula(str_c(lh1, if (length(within) > 0) rh1 else ".", sep = "~")), fun.aggregate = fun.aggregate, ..., value.var = dv)
- # check for missing values:
- if (any(is.na(tmp.dat))) {
- missing.values <- apply(tmp.dat, 1, function(x) any(is.na(x)))
- warning(str_c("Missing values for following ID(s):\n", str_c(tmp.dat[missing.values,1], collapse = ", "), "\nRemoving those cases from the analysis."))
- }
- # if (length(between) > 0) {
- # n_data_points <- xtabs(as.formula(paste("~", paste(between, collapse = "+"))), data = tmp.dat)
- # if (any(n_data_points == 0)) warning("Some cells of the fully crossed between-subjects design are empty. A full model might not be estimable.")
- # }
- # marginals: (disabled in April 2015)
- dat.ret <- dcast(data, formula = as.formula(str_c(str_c(lh1, if (length(within) > 0) rh1 else NULL, sep = "+"), "~.")), fun.aggregate = fun.aggregate, ..., value.var = dv)
- colnames(dat.ret)[length(colnames(dat.ret))] <- dv
- # full.formula <- as.formula(str_c(dv, " ~ ", str_c(c(between.factors, within), collapse = "*")))
- # all.terms <- attr(terms(full.formula), "term.labels")
- # marginals.out <- lapply(all.terms, function(x) aggregate(as.formula(str_c(dv, " ~ ", x)), dat.ret, mean))
- # names(marginals.out) <- all.terms
- # grand.mean <- data.frame(mean(dat.ret[,dv]))
- # colnames(grand.mean) <- dv
- # marginals.out <- c(grand_mean = list(grand.mean), marginals.out)
- # if (return == "marginal") {
- # return(marginals.out)
- # }
- if (length(between) > 0) {
- if (check.contrasts) {
- resetted <- NULL
- for (i in between) {
- if (is.factor(tmp.dat[,i])) {
- if (is.null(attr(tmp.dat[,i], "contrasts")) & (options("contrasts")[[1]][1] != "contr.sum")) {
- contrasts(tmp.dat[,i]) <- "contr.sum"
- resetted <- c(resetted, i)
- }
- else if (!is.null(attr(tmp.dat[,i], "contrasts")) && attr(tmp.dat[,i], "contrasts") != "contr.sum") {
- contrasts(tmp.dat[,i]) <- "contr.sum"
- resetted <- c(resetted, i)
- }
- }
- }
- if (!is.null(resetted)) message(str_c("Contrasts set to contr.sum for the following variables: ", str_c(resetted, collapse=", ")))
- } else {
- non_sum_contrast <- c()
- for (i in between) {
- if (is.factor(tmp.dat[,i])) {
- if (is.null(attr(tmp.dat[,i], "contrasts")) & (options("contrasts")[[1]][1] != "contr.sum")) {
- non_sum_contrast <- c(non_sum_contrast, between)
- }
- else if (!is.null(attr(tmp.dat[,i], "contrasts")) && attr(tmp.dat[,i], "contrasts") != "contr.sum") {
- non_sum_contrast <- c(non_sum_contrast, between)
- }
- }
- }
- if((type == 3 | type == "III") && (length(non_sum_contrast)>0)) warning(str_c("Calculating Type 3 sums with contrasts != 'contr.sum' for: ", paste0(non_sum_contrast, collapse=", "), "\n Results likely bogus or not interpretable!\n You probably want check.contrasts = TRUE or options(contrasts=c('contr.sum','contr.poly'))"))
- }
- }
- if (return %in% c("aov", "afex_aov")) include.aov <- TRUE
- else include.aov <- FALSE
- if(include.aov){
- if (check.contrasts) {
- factor_vars <- vapply(dat.ret[,c(within, between), drop = FALSE], is.factor, NA)
- contrasts <- as.list(rep("contr.sum", sum(factor_vars)))
- names(contrasts) <- c(within, between)[factor_vars]
- }
- #return(aov(formula(paste(dv, "~", paste(c(between, within), collapse = "*"), if (length(within) > 0) paste0("+Error(", id, "/(",paste(within, collapse="*"), "))") else NULL)), data=dat.ret, contrasts = contrasts))
- aov <- aov(formula(paste(dv, "~", paste(c(between, within), collapse = "*"), if (length(within) > 0) paste0("+Error(", id, "/(",paste(within, collapse="*"), "))") else NULL)), data=dat.ret, contrasts = contrasts)
- }
- if(return == "aov") return(aov)
- data.l <- list(long = dat.ret, wide = tmp.dat)
- if (return == "data") return(tmp.dat)
- # branching based on type of ANOVA
- if (length(within) > 0) { # if within-subject factors are present:
- # make idata argument
- if (length(within) > 1) {
- within.levels <- lapply(lapply(data[,within], levels), factor)
- idata <- rev(expand.grid(rev(within.levels)))
- } else {
- idata <- data.frame(levels(data[,within]))
- colnames(idata) <- within
- }
- # print(as.formula(str_c("cbind(",str_c(colnames(tmp.dat[-(seq_along(c(id, between)))]), collapse = ", "), ") ~ ", rh2)))
- # browser()
- tmp.lm <- do.call("lm", list(formula = as.formula(str_c("cbind(",str_c(colnames(tmp.dat[-(seq_along(c(id, between)))]), collapse = ", "), ") ~ ", rh2)), data = tmp.dat))
- # browser()
- if (any(is.na(coef(tmp.lm)))) stop("Some parameters are not estimable, most likely due to empty cells of the design (i.e., structural missings). Check your data.")
- if (return == "lm") return(tmp.lm)
- Anova.out <- Anova(tmp.lm, idata = idata, idesign = as.formula(str_c("~", rh3)), type = type)
- data.l <- c(data.l, idata = list(idata))
- } else { # if NO within-subjetc factors are present (i.e., purley between ANOVA):
- colnames(tmp.dat)[ncol(tmp.dat)] <- "dv"
- tmp.lm <- do.call("lm", list(formula = as.formula(str_c("dv ~ ", rh2)), data = tmp.dat))
- if (return == "lm") return(tmp.lm)
- Anova.out <- Anova(tmp.lm, type = type)
- }
- if (return == "afex_aov") {
- afex_aov <- list(
- anova_table = NULL,
- aov = aov,
- Anova = Anova.out,
- lm = tmp.lm,
- data = data.l
- )
- class(afex_aov) <- "afex_aov"
- attr(afex_aov, "dv") <- dv
- attr(afex_aov, "id") <- id
- attr(afex_aov, "within") <- within
- attr(afex_aov, "between") <- between
- attr(afex_aov, "type") <- type
- afex_aov$anova_table <- do.call("anova", args = c(object = list(afex_aov), observed = list(observed), anova_table))
- return(afex_aov)
- }
- if (return == "Anova") return(Anova.out)
- else if (return == "univariate") {
- if (class(Anova.out) == "Anova.mlm") return(summary(Anova.out, multivariate = FALSE))
- else return(Anova.out)
- }
- else if (return == "nice") {
- afex_aov <- list(
- anova_table = NULL,
- Anova = Anova.out
- )
- class(afex_aov) <- "afex_aov"
- attr(afex_aov, "dv") <- dv
- attr(afex_aov, "id") <- id
- attr(afex_aov, "within") <- within
- attr(afex_aov, "between") <- between
- attr(afex_aov, "type") <- type
- #afex_aov$anova_table <- do.call("anova", args = c(object = list(afex_aov), observed = list(observed), args.return))
- return(do.call("nice", args = c(object = list(afex_aov), observed = list(observed), anova_table)))
- }
-}
-
-aov_4 <- function(formula, data, observed = NULL, fun.aggregate = NULL, type = afex_options("type"), factorize = afex_options("factorize"), check.contrasts = afex_options("check.contrasts"), return = afex_options("return_aov"), anova_table = list(), ..., print.formula = FALSE) {
- #browser()
- barterms <- findbars(formula)
- if (length(barterms) > 1) stop("aov_4 only allows one random effect term")
- within <- all.vars(barterms[[1]][[2]])
- id <- all.vars(barterms[[1]][[3]])
- error <- str_c(" + Error(", id, if (length(within) > 0) "/(" else "", str_c(within, collapse = " * "), if (length(within) > 0) ")" else "", ")")
- lh <- as.character(nobars(formula))
- if (length(lh) == 1) {
- dv <- lh
- rh <- "1"
- } else {
- dv <- lh[2]
- rh <- lh[3]
- }
- formula <- str_c(dv, " ~ ", rh, error)
- if (print.formula) message(str_c("Formula send to aov_car: ", formula))
- aov_car(formula = as.formula(formula), data = data, fun.aggregate = fun.aggregate, type = type, return = return, factorize = factorize, check.contrasts = check.contrasts, observed = observed, anova_table = anova_table, ...)
-}
-
-
-
-aov_ez <- function(id, dv, data, between = NULL, within = NULL, covariate = NULL, observed = NULL, fun.aggregate = NULL, type = afex_options("type"), factorize = afex_options("factorize"), check.contrasts = afex_options("check.contrasts"), return = afex_options("return_aov"), anova_table = list(), ..., print.formula = FALSE) {
- if (is.null(between) & is.null(within)) stop("Either between or within need to be non-NULL!")
- if (!is.null(covariate)) covariate <- str_c(covariate, collapse = "+")
- #browser()
- rh <- if (!is.null(between) || !is.null(covariate)) str_c(if (!is.null(between)) str_c(between, collapse = " * ") else NULL, covariate, sep = " + ") else "1"
- error <- str_c(" + Error(", id, if (!is.null(within)) "/(" else "", str_c(within, collapse = " * "), if (length(within) > 0) ")" else "", ")")
- formula <- str_c(dv, " ~ ", rh, error)
- if (print.formula) message(str_c("Formula send to aov_car: ", formula))
- aov_car(formula = as.formula(formula), data = data, fun.aggregate = fun.aggregate, type = type, return = return, factorize = factorize, check.contrasts = check.contrasts, observed = observed, anova_table = anova_table, ...)
-}
-
-
+#' Convenient ANOVA estimation for factorial designs
+#'
+#' These functions allow convenient specification of any type of ANOVAs (i.e., purely within-subjects ANOVAs, purely between-subjects ANOVAs, and mixed between-within or split-plot ANOVAs) for data in the \strong{long} format (i.e., one observation per row). If the data has more than one observation per individual and cell of the design (e.g., multiple responses per condition), the data will by automatically aggregated. The default settings reproduce results from commercial statistical p [...]
+#'
+#' @usage
+#' aov_ez(id, dv, data, between = NULL, within = NULL, covariate = NULL,
+#' observed = NULL, fun.aggregate = NULL, type = afex_options("type"),
+#' factorize = afex_options("factorize"),
+#' check.contrasts = afex_options("check.contrasts"),
+#' return = afex_options("return_aov"),
+#' anova_table = list(), ..., print.formula = FALSE)
+#'
+#' aov_car(formula, data, fun.aggregate = NULL, type = afex_options("type"),
+#' factorize = afex_options("factorize"),
+#' check.contrasts = afex_options("check.contrasts"),
+#' return = afex_options("return_aov"), observed = NULL,
+#' anova_table = list(), ...)
+#'
+#' aov_4(formula, data, observed = NULL, fun.aggregate = NULL, type = afex_options("type"),
+#' factorize = afex_options("factorize"),
+#' check.contrasts = afex_options("check.contrasts"),
+#' return = afex_options("return_aov"),
+#' anova_table = list(), ..., print.formula = FALSE)
+#'
+#'
+#' @param id \code{character} vector (of length 1) indicating the subject identifier column in \code{data}.
+#' @param dv \code{character} vector (of length 1) indicating the column containing the \strong{dependent variable} in \code{data}.
+#' @param between \code{character} vector indicating the \strong{between}-subject(s) factor(s)/column(s) in \code{data}. Default is \code{NULL} indicating no between-subjects factors.
+#' @param within \code{character} vector indicating the \strong{within}-subject(s)(or repeated-measures) factor(s)/column(s) in \code{data}. Default is \code{NULL} indicating no within-subjects factors.
+#' @param covariate \code{character} vector indicating the between-subject(s) covariate(s) (i.e., column(s)) in \code{data}. Default is \code{NULL} indicating no covariates.
+#' @param observed \code{character} vector indicating which of the variables are observed (i.e, measured) as compared to experimentally manipulated. The default effect size reported (generalized eta-squared) requires correct specification of the obsered (in contrast to manipulated) variables.
+#' @param formula A formula specifying the ANOVA model similar to \code{\link{aov}} (for \code{aov_car} or similar to \code{lme4:lmer} for \code{aov_4}). Should include an error term (i.e., \code{Error(id/...)} for \code{aov_car} or \code{(...|id)} for \code{aov_4}). Note that the within-subject factors do not need to be outside the Error term (this contrasts with \code{aov}). See Details.
+#' @param data A \code{data.frame} containing the data. Mandatory.
+#' @param fun.aggregate The function for aggregating the data before running the ANOVA if there is more than one observation per individual and cell of the design. The default \code{NULL} issues a warning if aggregation is necessary and uses \code{\link{mean}}. Pass \code{mean} directly to avoid the warning.
+#' @param type The type of sums of squares for the ANOVA. The default is given by \code{afex_options("type")}, which is \strong{initially set to 3}. Passed to \code{\link[car]{Anova}}. Possible values are \code{"II"}, \code{"III"}, \code{2}, or \code{3}.
+#' @param factorize logical. Should between subject factors be factorized (with note) before running the analysis. he default is given by \code{afex_options("factorize")}, which is initially \code{TRUE}. If one wants to run an ANCOVA, needs to be set to \code{FALSE} (in which case centering on 0 is checked on numeric variables).
+#' @param check.contrasts \code{logical}. Should contrasts for between-subject factors be checked and (if necessary) changed to be \code{"contr.sum"}. See details. The default is given by \code{afex_options("check.contrasts")}, which is initially \code{TRUE}.
+#' @param print.formula \code{aov_ez} and \code{aov_4} are wrapper for \code{aov_car}. This boolean argument indicates whether the formula in the call to \code{car.aov} should be printed.
+#' @param return What should be returned? The default is given by \code{afex_options("return_aov")}, which is initially \code{"afex_aov"}, returning an S3 object of class \code{afex_aov} for which various \link[=afex_aov-methods]{methods} exist (see there and below for more details). To avoid the (potentially costly) computation via \code{aov} set \code{return} to \code{"nice"} in which case only the nice ANOVA table is returned (produced by \code{\link{nice}}, this was the previous defa [...]
+# Possible values are \code{c("Anova", "lm", "data", "nice", "full", "all", "univariate", "marginal", "aov")} (possibly abbreviated).
+#' @param anova_table \code{list} of further arguments passed to function producing the ANOVA table. Arguments such as \code{es} (effect size) or \code{correction} are passed to either \code{anova.afex_aov} or \code{nice}. Note that those settings can also be changed once an object of class \code{afex_aov} is created by invoking the \code{anova} method directly.
+#' @param ... Further arguments passed to \code{fun.aggregate}.
+#'
+#' @return \code{aov_car}, \code{aov_4}, and \code{aov_ez} are wrappers for \code{\link[car]{Anova}} and \code{\link{aov}}, the return value is dependent on the \code{return} argument. Per default, an S3 object of class \code{"afex_aov"} is returned containing the following slots:
+#'
+#' \describe{
+#' \item{\code{"anova_table"}}{An ANOVA table of class \code{c("anova", "data.frame")}.}
+#' \item{\code{"aov"}}{\code{aov} object returned from \code{\link{aov}} (should not be used to evaluate significance of effects, but can be passed to \code{lsmeans} for post-hoc tests).}
+#' \item{\code{"Anova"}}{object returned from \code{\link[car]{Anova}}, an object of class \code{"Anova.mlm"} (if within-subjects factors are present) or of class \code{c("anova", "data.frame")}.}
+#' \item{\code{"lm"}}{the object fitted with \code{lm} and passed to \code{Anova} (i.e., an object of class \code{"lm"} or \code{"mlm"}). Also returned if \code{return = "lm"}.}
+#' \item{\code{"data"}}{a list containing: (1) \code{long} (the possibly aggregated data in long format used for \code{aov}), \code{wide} (the data used to fit the \code{lm} object), and \code{idata} (if within-subject factors are present, the \code{idata} argument passed to \code{car::Anova}). Also returned if \code{return = "data"}.}
+#' }
+#' In addition, the object has the following attributes: \code{"dv"}, \code{"id"}, \code{"within"}, \code{"between"}, and \code{"type"}.
+#'
+#' The \link[=afex_aov-methods]{print} method for \code{afex_aov} objects (invisibly) returns (and prints) the same as if \code{return} is \code{"nice"}: a nice ANOVA table (produced by \code{\link{nice}}) with the following columns: \code{Effect}, \code{df}, \code{MSE} (mean-squared errors), \code{F} (potentially with significant symbols), \code{ges} (generalized eta-squared), \code{p}.
+#'
+#' @details
+#'
+#' \subsection{Details of ANOVA Specification}{
+#' \code{aov_ez} will concatenate all between-subject factors using \code{*} (i.e., producing all main effects and interactions) and all covariates by \code{+} (i.e., adding only the main effects to the existing between-subject factors). The within-subject factors do fully interact with all between-subject factors and covariates. This is essentially identical to the behavior of SPSS's \code{glm} function.
+#'
+#' The \code{formula}s for \code{aov_car} or \code{aov_4} must contain a single \code{Error} term specifying the \code{ID} column and potential within-subject factors (you can use \code{\link{mixed}} for running mixed-effects models with multiple error terms). Factors outside the \code{Error} term are treated as between-subject factors (the within-subject factors specified in the \code{Error} term are ignored outside the \code{Error} term; in other words, it is not necessary to specify t [...]
+#' Suppressing the intercept (i.e, via \code{0 +} or \code{- 1}) is ignored. Specific specifications of effects (e.g., excluding terms with \code{-} or using \code{^}) could be okay but is not tested. Using the \code{\link{I}} or \code{\link{poly}} function within the formula is not tested and not supported!
+#'
+#' To run an ANCOVA you need to set \code{factorize = FALSE} and make sure that all variables have the correct type (i.e., factors are factors and numeric variables are numeric and centered).
+#'
+#' Note that the default behavior is to include calculation of the effect size generalized eta-squared for which \strong{all non-manipluated (i.e., observed)} variables need to be specified via the \code{observed} argument to obtain correct results. When changing the effect size to \code{"pes"} (partial eta-squared) or \code{"none"} via \code{anova_table} this becomes unnecessary.
+#'
+#' If \code{check.contrasts = TRUE}, contrasts will be set to \code{"contr.sum"} for all between-subject factors if default contrasts are not equal to \code{"contr.sum"} or \code{attrib(factor, "contrasts") != "contr.sum"}. (within-subject factors are hard-coded \code{"contr.sum"}.)
+#' }
+#'
+#' \subsection{Statistical Issues}{
+#' \strong{Type 3 sums of squares are default in \pkg{afex}.} While some authors argue that so-called type 3 sums of squares are dangerous and/or problematic (most notably Venables, 2000), they are the default in many commercial statistical application such as SPSS or SAS. Furthermore, statisticians with an applied perspective recommend type 3 tests (e.g., Maxwell and Delaney, 2004). Consequently, they are the default for the ANOVA functions described here. For some more discussion on th [...]
+#'
+#' Note that lower order effects (e.g., main effects) in type 3 ANOVAs are only meaningful with \href{http://www.ats.ucla.edu/stat/mult_pkg/faq/general/effect.htm}{effects coding}. That is, contrasts should be set to \code{\link{contr.sum}} to obtain meaningful results. This is imposed automatically for the functions discussed here as long as \code{check.contrasts} is \code{TRUE} (the default). I nevertheless recommend to set the contrasts globally to \code{contr.sum} via running \code{\ [...]
+#' }
+#'
+#' \subsection{Follow-Up Contrasts and Post-Hoc Tests}{
+#' The S3 object returned per default can be directly passed to \code{lsmeans::lsmeans} for further analysis. This allows to test any type of contrasts that might be of interest independent of whether or not this contrast involves between-subject variables, within-subject variables, or a combination thereof. The general procedure to run those contrasts is the following (see Examples for a full example):
+#'
+#' \enumerate{
+#' \item Estimate an \code{afex_aov} object with the function returned here. For example: \code{x <- aov_car(dv ~ a*b + (id/c), d)}
+#' \item Obtain a \code{\link[lsmeans]{ref.grid}} object by running \code{\link[lsmeans]{lsmeans}} on the \code{afex_aov} object from step 1 using the factors involved in the contrast. For example: \code{r <- lsmeans(x, ~a:c)}
+#' \item Create a list containing the desired contrasts on the reference grid object from step 2. For example: \code{con1 <- list(a_x = c(-1, 1, 0, 0, 0, 0), b_x = c(0, 0, -0.5, -0.5, 0, 1))}
+#' \item Test the contrast on the reference grid using \code{\link[lsmeans]{contrast}}. For example: \code{contrast(r, con1)}
+#' \item To control for multiple testing p-value adjustments can be specified. For example the Bonferroni-Holm correction: \code{contrast(r, con1, adjust = "holm")}
+#' }
+#'
+#' Note that \pkg{lsmeans} allows for a variety of advanced settings and simplifiations, for example: all pairwise comparison of a single factor using one command (e.g., \code{lsmeans(x, "a", contr = "pairwise")}) or advanced control for multiple testing by passing objects to \pkg{multcomp}. A comprehensive overview of the functionality is provided in the accompanying vignettes (see \href{http://cran.r-project.org/package=lsmeans}{here}).
+#'
+#' A caveat regarding the use of \pkg{lsmeans} concerns the assumption of sphericity for ANOVAs including within-subjects/repeated-measures factors (with more than two levels). While the ANOVA tables per default report results using the Greenhousse-Geisser correction, no such correction is available when using \pkg{lsmeans}. This may result in anti-conservative tests.
+#'
+#' \pkg{lsmeans} is loaded/attached automatically when loading \pkg{afex} via \code{library} or \code{require}.
+#' }
+#'
+#' \subsection{Methods for \code{afex_aov} Objects}{
+#' A full overview over the methods provided for \code{afex_aov} objects is provided in the corresponding help page: \code{\link{afex_aov-methods}}. The probably most important ones for end-users are \code{summary} and \code{anova}.
+#'
+#' The \code{summary} method returns, for ANOVAs containing within-subject (repeated-measures) factors with more than two levels, the complete univariate analysis: Results without df-correction, the Greenhouse-Geisser corrected results, the Hyunh-Feldt corrected results, and the results of the Mauchly test for sphericity.
+#'
+#' The \code{anova} method returns a \code{data.frame} of class \code{"anova"} containing the ANOVA table in numeric form (i.e., the one in slot \code{anova_table} of a \code{afex_aov}). This method has arguments such as \code{correction} and \code{es} and can be used to obtain an ANOVA table with different correction than the one initially specified.
+#' }
+#'
+#' @author Henrik Singmann
+#'
+#' The design of these functions was influenced by \code{\link[ez]{ezANOVA}} from package \pkg{ez}.
+#'
+#' @note Calculation of ANOVA models via \code{aov} (which is done per default) can be comparatively slow and produce comparatively large objects for ANOVAs with many within-subjects factors or levels. To avoid this calculation set the return argument to \code{"nice"}. This can also be done globally via \code{afex_options(return_aov = "nice")}. \code{return = "nice"} also produces the default output of previous versions of afex (versions 0.13 and earlier).
+#'
+#' The id variable and variables entered as within-subjects (i.e., repeated-measures) factors are silently converted to factors. Levels of within-subject factors are converted to valid variable names using \code{\link{make.names}(...,unique=TRUE)}. Unused factor levels are silently dropped on all variables.
+#'
+#' Contrasts attached to a factor as an attribute are probably not preserved and not supported.
+#'
+#' The workhorse is \code{aov_car}. \code{aov_4} and \code{aov_ez} only construe and pass an appropriate formula to \code{aov_car}. Use \code{print.formula = TRUE} to view this formula.
+#'
+#' In contrast to \code{\link{aov}} \code{aov_car} assumes that all factors to the right of \code{/} in the \code{Error} term are belonging together. Consequently, \code{Error(id/(a*b))} and \code{Error(id/a*b)} are identical (which is not true for \code{\link{aov}}).
+#'
+#' @seealso Various methods for objects of class \code{afex_aov} are available: \code{\link{afex_aov-methods}}
+#'
+#' \code{\link{nice}} creates the nice ANOVA tables which is by default printed. See also there for a slightly longer discussion of the available effect sizes.
+#'
+#' \code{\link{mixed}} provides a (formula) interface for obtaining p-values for mixed-models via \pkg{lme4}.
+#'
+#' @references Maxwell, S. E., & Delaney, H. D. (2004). \emph{Designing Experiments and Analyzing Data: A Model-Comparisons Perspective}. Mahwah, N.J.: Lawrence Erlbaum Associates.
+#'
+#' Venables, W.N. (2000). \emph{Exegeses on linear models}. Paper presented to the S-Plus User's Conference, Washington DC, 8-9 October 1998, Washington, DC. Available from: \url{http://www.stats.ox.ac.uk/pub/MASS3/Exegeses.pdf}
+#'
+#' @name aov_car
+#' @aliases aov_ez aov_car aov_4
+#' @export aov_ez aov_car aov_4
+#' @importFrom car Anova
+#' @importFrom stringr str_c str_detect str_replace_all str_extract
+#' @importFrom reshape2 dcast
+#' @importFrom lme4 findbars nobars
+#' @importFrom stats terms as.formula xtabs contrasts<- coef
+#'
+#' @example examples/examples.aov_car.R
+#'
+#'
+#' @encoding UTF-8
+#'
+
+
+
+
+aov_car <- function(formula, data, fun.aggregate = NULL, type = afex_options("type"), factorize = afex_options("factorize"), check.contrasts = afex_options("check.contrasts"), return = afex_options("return_aov"), observed = NULL, anova_table = list(), ...) {
+ return <- match.arg(return, c("Anova", "lm", "data", "nice", "afex_aov", "univariate", "marginal", "aov"))
+ # stuff copied from aov:
+ Terms <- terms(formula, "Error", data = data)
+ indError <- attr(Terms, "specials")$Error
+ if (length(indError) > 1L)
+ stop(sprintf(ngettext(length(indError), "there are %d Error terms: only 1 is allowed",
+ "there are %d Error terms: only 1 is allowed"), length(indError)),
+ domain = NA)
+ # from here, code by Henrik Singmann:
+ vars <- all.vars(formula)
+ dv <- vars[1]
+ # transform to data.frame if necessary (e.g., when using dplyr)
+ data <- as.data.frame(data)
+ #check if dv is numeric:
+ if (!is.numeric(data[,dv])) stop("dv needs to be numeric.")
+ vars <- vars[-1]
+ parts <- attr(terms(formula, "Error", data = data), "term.labels")
+ error.term <- parts[str_detect(parts, "^Error\\(")]
+ id <- all.vars(parse(text = error.term))[1]
+ within <- all.vars(parse(text = error.term))[-1]
+ between <- vars[!(vars %in% c(id, within))]
+ effect.parts <- parts[!str_detect(parts, "^Error\\(")]
+ effect.parts.no.within <- if (length(within) == 0) effect.parts else effect.parts[!str_detect(effect.parts, str_c("\\b",within,"\\b", collapse = "|"))]
+ data <- droplevels(data) #remove empty levels.
+ # make id and within variables to factors:
+ if (!(is.factor(data[,id]))) data[,id] <- factor(data[,id])
+ # factorize if necessary
+ if (factorize) {
+ if (any(!vapply(data[, between, drop = FALSE], is.factor, TRUE))) {
+ to.factor <- between[!vapply(data[,between, drop = FALSE], is.factor, TRUE)]
+ message(str_c("Converting to factor: ", str_c(to.factor, collapse = ", ")))
+ for (tmp.c in to.factor) {
+ data[,tmp.c] <- factor(data[,tmp.c])
+ }
+ }
+ } else {
+ # check if numeric variables are centered.
+ c.ns <- between[vapply(data[, between, drop = FALSE], is.numeric, TRUE)]
+ if (length(c.ns) > 0) {
+ non.null <- c.ns[!abs(vapply(data[, c.ns, drop = FALSE], mean, 0)) < .Machine$double.eps ^ 0.5]
+ if (length(non.null) > 0) warning(str_c("Numerical variables NOT centered on 0 (i.e., likely bogus results): ", str_c(non.null, collapse = ", ")))
+ }
+ }
+ for (i in c(between, within)) {
+ if (is.factor(data[,i]) && length(unique(data[,i])) == 1) stop(paste0("Factor \"", i, "\" consists of one level only. Remove factor from model?"))
+ }
+ # make formulas
+ rh2 <- if (length(between) > 0) str_c(effect.parts.no.within, collapse = "+") else "1"
+ lh1 <- str_c(id, if (length(between) > 0) str_c(between, collapse = "+") else NULL, sep = "+")
+ rh1 <- str_c(within, collapse = "+")
+ rh3 <- str_c(within, collapse = "*")
+ # converting all within subject factors to factors and adding a leading charcter (x) if starting with a digit.
+ for (within.factor in within) {
+ if (is.factor(data[,within.factor])) levels(data[,within.factor]) <- make.names(levels(data[,within.factor]), unique = TRUE)
+ else data[,within.factor] <- factor(as.character(data[,within.factor]), levels = unique(as.character(data[,within.factor])), labels = make.names(unique(as.character(data[,within.factor])), unique=TRUE))
+ }
+ # Check if each id is in only one between subjects cell.
+ between.factors <- between[vapply(data[, between, drop = FALSE], is.factor, TRUE)]
+ if (length(between.factors) > 0) {
+ split.data <- split(data, lapply(between.factors, function(x) data[,x]))
+ ids.per.condition <- lapply(split.data, function(x) unique(as.character(x[,id])))
+ ids.in.more.condition <- unique(unlist(lapply(seq_along(ids.per.condition), function(x) unique(unlist(lapply(ids.per.condition[-x], function(y, z = ids.per.condition[[x]]) intersect(z, y)))))))
+ if (length(ids.in.more.condition) > 0) stop(str_c("Following ids are in more than one between subjects condition:\n", str_c(ids.in.more.condition, collapse = ", ")))
+ }
+ # Is fun.aggregate NULL and aggregation necessary?
+ if (is.null(fun.aggregate)) {
+ if (any(xtabs(as.formula(str_c("~", id, if (length(within) > 0) "+", rh1)), data = data) > 1)) {
+ warning("More than one observation per cell, aggregating the data using mean (i.e, fun.aggregate = mean)!")
+ fun.aggregate <- mean
+ }
+ }
+ # if return = "lme4" return the (aggregated) data fitted with lmer!
+ # if (return == "lme4") {
+ # warning("lme4 return is experimental!\nAlso: Missing values and contrasts not checked for return = 'lme4'!")
+ # n.dat <- dcast(data, formula = as.formula(str_c(lh1, if (length(within) > 0) paste0("+", rh1) else "", "~ .", sep = "")), fun.aggregate = fun.aggregate, ..., value.var = dv)
+ # colnames(n.dat)[length(colnames(n.dat))] <- "value"
+ # f.within.new <- str_replace_all(rh1, pattern="\\+", replacement="*")
+ # return(lmer(as.formula(str_c("value~", rh2, if (length(within) > 0) paste0("*", f.within.new) else "", "+ (1", if (length(within) > 0) paste0("+", f.within.new) else "", "|", id, ")" , sep = "")), data = n.dat))
+ # }
+ # prepare the data:
+ tmp.dat <- dcast(data, formula = as.formula(str_c(lh1, if (length(within) > 0) rh1 else ".", sep = "~")), fun.aggregate = fun.aggregate, ..., value.var = dv)
+ # check for missing values:
+ if (any(is.na(tmp.dat))) {
+ missing.values <- apply(tmp.dat, 1, function(x) any(is.na(x)))
+ warning(str_c("Missing values for following ID(s):\n", str_c(tmp.dat[missing.values,1], collapse = ", "), "\nRemoving those cases from the analysis."))
+ }
+ # if (length(between) > 0) {
+ # n_data_points <- xtabs(as.formula(paste("~", paste(between, collapse = "+"))), data = tmp.dat)
+ # if (any(n_data_points == 0)) warning("Some cells of the fully crossed between-subjects design are empty. A full model might not be estimable.")
+ # }
+ # marginals: (disabled in April 2015)
+ dat.ret <- dcast(data, formula = as.formula(str_c(str_c(lh1, if (length(within) > 0) rh1 else NULL, sep = "+"), "~.")), fun.aggregate = fun.aggregate, ..., value.var = dv)
+ colnames(dat.ret)[length(colnames(dat.ret))] <- dv
+ # full.formula <- as.formula(str_c(dv, " ~ ", str_c(c(between.factors, within), collapse = "*")))
+ # all.terms <- attr(terms(full.formula), "term.labels")
+ # marginals.out <- lapply(all.terms, function(x) aggregate(as.formula(str_c(dv, " ~ ", x)), dat.ret, mean))
+ # names(marginals.out) <- all.terms
+ # grand.mean <- data.frame(mean(dat.ret[,dv]))
+ # colnames(grand.mean) <- dv
+ # marginals.out <- c(grand_mean = list(grand.mean), marginals.out)
+ # if (return == "marginal") {
+ # return(marginals.out)
+ # }
+ if (length(between) > 0) {
+ if (check.contrasts) {
+ resetted <- NULL
+ for (i in between) {
+ if (is.factor(tmp.dat[,i])) {
+ if (is.null(attr(tmp.dat[,i], "contrasts")) & (options("contrasts")[[1]][1] != "contr.sum")) {
+ contrasts(tmp.dat[,i]) <- "contr.sum"
+ resetted <- c(resetted, i)
+ }
+ else if (!is.null(attr(tmp.dat[,i], "contrasts")) && attr(tmp.dat[,i], "contrasts") != "contr.sum") {
+ contrasts(tmp.dat[,i]) <- "contr.sum"
+ resetted <- c(resetted, i)
+ }
+ }
+ }
+ if (!is.null(resetted)) message(str_c("Contrasts set to contr.sum for the following variables: ", str_c(resetted, collapse=", ")))
+ } else {
+ non_sum_contrast <- c()
+ for (i in between) {
+ if (is.factor(tmp.dat[,i])) {
+ if (is.null(attr(tmp.dat[,i], "contrasts")) & (options("contrasts")[[1]][1] != "contr.sum")) {
+ non_sum_contrast <- c(non_sum_contrast, between)
+ }
+ else if (!is.null(attr(tmp.dat[,i], "contrasts")) && attr(tmp.dat[,i], "contrasts") != "contr.sum") {
+ non_sum_contrast <- c(non_sum_contrast, between)
+ }
+ }
+ }
+ if((type == 3 | type == "III") && (length(non_sum_contrast)>0)) warning(str_c("Calculating Type 3 sums with contrasts != 'contr.sum' for: ", paste0(non_sum_contrast, collapse=", "), "\n Results likely bogus or not interpretable!\n You probably want check.contrasts = TRUE or options(contrasts=c('contr.sum','contr.poly'))"))
+ }
+ }
+ if (return %in% c("aov", "afex_aov")) include.aov <- TRUE
+ else include.aov <- FALSE
+ if(include.aov){
+ if (check.contrasts) {
+ factor_vars <- vapply(dat.ret[,c(within, between), drop = FALSE], is.factor, NA)
+ contrasts <- as.list(rep("contr.sum", sum(factor_vars)))
+ names(contrasts) <- c(within, between)[factor_vars]
+ }
+ #return(aov(formula(paste(dv, "~", paste(c(between, within), collapse = "*"), if (length(within) > 0) paste0("+Error(", id, "/(",paste(within, collapse="*"), "))") else NULL)), data=dat.ret, contrasts = contrasts))
+ aov <- aov(formula(paste(dv, "~", paste(c(between, within), collapse = "*"), if (length(within) > 0) paste0("+Error(", id, "/(",paste(within, collapse="*"), "))") else NULL)), data=dat.ret, contrasts = contrasts)
+ }
+ if(return == "aov") return(aov)
+ data.l <- list(long = dat.ret, wide = tmp.dat)
+ if (return == "data") return(tmp.dat)
+ # branching based on type of ANOVA
+ if (length(within) > 0) { # if within-subject factors are present:
+ # make idata argument
+ if (length(within) > 1) {
+ within.levels <- lapply(lapply(data[,within], levels), factor)
+ idata <- rev(expand.grid(rev(within.levels)))
+ } else {
+ idata <- data.frame(levels(data[,within]))
+ colnames(idata) <- within
+ }
+ # print(as.formula(str_c("cbind(",str_c(colnames(tmp.dat[-(seq_along(c(id, between)))]), collapse = ", "), ") ~ ", rh2)))
+ # browser()
+ tmp.lm <- do.call("lm", list(formula = as.formula(str_c("cbind(",str_c(colnames(tmp.dat[-(seq_along(c(id, between)))]), collapse = ", "), ") ~ ", rh2)), data = tmp.dat))
+ # browser()
+ if (any(is.na(coef(tmp.lm)))) stop("Some parameters are not estimable, most likely due to empty cells of the design (i.e., structural missings). Check your data.")
+ if (return == "lm") return(tmp.lm)
+ Anova.out <- Anova(tmp.lm, idata = idata, idesign = as.formula(str_c("~", rh3)), type = type)
+ data.l <- c(data.l, idata = list(idata))
+ } else { # if NO within-subjetc factors are present (i.e., purley between ANOVA):
+ colnames(tmp.dat)[ncol(tmp.dat)] <- "dv"
+ tmp.lm <- do.call("lm", list(formula = as.formula(str_c("dv ~ ", rh2)), data = tmp.dat))
+ if (return == "lm") return(tmp.lm)
+ Anova.out <- Anova(tmp.lm, type = type)
+ }
+ if (return == "afex_aov") {
+ afex_aov <- list(
+ anova_table = NULL,
+ aov = aov,
+ Anova = Anova.out,
+ lm = tmp.lm,
+ data = data.l
+ )
+ class(afex_aov) <- "afex_aov"
+ attr(afex_aov, "dv") <- dv
+ attr(afex_aov, "id") <- id
+ attr(afex_aov, "within") <- within
+ attr(afex_aov, "between") <- between
+ attr(afex_aov, "type") <- type
+ afex_aov$anova_table <- do.call("anova", args = c(object = list(afex_aov), observed = list(observed), anova_table))
+ return(afex_aov)
+ }
+ if (return == "Anova") return(Anova.out)
+ else if (return == "univariate") {
+ if (class(Anova.out) == "Anova.mlm") return(summary(Anova.out, multivariate = FALSE))
+ else return(Anova.out)
+ }
+ else if (return == "nice") {
+ afex_aov <- list(
+ anova_table = NULL,
+ Anova = Anova.out
+ )
+ class(afex_aov) <- "afex_aov"
+ attr(afex_aov, "dv") <- dv
+ attr(afex_aov, "id") <- id
+ attr(afex_aov, "within") <- within
+ attr(afex_aov, "between") <- between
+ attr(afex_aov, "type") <- type
+ #afex_aov$anova_table <- do.call("anova", args = c(object = list(afex_aov), observed = list(observed), args.return))
+ return(do.call("nice", args = c(object = list(afex_aov), observed = list(observed), anova_table)))
+ }
+}
+
+aov_4 <- function(formula, data, observed = NULL, fun.aggregate = NULL, type = afex_options("type"), factorize = afex_options("factorize"), check.contrasts = afex_options("check.contrasts"), return = afex_options("return_aov"), anova_table = list(), ..., print.formula = FALSE) {
+ #browser()
+ barterms <- findbars(formula)
+ if (length(barterms) > 1) stop("aov_4 only allows one random effect term")
+ within <- all.vars(barterms[[1]][[2]])
+ id <- all.vars(barterms[[1]][[3]])
+ error <- str_c(" + Error(", id, if (length(within) > 0) "/(" else "", str_c(within, collapse = " * "), if (length(within) > 0) ")" else "", ")")
+ lh <- as.character(nobars(formula))
+ if (length(lh) == 1) {
+ dv <- lh
+ rh <- "1"
+ } else {
+ dv <- lh[2]
+ rh <- lh[3]
+ }
+ formula <- str_c(dv, " ~ ", rh, error)
+ if (print.formula) message(str_c("Formula send to aov_car: ", formula))
+ aov_car(formula = as.formula(formula), data = data, fun.aggregate = fun.aggregate, type = type, return = return, factorize = factorize, check.contrasts = check.contrasts, observed = observed, anova_table = anova_table, ...)
+}
+
+
+
+aov_ez <- function(id, dv, data, between = NULL, within = NULL, covariate = NULL, observed = NULL, fun.aggregate = NULL, type = afex_options("type"), factorize = afex_options("factorize"), check.contrasts = afex_options("check.contrasts"), return = afex_options("return_aov"), anova_table = list(), ..., print.formula = FALSE) {
+ if (is.null(between) & is.null(within)) stop("Either between or within need to be non-NULL!")
+ if (!is.null(covariate)) covariate <- str_c(covariate, collapse = "+")
+ #browser()
+ rh <- if (!is.null(between) || !is.null(covariate)) str_c(if (!is.null(between)) str_c(between, collapse = " * ") else NULL, covariate, sep = " + ") else "1"
+ error <- str_c(" + Error(", id, if (!is.null(within)) "/(" else "", str_c(within, collapse = " * "), if (length(within) > 0) ")" else "", ")")
+ formula <- str_c(dv, " ~ ", rh, error)
+ if (print.formula) message(str_c("Formula send to aov_car: ", formula))
+ aov_car(formula = as.formula(formula), data = data, fun.aggregate = fun.aggregate, type = type, return = return, factorize = factorize, check.contrasts = check.contrasts, observed = observed, anova_table = anova_table, ...)
+}
+
+
diff --git a/R/compare.2.vectors.R b/R/compare.2.vectors.R
index 1efcd4a..69a687c 100644
--- a/R/compare.2.vectors.R
+++ b/R/compare.2.vectors.R
@@ -1,93 +1,93 @@
-#' Compare two vectors using various tests.
-#'
-#' Compares two vectors \code{x} and \code{y} using t-test, Welch-test (also known as Satterthwaite), Wilcoxon-test, and a permutation test implemented in \pkg{coin}.
-#'
-#' @usage compare.2.vectors(x, y, paired = FALSE, na.rm = FALSE,
-#' tests = c("parametric", "nonparametric"), coin = TRUE,
-#' alternative = "two.sided",
-#' perm.distribution = approximate(100000),
-#' wilcox.exact = NULL, wilcox.correct = TRUE)
-#'
-#' @param x a (non-empty) numeric vector of data values.
-#' @param y a (non-empty) numeric vector of data values.
-#' @param paired a logical whether the data is paired. Default is \code{FALSE}.
-#' @param na.rm logical. Should \code{NA} be removed? Default is \code{FALSE}.
-#' @param tests Which tests to report, parametric or nonparamteric? The default \code{c("parametric", "nonparametric")} reports both. See details. (Arguments may be abbreviated).
-#' @param alternative a character, the alternative hypothesis must be one of \code{"two.sided"} (default), \code{"greater"} or \code{"less"}. You can specify just the initial letter, will be passed to all functions.
-#' @param coin logical or character. Should (permutation) tests from the \pkg{coin} package be reported? Default is \code{TRUE} corresponding to all implemented tests. \code{FALSE} calculates no tests from \pkg{coin}. A character vector may include any of the following (potentially abbreviated) implemented tests (see also Details): \code{c("permutation", "Wilcoxon", "median")}
-#' @param perm.distribution \code{distribution} argument to \pkg{coin}, see \code{\link[coin]{NullDistribution}} or , \code{\link[coin]{IndependenceTest}}. Defaults to \code{approximate(100000)} indicating an approximation of the excat conditional distribution with 100.000 Monte Carlo samples. One can use \code{"exact"} for small samples and if \code{paired = FALSE}.
-#' @param wilcox.exact \code{exact} argument to \code{\link{wilcox.test}}.
-#' @param wilcox.correct \code{correct} argument to \code{\link{wilcox.test}}.
-#'
-#' @details The \code{parametric} tests (currently) only contain the \emph{t}-test and Welch/Statterwaithe/Smith/unequal variance \emph{t}-test implemented in \code{\link{t.test}}. The latter one is only displayed if \code{paired = FALSE}.
-#'
-#' The \code{nonparametric} tests (currently) contain the Wilcoxon test implemented in \code{\link{wilcox.test}} (\code{stats::Wilcoxon}) and (if \code{coin = TRUE}) the following tests implemented in \pkg{coin}:
-#'
-#' \itemize{
-#' \item a \code{permutation} test \code{\link{oneway_test}} (the only test in this selction not using a rank transformation),
-#' \item the \code{Wilcoxon} test \code{\link{wilcox_test}} (\code{coin::Wilcoxon}), and
-#' \item the \code{median} test \code{median_test}.
-#' }
-#' Note that the two implementations of the Wilcoxon test probably differ. This is due to differences in the calculation of the Null distributions.
-#'
-#' @return a list with up to two elements (i.e., \code{paramteric} and/or \code{nonparamteric}) each containing a \code{data.frame} with the following columns: \code{test}, \code{test.statistic}, \code{test.value}, \code{test.df}, \code{p}.
-#'
-#' @export compare.2.vectors
-#' @importFrom coin oneway_test wilcox_test median_test approximate statistic pvalue
-#' @importFrom stats t.test wilcox.test
-#' @example examples/examples.compare.R
-#'
-#' @encoding UTF-8
-#'
-
-compare.2.vectors <- function(x, y, paired = FALSE, na.rm = FALSE, tests = c("parametric", "nonparametric"), coin = TRUE, alternative = "two.sided", perm.distribution = approximate(100000), wilcox.exact = NULL, wilcox.correct = TRUE) {
- #browser()
- tests <- match.arg(tests, c("parametric", "nonparametric"), several.ok = TRUE)
- if (na.rm) {
- x <- x[!is.na(x)]
- y <- y[!is.na(y)]
- } else if (any(is.na(x), is.na(y))) stop("NAs in data, use na.rm = TRUE.")
- out <- list()
- if (paired) if (!length(x) == length(y)) stop("length(x) needs to be equal to length(y) when paired is TRUE!")
- if ("parametric" %in% tests) {
- res.t <- t.test(x, y, paired = paired, var.equal = TRUE, alternative = alternative)
- parametric <- data.frame(test = "t", test.statistic = "t", test.value = res.t[["statistic"]], test.df = res.t[["parameter"]], p = res.t[["p.value"]], stringsAsFactors = FALSE)
- if (!paired) {
- res.welch <- t.test(x, y, paired = paired, var.equal = FALSE, alternative = alternative)
- parametric <- rbind(parametric, data.frame(test = "Welch", test.statistic = "t", test.value = res.welch[["statistic"]], test.df = res.welch[["parameter"]], p = res.welch[["p.value"]], stringsAsFactors = FALSE))
- }
- rownames(parametric) <- NULL
- out <- c(out, list(parametric = parametric))
- }
- if ("nonparametric" %in% tests) {
- implemented.tests <- c("permutation", "Wilcoxon", "median")
- res.wilcox <- wilcox.test(x, y, paired = paired, exact = wilcox.exact, correct = wilcox.correct, alternative = alternative)
- nonparametric <- data.frame(test = "stats::Wilcoxon", test.statistic = if (paired) "V" else "W", test.value = res.wilcox[["statistic"]], test.df = NA, p = res.wilcox[["p.value"]], stringsAsFactors = FALSE)
- if (!(coin == FALSE)) {
- dv <- c(x, y)
- iv <- factor(rep(c("A", "B"), c(length(x), length(y))))
- if (paired) {
- id <- factor(rep(1:length(x), 2))
- formula.coin <- as.formula(dv ~ iv | id)
- } else formula.coin <- as.formula(dv ~ iv)
- if (isTRUE(coin)) coin <- implemented.tests
- else coin <- match.arg(coin, implemented.tests, several.ok = TRUE)
- tryCatch(if ("permutation" %in% coin) {
- res.perm <- oneway_test(formula.coin, distribution=perm.distribution, alternative = alternative)
- nonparametric <- rbind(nonparametric, data.frame(test = "permutation", test.statistic = "Z", test.value = statistic(res.perm), test.df = NA, p = pvalue(res.perm)[1], stringsAsFactors = FALSE))
- }, error = function(e) warning(paste("coin::permutation test failed:", e)))
- tryCatch(if ("Wilcoxon" %in% coin) {
- res.coin.wilcox <- wilcox_test(formula.coin, distribution=perm.distribution, alternative = alternative)
- nonparametric <- rbind(nonparametric, data.frame(test = "coin::Wilcoxon", test.statistic = "Z", test.value = statistic(res.coin.wilcox), test.df = NA, p = pvalue(res.coin.wilcox)[1], stringsAsFactors = FALSE))
- }, error = function(e) warning(paste("coin::Wilcoxon test failed:", e)))
- tryCatch(if ("median" %in% coin) {
- res.median <- median_test(formula.coin, distribution=perm.distribution, alternative = alternative)
- nonparametric <- rbind(nonparametric, data.frame(test = "median", test.statistic = "Z", test.value = statistic(res.median), test.df = NA, p = pvalue(res.median)[1], stringsAsFactors = FALSE))
- }, error = function(e) warning(paste("coin::median test failed:", e)))
-
- }
- rownames(nonparametric) <- NULL
- out <- c(out, nonparametric = list(nonparametric))
- }
- out
-}
+#' Compare two vectors using various tests.
+#'
+#' Compares two vectors \code{x} and \code{y} using t-test, Welch-test (also known as Satterthwaite), Wilcoxon-test, and a permutation test implemented in \pkg{coin}.
+#'
+#' @usage compare.2.vectors(x, y, paired = FALSE, na.rm = FALSE,
+#' tests = c("parametric", "nonparametric"), coin = TRUE,
+#' alternative = "two.sided",
+#' perm.distribution = approximate(100000),
+#' wilcox.exact = NULL, wilcox.correct = TRUE)
+#'
+#' @param x a (non-empty) numeric vector of data values.
+#' @param y a (non-empty) numeric vector of data values.
+#' @param paired a logical whether the data is paired. Default is \code{FALSE}.
+#' @param na.rm logical. Should \code{NA} be removed? Default is \code{FALSE}.
+#' @param tests Which tests to report, parametric or nonparamteric? The default \code{c("parametric", "nonparametric")} reports both. See details. (Arguments may be abbreviated).
+#' @param alternative a character, the alternative hypothesis must be one of \code{"two.sided"} (default), \code{"greater"} or \code{"less"}. You can specify just the initial letter, will be passed to all functions.
+#' @param coin logical or character. Should (permutation) tests from the \pkg{coin} package be reported? Default is \code{TRUE} corresponding to all implemented tests. \code{FALSE} calculates no tests from \pkg{coin}. A character vector may include any of the following (potentially abbreviated) implemented tests (see also Details): \code{c("permutation", "Wilcoxon", "median")}
+#' @param perm.distribution \code{distribution} argument to \pkg{coin}, see \code{\link[coin]{NullDistribution}} or , \code{\link[coin]{IndependenceTest}}. Defaults to \code{approximate(100000)} indicating an approximation of the excat conditional distribution with 100.000 Monte Carlo samples. One can use \code{"exact"} for small samples and if \code{paired = FALSE}.
+#' @param wilcox.exact \code{exact} argument to \code{\link{wilcox.test}}.
+#' @param wilcox.correct \code{correct} argument to \code{\link{wilcox.test}}.
+#'
+#' @details The \code{parametric} tests (currently) only contain the \emph{t}-test and Welch/Statterwaithe/Smith/unequal variance \emph{t}-test implemented in \code{\link{t.test}}. The latter one is only displayed if \code{paired = FALSE}.
+#'
+#' The \code{nonparametric} tests (currently) contain the Wilcoxon test implemented in \code{\link{wilcox.test}} (\code{stats::Wilcoxon}) and (if \code{coin = TRUE}) the following tests implemented in \pkg{coin}:
+#'
+#' \itemize{
+#' \item a \code{permutation} test \code{\link{oneway_test}} (the only test in this selction not using a rank transformation),
+#' \item the \code{Wilcoxon} test \code{\link{wilcox_test}} (\code{coin::Wilcoxon}), and
+#' \item the \code{median} test \code{median_test}.
+#' }
+#' Note that the two implementations of the Wilcoxon test probably differ. This is due to differences in the calculation of the Null distributions.
+#'
+#' @return a list with up to two elements (i.e., \code{paramteric} and/or \code{nonparamteric}) each containing a \code{data.frame} with the following columns: \code{test}, \code{test.statistic}, \code{test.value}, \code{test.df}, \code{p}.
+#'
+#' @export compare.2.vectors
+#' @importFrom coin oneway_test wilcox_test median_test approximate statistic pvalue
+#' @importFrom stats t.test wilcox.test
+#' @example examples/examples.compare.R
+#'
+#' @encoding UTF-8
+#'
+
+compare.2.vectors <- function(x, y, paired = FALSE, na.rm = FALSE, tests = c("parametric", "nonparametric"), coin = TRUE, alternative = "two.sided", perm.distribution = approximate(100000), wilcox.exact = NULL, wilcox.correct = TRUE) {
+ #browser()
+ tests <- match.arg(tests, c("parametric", "nonparametric"), several.ok = TRUE)
+ if (na.rm) {
+ x <- x[!is.na(x)]
+ y <- y[!is.na(y)]
+ } else if (any(is.na(x), is.na(y))) stop("NAs in data, use na.rm = TRUE.")
+ out <- list()
+ if (paired) if (!length(x) == length(y)) stop("length(x) needs to be equal to length(y) when paired is TRUE!")
+ if ("parametric" %in% tests) {
+ res.t <- t.test(x, y, paired = paired, var.equal = TRUE, alternative = alternative)
+ parametric <- data.frame(test = "t", test.statistic = "t", test.value = res.t[["statistic"]], test.df = res.t[["parameter"]], p = res.t[["p.value"]], stringsAsFactors = FALSE)
+ if (!paired) {
+ res.welch <- t.test(x, y, paired = paired, var.equal = FALSE, alternative = alternative)
+ parametric <- rbind(parametric, data.frame(test = "Welch", test.statistic = "t", test.value = res.welch[["statistic"]], test.df = res.welch[["parameter"]], p = res.welch[["p.value"]], stringsAsFactors = FALSE))
+ }
+ rownames(parametric) <- NULL
+ out <- c(out, list(parametric = parametric))
+ }
+ if ("nonparametric" %in% tests) {
+ implemented.tests <- c("permutation", "Wilcoxon", "median")
+ res.wilcox <- wilcox.test(x, y, paired = paired, exact = wilcox.exact, correct = wilcox.correct, alternative = alternative)
+ nonparametric <- data.frame(test = "stats::Wilcoxon", test.statistic = if (paired) "V" else "W", test.value = res.wilcox[["statistic"]], test.df = NA, p = res.wilcox[["p.value"]], stringsAsFactors = FALSE)
+ if (!(coin == FALSE)) {
+ dv <- c(x, y)
+ iv <- factor(rep(c("A", "B"), c(length(x), length(y))))
+ if (paired) {
+ id <- factor(rep(1:length(x), 2))
+ formula.coin <- as.formula(dv ~ iv | id)
+ } else formula.coin <- as.formula(dv ~ iv)
+ if (isTRUE(coin)) coin <- implemented.tests
+ else coin <- match.arg(coin, implemented.tests, several.ok = TRUE)
+ tryCatch(if ("permutation" %in% coin) {
+ res.perm <- oneway_test(formula.coin, distribution=perm.distribution, alternative = alternative)
+ nonparametric <- rbind(nonparametric, data.frame(test = "permutation", test.statistic = "Z", test.value = statistic(res.perm), test.df = NA, p = pvalue(res.perm)[1], stringsAsFactors = FALSE))
+ }, error = function(e) warning(paste("coin::permutation test failed:", e)))
+ tryCatch(if ("Wilcoxon" %in% coin) {
+ res.coin.wilcox <- wilcox_test(formula.coin, distribution=perm.distribution, alternative = alternative)
+ nonparametric <- rbind(nonparametric, data.frame(test = "coin::Wilcoxon", test.statistic = "Z", test.value = statistic(res.coin.wilcox), test.df = NA, p = pvalue(res.coin.wilcox)[1], stringsAsFactors = FALSE))
+ }, error = function(e) warning(paste("coin::Wilcoxon test failed:", e)))
+ tryCatch(if ("median" %in% coin) {
+ res.median <- median_test(formula.coin, distribution=perm.distribution, alternative = alternative)
+ nonparametric <- rbind(nonparametric, data.frame(test = "median", test.statistic = "Z", test.value = statistic(res.median), test.df = NA, p = pvalue(res.median)[1], stringsAsFactors = FALSE))
+ }, error = function(e) warning(paste("coin::median test failed:", e)))
+
+ }
+ rownames(nonparametric) <- NULL
+ out <- c(out, nonparametric = list(nonparametric))
+ }
+ out
+}
diff --git a/R/deprecated.R b/R/deprecated.R
index 92a780a..a88fdf4 100644
--- a/R/deprecated.R
+++ b/R/deprecated.R
@@ -1,29 +1,29 @@
-#' Deprecated functions
-#'
-#' These functions have been renamed and deprecated in \pkg{afex}:
-#' \code{aov.car()} (use \code{\link{aov_car}()}),
-#' \code{ez.glm()} (use \code{\link{aov_ez}()}),
-#' \code{aov4()} (use \code{\link{aov_4}()}).
-#' @rdname deprecated
-#' @keywords internal
-#' @aliases afex-deprecated
-#' @param ... arguments passed from the old functions of the style
-#' \code{foo.bar()} to the new functions \code{foo_bar()}
-#' @export
-aov.car <- function(...) {
- .Deprecated("aov_car", "afex", "aov.car was renamed to aov_car and is now deprecated.")
- aov_car(...)
-}
-#' @rdname deprecated
-#' @export
-ez.glm <- function(...) {
- .Deprecated("aov_ez", "afex", "ez.glm was renamed to aov_ez and is now deprecated.")
- aov_ez(...)
-}
-#' @rdname deprecated
-#' @export
-aov4 <- function(...) {
- .Deprecated("aov_4", "afex", "aov4 was renamed to aov_4 and is now deprecated.")
- aov_4(...)
-}
-
+#' Deprecated functions
+#'
+#' These functions have been renamed and deprecated in \pkg{afex}:
+#' \code{aov.car()} (use \code{\link{aov_car}()}),
+#' \code{ez.glm()} (use \code{\link{aov_ez}()}),
+#' \code{aov4()} (use \code{\link{aov_4}()}).
+#' @rdname deprecated
+#' @keywords internal
+#' @aliases afex-deprecated
+#' @param ... arguments passed from the old functions of the style
+#' \code{foo.bar()} to the new functions \code{foo_bar()}
+#' @export
+aov.car <- function(...) {
+ .Deprecated("aov_car", "afex", "aov.car was renamed to aov_car and is now deprecated.")
+ aov_car(...)
+}
+#' @rdname deprecated
+#' @export
+ez.glm <- function(...) {
+ .Deprecated("aov_ez", "afex", "ez.glm was renamed to aov_ez and is now deprecated.")
+ aov_ez(...)
+}
+#' @rdname deprecated
+#' @export
+aov4 <- function(...) {
+ .Deprecated("aov_4", "afex", "aov4 was renamed to aov_4 and is now deprecated.")
+ aov_4(...)
+}
+
diff --git a/R/ems.R b/R/ems.R
index 0ff9495..f27a70a 100644
--- a/R/ems.R
+++ b/R/ems.R
@@ -1,107 +1,107 @@
-#' Expected values of mean squares for factorial designs
-#'
-#' Implements the Cornfield-Tukey algorithm for deriving the expected values of the mean squares for factorial designs.
-#'
-#' @param design A \code{formula} object specifying the factors in the design (except residual error, which is always implicitly included). The left hand side of the \code{~} is the symbol that will be used to denote the number of replications per lowest-level factor combination (I usually use "r" or "n"). The right hand side should include all fixed and random factors separated by \code{*}. Factor names should be single letters.
-#' @param nested A \code{character} vector, where each element is of the form \code{"A/B"}, indicating that the levels of factor B are nested under the levels of factor A.
-#' @param random A \code{character} string indicating, without spaces or any separating characters, which of the factors specified in the design are random.
-#'
-#' @return The returned value is a formatted table where the rows represent the mean squares, the columns represent the variance components that comprise the various mean squares, and the entries in each cell represent the terms that are multiplied and summed to form the expectation of the mean square for that row. Each term is either the lower-case version of one of the experimental factors, which indicates the number of levels for that factor, or a "1", which means the variance compone [...]
-#'
-#' @note Names for factors or parameters should only be of length 1 as they are simply concatenated in the returned table.
-#'
-#' @author Jake Westfall
-#'
-#' @seealso A detailed description with explanation of the example can be found \href{http://www.talkstats.com/showthread.php/18603-Share-your-functions-amp-code?p=82050&viewfull=1\#post82050}{elsewhere} (note that the \code{design} argument of the function described at the link behaves slightly different).
-#'
-#' Example applications of this function can be found here: \url{http://stats.stackexchange.com/a/122662/442}.
-#'
-#'
-#' @example examples/examples.ems.R
-#' @export
-
-
-ems <- function(design, nested=NULL, random=NULL){
- # modify design formula based on nested factors specified
- if(!is.null(nested)){
- terms <- attr(terms(design), "term.labels")
- # for each nested, get indices of all terms not involving their interaction
- keeps <- lapply(strsplit(nested, "/"), function(x){
- which(apply(sapply(x, grepl, terms), 1, function(x) !all(x)))
- })
- terms <- terms[Reduce(intersect, keeps)]
- formula <- paste(c(as.character(design)[2:1], paste(terms, collapse="+")), collapse="")
- design <- eval(parse(text=formula))
- }
-
- # build two-way table
- mat <- t(attr(terms(design), "factors"))
- terms <- tolower(as.character(attr(terms(design), "variables"))[-1])
-
- # resolve fixed/random dummies
- if (!is.null(random)){
- random <- unlist(strsplit(random,split=""))
- mat[,which(colnames(mat) %in% random)][mat[,
- which(colnames(mat) %in% random)]==1] <- ""
- mat[,which(!colnames(mat) %in% random)][mat[,
- which(!colnames(mat) %in% random)]==1] <- "fix"
- }
-
- # insert 1 in nested rows
- subs <- strsplit(rownames(mat), split=":")
- if(!is.null(nested)){
- nested <- strsplit(nested, split="/")
- for(term in nested){
- rows <- unlist(lapply(subs, function(x) term[2] %in% x))
- cols <- colnames(mat)==term[1]
- mat[rows,cols] <- "1"
- }
- }
- mat <- rbind(mat, e=rep("1", ncol(mat)))
-
- # insert numbers of levels for remaining cells
- for(row in seq(nrow(mat))){
- mat[row,][mat[row,]=="0"] <- tolower(colnames(mat)[mat[row,]=="0"])
- }
-
- # construct EMS table
- ems <- matrix(nrow=nrow(mat), ncol=nrow(mat),
- dimnames=list(Effect=rownames(mat),
- VarianceComponent=rev(rownames(mat))))
- # add nesting information to subscripts
- if (!is.null(nested)){
- subs <- lapply(subs, function(x){
- new <- x
- for (nest in seq(length(nested))){
- if (nested[[nest]][2] %in% x) new <- c(new, nested[[nest]][1])
- }
- return(new)
- })
- }
- subs[["e"]] <- colnames(mat)[-1]
- names(subs) <- rownames(mat)
- # rename #-of-reps variable to 'e' invisibly
- colnames(mat)[1] <- "e"
- # fill in EMS table
- for(effect in rownames(ems)){
- for(varcomp in colnames(ems)){
- effectVec <- unlist(strsplit(effect, ":"))
- ans <- mat[varcomp,-1*which(colnames(mat) %in% effectVec)]
- if ("fix" %in% ans) ans <- ""
- if (all(ans=="1")) ans <- "1"
- if (("1" %in% ans | "2" %in% ans) & !all(ans=="1")){
- ans <- ans[!ans %in% c("1","2")]
- }
- varcompVec <- unlist(strsplit(varcomp, ":"))
- if (!all(effectVec %in% subs[[varcomp]])) ans <- ""
- if (effect=="e" & varcomp=="e") ans <- "1"
- ems[effect,varcomp] <- paste(ans, collapse="")
- }
- }
- attr(ems, "terms") <- terms
- return(noquote(ems))
-}
-
-
-
-
+#' Expected values of mean squares for factorial designs
+#'
+#' Implements the Cornfield-Tukey algorithm for deriving the expected values of the mean squares for factorial designs.
+#'
+#' @param design A \code{formula} object specifying the factors in the design (except residual error, which is always implicitly included). The left hand side of the \code{~} is the symbol that will be used to denote the number of replications per lowest-level factor combination (I usually use "r" or "n"). The right hand side should include all fixed and random factors separated by \code{*}. Factor names should be single letters.
+#' @param nested A \code{character} vector, where each element is of the form \code{"A/B"}, indicating that the levels of factor B are nested under the levels of factor A.
+#' @param random A \code{character} string indicating, without spaces or any separating characters, which of the factors specified in the design are random.
+#'
+#' @return The returned value is a formatted table where the rows represent the mean squares, the columns represent the variance components that comprise the various mean squares, and the entries in each cell represent the terms that are multiplied and summed to form the expectation of the mean square for that row. Each term is either the lower-case version of one of the experimental factors, which indicates the number of levels for that factor, or a "1", which means the variance compone [...]
+#'
+#' @note Names for factors or parameters should only be of length 1 as they are simply concatenated in the returned table.
+#'
+#' @author Jake Westfall
+#'
+#' @seealso A detailed description with explanation of the example can be found \href{http://www.talkstats.com/showthread.php/18603-Share-your-functions-amp-code?p=82050&viewfull=1\#post82050}{elsewhere} (note that the \code{design} argument of the function described at the link behaves slightly different).
+#'
+#' Example applications of this function can be found here: \url{http://stats.stackexchange.com/a/122662/442}.
+#'
+#'
+#' @example examples/examples.ems.R
+#' @export
+
+
+ems <- function(design, nested=NULL, random=NULL){
+ # modify design formula based on nested factors specified
+ if(!is.null(nested)){
+ terms <- attr(terms(design), "term.labels")
+ # for each nested, get indices of all terms not involving their interaction
+ keeps <- lapply(strsplit(nested, "/"), function(x){
+ which(apply(sapply(x, grepl, terms), 1, function(x) !all(x)))
+ })
+ terms <- terms[Reduce(intersect, keeps)]
+ formula <- paste(c(as.character(design)[2:1], paste(terms, collapse="+")), collapse="")
+ design <- eval(parse(text=formula))
+ }
+
+ # build two-way table
+ mat <- t(attr(terms(design), "factors"))
+ terms <- tolower(as.character(attr(terms(design), "variables"))[-1])
+
+ # resolve fixed/random dummies
+ if (!is.null(random)){
+ random <- unlist(strsplit(random,split=""))
+ mat[,which(colnames(mat) %in% random)][mat[,
+ which(colnames(mat) %in% random)]==1] <- ""
+ mat[,which(!colnames(mat) %in% random)][mat[,
+ which(!colnames(mat) %in% random)]==1] <- "fix"
+ }
+
+ # insert 1 in nested rows
+ subs <- strsplit(rownames(mat), split=":")
+ if(!is.null(nested)){
+ nested <- strsplit(nested, split="/")
+ for(term in nested){
+ rows <- unlist(lapply(subs, function(x) term[2] %in% x))
+ cols <- colnames(mat)==term[1]
+ mat[rows,cols] <- "1"
+ }
+ }
+ mat <- rbind(mat, e=rep("1", ncol(mat)))
+
+ # insert numbers of levels for remaining cells
+ for(row in seq(nrow(mat))){
+ mat[row,][mat[row,]=="0"] <- tolower(colnames(mat)[mat[row,]=="0"])
+ }
+
+ # construct EMS table
+ ems <- matrix(nrow=nrow(mat), ncol=nrow(mat),
+ dimnames=list(Effect=rownames(mat),
+ VarianceComponent=rev(rownames(mat))))
+ # add nesting information to subscripts
+ if (!is.null(nested)){
+ subs <- lapply(subs, function(x){
+ new <- x
+ for (nest in seq(length(nested))){
+ if (nested[[nest]][2] %in% x) new <- c(new, nested[[nest]][1])
+ }
+ return(new)
+ })
+ }
+ subs[["e"]] <- colnames(mat)[-1]
+ names(subs) <- rownames(mat)
+ # rename #-of-reps variable to 'e' invisibly
+ colnames(mat)[1] <- "e"
+ # fill in EMS table
+ for(effect in rownames(ems)){
+ for(varcomp in colnames(ems)){
+ effectVec <- unlist(strsplit(effect, ":"))
+ ans <- mat[varcomp,-1*which(colnames(mat) %in% effectVec)]
+ if ("fix" %in% ans) ans <- ""
+ if (all(ans=="1")) ans <- "1"
+ if (("1" %in% ans | "2" %in% ans) & !all(ans=="1")){
+ ans <- ans[!ans %in% c("1","2")]
+ }
+ varcompVec <- unlist(strsplit(varcomp, ":"))
+ if (!all(effectVec %in% subs[[varcomp]])) ans <- ""
+ if (effect=="e" & varcomp=="e") ans <- "1"
+ ems[effect,varcomp] <- paste(ans, collapse="")
+ }
+ }
+ attr(ems, "terms") <- terms
+ return(noquote(ems))
+}
+
+
+
+
diff --git a/R/helpers.R b/R/helpers.R
index bb618fc..5abaec1 100644
--- a/R/helpers.R
+++ b/R/helpers.R
@@ -1,48 +1,48 @@
-#' Set/get global afex options
-#'
-#' Global afex options are used, for example, by \code{\link{aov_car}} (et al.) and \code{\link{mixed}}. But can be changed in each functions directly using an argument (which has precedence over the global options).
-#'
-#' @param ... One of three: (1) nothing, then returns all options; (2) a name of an option element, then returns its' value; (3) a name-value pair which sets the corresponding option to the new value (and returns nothing).
-#'
-#' @details The following arguments are currently set:
-#' \itemize{
-#' \item \code{check.contrasts} should contrasts be checked and changed to sum-to-zero contrasts? Default is \code{TRUE}.
-#' \item \code{type} type of sums-of-squares to be used for testing effects, default is 3 which reports Type 3 tests.
-#' \item \code{method_mixed}: Method used to obtain p-values in \code{\link{mixed}}, default is \code{"KR"} (which will change to \code{"LRT"} soon). (\code{mixed()} only)
-#' \item \code{return_aov}: Return value of the ANOVA functions (see \code{\link{aov_car}}), default is \code{"nice"}.
-#' \item \code{es_aov}: Effect size reported for ANOVAs (see \code{\link{aov_car}}), default is \code{"ges"} (generalized eta-squared).
-#' \item \code{correction_aov}: Correction used for within-subjects factors with more than two levels for ANOVAs (see \code{\link{aov_car}} or \code{\link{nice}}), default is \code{"GG"} (Greenhouse-Geisser correction). (ANOVA functions only)
-#' \item \code{factorize}: Should between subject factors be factorized (with note) before running the analysis? Default is \code{TRUE}. (ANOVA functions only)
-#' }
-#'
-#' @return depends on input, see above.
-#'
-#' @examples
-#' afex_options()
-#'
-#' afex_options("return_aov")
-#'
-#' afex_options("return_aov", "check.contrasts") # returns only first value!
-#'
-#' \dontrun{
-#' afex_options(return_aov = "nice")
-#' }
-#'
-#' @importFrom utils ls.str
-#'
-#' @export
-#'
-
-afex_options <- function(...)
-{
- dots <- list(...)
- if (length(dots) == 0) return(ls.str(envir = .afexEnv))
- else {
- if (!is.null(names(dots))) {
- if (length(dots) > 1) stop("afex_options can only return a single element.")
- for (i in seq_along(dots)) {
- assign(names(dots)[i], dots[[i]], envir = .afexEnv)
- }
- } else return(get(dots[[1]], envir = .afexEnv))
- }
-}
+#' Set/get global afex options
+#'
+#' Global afex options are used, for example, by \code{\link{aov_car}} (et al.) and \code{\link{mixed}}. But can be changed in each functions directly using an argument (which has precedence over the global options).
+#'
+#' @param ... One of three: (1) nothing, then returns all options; (2) a name of an option element, then returns its' value; (3) a name-value pair which sets the corresponding option to the new value (and returns nothing).
+#'
+#' @details The following arguments are currently set:
+#' \itemize{
+#' \item \code{check.contrasts} should contrasts be checked and changed to sum-to-zero contrasts? Default is \code{TRUE}.
+#' \item \code{type} type of sums-of-squares to be used for testing effects, default is 3 which reports Type 3 tests.
+#' \item \code{method_mixed}: Method used to obtain p-values in \code{\link{mixed}}, default is \code{"KR"} (which will change to \code{"LRT"} soon). (\code{mixed()} only)
+#' \item \code{return_aov}: Return value of the ANOVA functions (see \code{\link{aov_car}}), default is \code{"nice"}.
+#' \item \code{es_aov}: Effect size reported for ANOVAs (see \code{\link{aov_car}}), default is \code{"ges"} (generalized eta-squared).
+#' \item \code{correction_aov}: Correction used for within-subjects factors with more than two levels for ANOVAs (see \code{\link{aov_car}} or \code{\link{nice}}), default is \code{"GG"} (Greenhouse-Geisser correction). (ANOVA functions only)
+#' \item \code{factorize}: Should between subject factors be factorized (with note) before running the analysis? Default is \code{TRUE}. (ANOVA functions only)
+#' }
+#'
+#' @return depends on input, see above.
+#'
+#' @examples
+#' afex_options()
+#'
+#' afex_options("return_aov")
+#'
+#' afex_options("return_aov", "check.contrasts") # returns only first value!
+#'
+#' \dontrun{
+#' afex_options(return_aov = "nice")
+#' }
+#'
+#' @importFrom utils ls.str
+#'
+#' @export
+#'
+
+afex_options <- function(...)
+{
+ dots <- list(...)
+ if (length(dots) == 0) return(ls.str(envir = .afexEnv))
+ else {
+ if (!is.null(names(dots))) {
+ if (length(dots) > 1) stop("afex_options can only return a single element.")
+ for (i in seq_along(dots)) {
+ assign(names(dots)[i], dots[[i]], envir = .afexEnv)
+ }
+ } else return(get(dots[[1]], envir = .afexEnv))
+ }
+}
diff --git a/R/ks2013.3-data.R b/R/ks2013.3-data.R
index 2ea59fb..59a8536 100644
--- a/R/ks2013.3-data.R
+++ b/R/ks2013.3-data.R
@@ -1,28 +1,28 @@
-#' Data from Klauer & Singmann (2013, Experiment 3)
-#'
-#' Klauer and Singmann (2013) attempted to replicate an hypothesis of Morsanyi and Handley (2012) according to which individuals have an intuitive sense of logicality. Specifically, Morsanyi and Handley apparently provided evidence that the logical status of syllogisms (i.e., valid or invalid) affects participants liking ratings of the conclusion of syllogisms. Conclusions from valid syllogisms (e.g., Some snakes are poisonous. No poisonous animals are obbs. Some snakes are not obbs.) re [...]
-#'
-#' In their Experiment 3 Klauer and Singmann (2013) tested the idea that this finding was a consequence of the materials used and not an effect intuitive logic. More specifically, they observed that in the original study by Morsanyi and Handley (2012) a specific content always appeared with the same logical status. For example, the "ice-cream" content only ever appeared as an invalid syllogism as in the example above but never in a valid syllogism. In other words, content was perfectly c [...]
-#'
-#' The data.frame contains the raw responses of all 60 participants (30 per condition) reported in Klauer & Singmann (2013). Each participants provided 24 responses, 12 to valid and 12 to invalid syllogisms. Furthermore, 8 syllogisms had a believable conclusion (e.g., Some ice creams are not hot.), 8 had an abstract conclusion (e.g., Some snakes are not obbs.), and 8 had an unbelievable conclusion (e.g., Some animals are not monkeys.). The number of the contents corresponds to the number [...]
-#'
-#'
-#' @docType data
-#' @keywords dataset
-#' @name ks2013.3
-#' @usage ks2013.3
-#' @format A data.frame with 1440 rows and 6 variables.
-#' @source Klauer, K. C., & Singmann, H. (2013). Does logic feel good? Testing for intuitive detection of logicality in syllogistic reasoning. Journal of Experimental Psychology: Learning, Memory, and Cognition, 39(4), 1265-1273. http://doi.org/10.1037/a0030530
-#'
-#' Morsanyi, K., & Handley, S. J. (2012). Logic feels so good-I like it! Evidence for intuitive detection of logicality in syllogistic reasoning. Journal of Experimental Psychology: Learning, Memory, and Cognition, 38(3), 596-616. http://doi.org/10.1037/a0026099
-#'
-#'
-#'
-#'
-#' @encoding UTF-8
-#'
-#' @example examples/examples.ks2013.3.R
-NULL
-
-
-
+#' Data from Klauer & Singmann (2013, Experiment 3)
+#'
+#' Klauer and Singmann (2013) attempted to replicate an hypothesis of Morsanyi and Handley (2012) according to which individuals have an intuitive sense of logicality. Specifically, Morsanyi and Handley apparently provided evidence that the logical status of syllogisms (i.e., valid or invalid) affects participants liking ratings of the conclusion of syllogisms. Conclusions from valid syllogisms (e.g., Some snakes are poisonous. No poisonous animals are obbs. Some snakes are not obbs.) re [...]
+#'
+#' In their Experiment 3 Klauer and Singmann (2013) tested the idea that this finding was a consequence of the materials used and not an effect intuitive logic. More specifically, they observed that in the original study by Morsanyi and Handley (2012) a specific content always appeared with the same logical status. For example, the "ice-cream" content only ever appeared as an invalid syllogism as in the example above but never in a valid syllogism. In other words, content was perfectly c [...]
+#'
+#' The data.frame contains the raw responses of all 60 participants (30 per condition) reported in Klauer & Singmann (2013). Each participants provided 24 responses, 12 to valid and 12 to invalid syllogisms. Furthermore, 8 syllogisms had a believable conclusion (e.g., Some ice creams are not hot.), 8 had an abstract conclusion (e.g., Some snakes are not obbs.), and 8 had an unbelievable conclusion (e.g., Some animals are not monkeys.). The number of the contents corresponds to the number [...]
+#'
+#'
+#' @docType data
+#' @keywords dataset
+#' @name ks2013.3
+#' @usage ks2013.3
+#' @format A data.frame with 1440 rows and 6 variables.
+#' @source Klauer, K. C., & Singmann, H. (2013). Does logic feel good? Testing for intuitive detection of logicality in syllogistic reasoning. Journal of Experimental Psychology: Learning, Memory, and Cognition, 39(4), 1265-1273. http://doi.org/10.1037/a0030530
+#'
+#' Morsanyi, K., & Handley, S. J. (2012). Logic feels so good-I like it! Evidence for intuitive detection of logicality in syllogistic reasoning. Journal of Experimental Psychology: Learning, Memory, and Cognition, 38(3), 596-616. http://doi.org/10.1037/a0026099
+#'
+#'
+#'
+#'
+#' @encoding UTF-8
+#'
+#' @example examples/examples.ks2013.3.R
+NULL
+
+
+
diff --git a/R/md_12.1-data.R b/R/md_12.1-data.R
index 601ac2c..e3a70a6 100644
--- a/R/md_12.1-data.R
+++ b/R/md_12.1-data.R
@@ -1,45 +1,45 @@
-#' Data 12.1 from Maxwell & Delaney
-#'
-#' Hypothetical Reaction Time Data for 2 x 3 Perceptual Experiment: Example data for chapter 12 of Maaxwell and Delaney (2004, Table 12.1, p. 574) in long format. Has two within.subjects factors: angle and noise.
-#'
-#' Description from pp. 573:
-#'
-#' Suppose that a perceptual psychologist studying the visual system was interested in determining the
-#' extent to which interfering visual stimuli slow the ability to recognize letters. Subjects are
-#' brought into a laboratory and seated in front of a tachistoscope. Subjects are told that they will
-#' see either the letter T or the letter I displayed on the screen. In some trials, the letter appears
-#' by itself, but in other trials, the target letter is embedded in a group of other letters. This
-#' variation in the display constitutes the first factor, which is referred to as noise. The noise
-#' factor has two levels?absent and present. The other factor varied by the experimenter is where in
-#' the display the target letter appears. This factor, which is called angle, has three levels. The
-#' target letter is either shown at the center of the screen (i.e., 0° off-center, where the subject
-#' has been instructed to fixate), 4° off-center or 8° off-center (in each case, the deviation from the
-#' center varies randomly between left and right). Table 12.1 presents hypothetical data for 10
-#' subjects. As usual, the sample size is kept small to make the calculations easier to follow. The
-#' dependent measure is reaction time (latency), measured in milliseconds (ms), required by a subject
-#' to identify the correct target letter. Notice that each subject has six scores, one for each
-#' combination of the 2 x 3 design. In an actual perceptual experiment, each of these six scores would
-#' itself be the mean score for that subject across a number of trials in the particular condition.
-#' Although "trials" could be used as a third within-subjects factor in such a situation, more
-#' typically trials are simply averaged over to obtain a more stable measure of the individual's
-#' performance in each condition.
-#'
-#' @docType data
-#' @keywords dataset
-#' @name md_12.1
-#' @usage md_12.1
-#' @format A data.frame with 60 rows and 4 variables.
-#' @source Maxwell, S. E., & Delaney, H. D. (2004). Designing experiments and analyzing data: a model-comparisons perspective. Mahwah, N.J.: Lawrence Erlbaum Associates. p. 574
-
-#'
-#' @encoding UTF-8
-#'
-#' @examples
-#' data(md_12.1)
-#'
-#' # Table 12.5 (p. 578):
-#' aov_ez("id", "rt", md_12.1, within = c("angle", "noise"),
-#' args.return=list(correction = "none", es = "none"))
-#'
-#'
-NULL
+#' Data 12.1 from Maxwell & Delaney
+#'
+#' Hypothetical Reaction Time Data for 2 x 3 Perceptual Experiment: Example data for chapter 12 of Maaxwell and Delaney (2004, Table 12.1, p. 574) in long format. Has two within.subjects factors: angle and noise.
+#'
+#' Description from pp. 573:
+#'
+#' Suppose that a perceptual psychologist studying the visual system was interested in determining the
+#' extent to which interfering visual stimuli slow the ability to recognize letters. Subjects are
+#' brought into a laboratory and seated in front of a tachistoscope. Subjects are told that they will
+#' see either the letter T or the letter I displayed on the screen. In some trials, the letter appears
+#' by itself, but in other trials, the target letter is embedded in a group of other letters. This
+#' variation in the display constitutes the first factor, which is referred to as noise. The noise
+#' factor has two levels?absent and present. The other factor varied by the experimenter is where in
+#' the display the target letter appears. This factor, which is called angle, has three levels. The
+#' target letter is either shown at the center of the screen (i.e., 0° off-center, where the subject
+#' has been instructed to fixate), 4° off-center or 8° off-center (in each case, the deviation from the
+#' center varies randomly between left and right). Table 12.1 presents hypothetical data for 10
+#' subjects. As usual, the sample size is kept small to make the calculations easier to follow. The
+#' dependent measure is reaction time (latency), measured in milliseconds (ms), required by a subject
+#' to identify the correct target letter. Notice that each subject has six scores, one for each
+#' combination of the 2 x 3 design. In an actual perceptual experiment, each of these six scores would
+#' itself be the mean score for that subject across a number of trials in the particular condition.
+#' Although "trials" could be used as a third within-subjects factor in such a situation, more
+#' typically trials are simply averaged over to obtain a more stable measure of the individual's
+#' performance in each condition.
+#'
+#' @docType data
+#' @keywords dataset
+#' @name md_12.1
+#' @usage md_12.1
+#' @format A data.frame with 60 rows and 4 variables.
+#' @source Maxwell, S. E., & Delaney, H. D. (2004). Designing experiments and analyzing data: a model-comparisons perspective. Mahwah, N.J.: Lawrence Erlbaum Associates. p. 574
+
+#'
+#' @encoding UTF-8
+#'
+#' @examples
+#' data(md_12.1)
+#'
+#' # Table 12.5 (p. 578):
+#' aov_ez("id", "rt", md_12.1, within = c("angle", "noise"),
+#' args.return=list(correction = "none", es = "none"))
+#'
+#'
+NULL
diff --git a/R/md_15.1-data.R b/R/md_15.1-data.R
index b1c2f48..7360181 100644
--- a/R/md_15.1-data.R
+++ b/R/md_15.1-data.R
@@ -1,61 +1,61 @@
-#' Data 15.1 / 11.5 from Maxwell & Delaney
-#'
-#' Hypothetical IQ Data from 12 children at 4 time points: Example data for chapter 11/15 of Maxwell and Delaney (2004, Table 15.1, p. 766) in long format. Has two one within-subjects factor: time.
-#'
-#' Description from pp. 534:
-#'
-#' The data show that 12 subjects have been observed in each of 4 conditions. To make the example easier to discuss, let's suppose that the 12 subjects are children who have been observed at 30, 36, 42, and 48 months of age. In each case, the dependent variable is the child's age-normed general cognitive score on the McCarthy Scales of Children's Abilities. Although the test is normed so that the mean score is independent of age for the general population, our 12 children may come from a [...]
-#'
-#' To replicate the results in chapter 15 several different contrasts need to be applied, see Examples.
-#'
-#' \code{time} is time in months (centered at 0) and \code{timecat} is the same as a categorical variable.
-#'
-#' @docType data
-#' @keywords dataset
-#' @name md_15.1
-#' @usage md_15.1
-#' @format A data.frame with 48 rows and 4 variables.
-#' @source Maxwell, S. E., & Delaney, H. D. (2004). Designing experiments and analyzing data: a model-comparisons perspective. Mahwah, N.J.: Lawrence Erlbaum Associates. p. 766
-#' @author R code for examples written by Ulf Mertens and Henrik Singmann
-#'
-#' @examples
-#' ### replicate results from Table 15.2 to 15.6 (Maxwell & Delaney, 2004, pp. 774)
-#' data(md_15.1)
-#'
-#' ### ANOVA results (Table 15.2)
-#' aov_4(iq ~ timecat + (timecat|id),data=md_15.1, anova_table=list(correction = "none"))
-#'
-#' ### Table 15.3 (random intercept only)
-#' # we need to set the base level on the last level:
-#' contrasts(md_15.1$timecat) <- contr.treatment(4, base = 4)
-#' # "Type 3 Tests of Fixed Effects"
-#' (t15.3 <- mixed(iq ~ timecat + (1|id),data=md_15.1, check.contrasts=FALSE))
-#' # "Solution for Fixed Effects" and "Covariance Parameter Estimates"
-#' summary(t15.3$full.model)
-#'
-#' ### make Figure 15.2
-#' plot(NULL, NULL, ylim = c(80, 140), xlim = c(30, 48), ylab = "iq", xlab = "time")
-#' plyr::d_ply(md_15.1, plyr::.(id), function(x) lines(as.numeric(as.character(x$timecat)), x$iq))
-#'
-#' ### Table 15.4, page 789
-#' # random intercept plus slope
-#' (t15.4 <- mixed(iq ~ timecat + (1+time|id),data=md_15.1, check.contrasts=FALSE))
-#' summary(t15.4$full.model)
-#'
-#' ### Table 15.5, page 795
-#' # set up polynomial contrasts for timecat
-#' contrasts(md_15.1$timecat) <- contr.poly
-#' # fit all parameters separately
-#' (t15.5 <- mixed(iq ~ timecat + (1+time|id), data=md_15.1, check.contrasts=FALSE,
-#' per.parameter="timecat"))
-#' # quadratic trend is considerably off, conclusions stay the same.
-#'
-#'
-#' ### Table 15.6, page 797
-#' # growth curve model
-#' (t15.6 <- mixed(iq ~ time + (1+time|id),data=md_15.1))
-#' summary(t15.6$full.model)
-#'
-#' @encoding UTF-8
-#'
-NULL
+#' Data 15.1 / 11.5 from Maxwell & Delaney
+#'
+#' Hypothetical IQ Data from 12 children at 4 time points: Example data for chapter 11/15 of Maxwell and Delaney (2004, Table 15.1, p. 766) in long format. Has two one within-subjects factor: time.
+#'
+#' Description from pp. 534:
+#'
+#' The data show that 12 subjects have been observed in each of 4 conditions. To make the example easier to discuss, let's suppose that the 12 subjects are children who have been observed at 30, 36, 42, and 48 months of age. In each case, the dependent variable is the child's age-normed general cognitive score on the McCarthy Scales of Children's Abilities. Although the test is normed so that the mean score is independent of age for the general population, our 12 children may come from a [...]
+#'
+#' To replicate the results in chapter 15 several different contrasts need to be applied, see Examples.
+#'
+#' \code{time} is time in months (centered at 0) and \code{timecat} is the same as a categorical variable.
+#'
+#' @docType data
+#' @keywords dataset
+#' @name md_15.1
+#' @usage md_15.1
+#' @format A data.frame with 48 rows and 4 variables.
+#' @source Maxwell, S. E., & Delaney, H. D. (2004). Designing experiments and analyzing data: a model-comparisons perspective. Mahwah, N.J.: Lawrence Erlbaum Associates. p. 766
+#' @author R code for examples written by Ulf Mertens and Henrik Singmann
+#'
+#' @examples
+#' ### replicate results from Table 15.2 to 15.6 (Maxwell & Delaney, 2004, pp. 774)
+#' data(md_15.1)
+#'
+#' ### ANOVA results (Table 15.2)
+#' aov_4(iq ~ timecat + (timecat|id),data=md_15.1, anova_table=list(correction = "none"))
+#'
+#' ### Table 15.3 (random intercept only)
+#' # we need to set the base level on the last level:
+#' contrasts(md_15.1$timecat) <- contr.treatment(4, base = 4)
+#' # "Type 3 Tests of Fixed Effects"
+#' (t15.3 <- mixed(iq ~ timecat + (1|id),data=md_15.1, check.contrasts=FALSE))
+#' # "Solution for Fixed Effects" and "Covariance Parameter Estimates"
+#' summary(t15.3$full.model)
+#'
+#' ### make Figure 15.2
+#' plot(NULL, NULL, ylim = c(80, 140), xlim = c(30, 48), ylab = "iq", xlab = "time")
+#' plyr::d_ply(md_15.1, plyr::.(id), function(x) lines(as.numeric(as.character(x$timecat)), x$iq))
+#'
+#' ### Table 15.4, page 789
+#' # random intercept plus slope
+#' (t15.4 <- mixed(iq ~ timecat + (1+time|id),data=md_15.1, check.contrasts=FALSE))
+#' summary(t15.4$full.model)
+#'
+#' ### Table 15.5, page 795
+#' # set up polynomial contrasts for timecat
+#' contrasts(md_15.1$timecat) <- contr.poly
+#' # fit all parameters separately
+#' (t15.5 <- mixed(iq ~ timecat + (1+time|id), data=md_15.1, check.contrasts=FALSE,
+#' per.parameter="timecat"))
+#' # quadratic trend is considerably off, conclusions stay the same.
+#'
+#'
+#' ### Table 15.6, page 797
+#' # growth curve model
+#' (t15.6 <- mixed(iq ~ time + (1+time|id),data=md_15.1))
+#' summary(t15.6$full.model)
+#'
+#' @encoding UTF-8
+#'
+NULL
diff --git a/R/md_16.1-data.R b/R/md_16.1-data.R
index d11be90..f03a387 100644
--- a/R/md_16.1-data.R
+++ b/R/md_16.1-data.R
@@ -1,34 +1,34 @@
-#' Data 16.1 / 10.9 from Maxwell & Delaney
-#'
-#' Hypothetical Reaction Time Data for 2 x 3 Perceptual Experiment: Example data for chapter 12 of Maaxwell and Delaney (2004, Table 12.1, p. 574) in long format. Has two within.subjects factors: angle and noise.
-#'
-#' Description from pp. 829:
-#'
-#' As brief background, the goal of the study here is to examine the extent to which female and male clinical psychology graduate student trainees may assign different severity ratings to clients at initial intake. Three female and 3 male graduate students are randomly selected to participate and each is randomly assigned four clients with whom to do an intake interview, after which each clinical trainee assigns a severity rating to each client, producing the data shown in Table 16.1.
-#'
-#' Note that I changed the labeling of the id slightly, so that they are now labeled from 1 to 6. Furthermore, I changed the contrasts of sex to \code{contr.treatment} to replicate the exact results of Table 16.3 (p. 837).
-#'
-#' @docType data
-#' @keywords dataset
-#' @name md_16.1
-#' @usage md_16.1
-#' @format A data.frame with 24 rows and 3 variables.
-#' @source Maxwell, S. E., & Delaney, H. D. (2004). Designing experiments and analyzing data: a model-comparisons perspective. Mahwah, N.J.: Lawrence Erlbaum Associates. p. 574
-
-#'
-#' @examples
-#' ### replicate results from Table 16.3 (Maxwell & Delaney, 2004, p. 837)
-#' data(md_16.1)
-#'
-#' # original results need treatment contrasts:
-#' (mixed1_orig <- mixed(severity ~ sex + (1|id), md_16.1, check.contrasts=FALSE))
-#' summary(mixed1_orig$full.model)
-#'
-#' # p-values stay the same with afex default contrasts (contr.sum),
-#' # but estimates and t-values for the fixed effects parameters change.
-#' (mixed1 <- mixed(severity ~ sex + (1|id), md_16.1))
-#' summary(mixed1$full.model)
-#'
-#' @encoding UTF-8
-#'
-NULL
+#' Data 16.1 / 10.9 from Maxwell & Delaney
+#'
+#' Hypothetical Reaction Time Data for 2 x 3 Perceptual Experiment: Example data for chapter 12 of Maaxwell and Delaney (2004, Table 12.1, p. 574) in long format. Has two within.subjects factors: angle and noise.
+#'
+#' Description from pp. 829:
+#'
+#' As brief background, the goal of the study here is to examine the extent to which female and male clinical psychology graduate student trainees may assign different severity ratings to clients at initial intake. Three female and 3 male graduate students are randomly selected to participate and each is randomly assigned four clients with whom to do an intake interview, after which each clinical trainee assigns a severity rating to each client, producing the data shown in Table 16.1.
+#'
+#' Note that I changed the labeling of the id slightly, so that they are now labeled from 1 to 6. Furthermore, I changed the contrasts of sex to \code{contr.treatment} to replicate the exact results of Table 16.3 (p. 837).
+#'
+#' @docType data
+#' @keywords dataset
+#' @name md_16.1
+#' @usage md_16.1
+#' @format A data.frame with 24 rows and 3 variables.
+#' @source Maxwell, S. E., & Delaney, H. D. (2004). Designing experiments and analyzing data: a model-comparisons perspective. Mahwah, N.J.: Lawrence Erlbaum Associates. p. 574
+
+#'
+#' @examples
+#' ### replicate results from Table 16.3 (Maxwell & Delaney, 2004, p. 837)
+#' data(md_16.1)
+#'
+#' # original results need treatment contrasts:
+#' (mixed1_orig <- mixed(severity ~ sex + (1|id), md_16.1, check.contrasts=FALSE))
+#' summary(mixed1_orig$full.model)
+#'
+#' # p-values stay the same with afex default contrasts (contr.sum),
+#' # but estimates and t-values for the fixed effects parameters change.
+#' (mixed1 <- mixed(severity ~ sex + (1|id), md_16.1))
+#' summary(mixed1$full.model)
+#'
+#' @encoding UTF-8
+#'
+NULL
diff --git a/R/md_16.4-data.R b/R/md_16.4-data.R
index 247ee2d..91e0dc2 100644
--- a/R/md_16.4-data.R
+++ b/R/md_16.4-data.R
@@ -1,34 +1,34 @@
-#' Data 16.4 from Maxwell & Delaney
-#'
-#' Data from a hypothetical inductive reasoning study.
-#'
-#'
-#' Description from pp. 841:
-#'
-#' Suppose an educational psychologist has developed an intervention to teach inductive reasoning skills to school children. She decides to test the efficacy of her intervention by conducting a randomized design. Three classrooms of students are randomly assigned to the treatment condition, and 3 other classrooms are assigned to the control.
-#'
-#' Table 16.4 shows hypothetical data collected from 29 children who participated in the study assessing the effectiveness of the intervention to increase inductive reasoning skills. We want to call your attention to several aspects of the data. First, the 15 children with condition values of 0 received the control, whereas the 14 children with condition values of 1 received the treatment. Second, 4 of the children in the control condition were students in control Classroom 1, 6 of them [...]
-#'
-#' Note that it would make a lot more sense to change the labeling of room from 1 to 3 nested within cond to 1 to 6. However, I keep this in line with the original. The random effects term in the call to mixed is therefore a little bit uncommon.#'
-#'
-#' @docType data
-#' @keywords dataset
-#' @name md_16.4
-#' @usage md_16.4
-#' @format A data.frame with 24 rows and 3 variables.
-#' @source Maxwell, S. E., & Delaney, H. D. (2004). Designing experiments and analyzing data: a model-comparisons perspective. Mahwah, N.J.: Lawrence Erlbaum Associates. p. 574
-#'
-#' @encoding UTF-8
-#'
-#' @examples
-#' # data for next examples (Maxwell & Delaney, Table 16.4)
-#' data(md_16.4)
-#' str(md_16.4)
-#'
-#' ### replicate results from Table 16.6 (Maxwell & Delaney, 2004, p. 845)
-#' # p-values (almost) hold:
-#' (mixed2 <- mixed(induct ~ cond + (1|room:cond), md_16.4))
-#' # (1|room:cond) is needed because room is nested within cond.
-#'
-#'
-NULL
+#' Data 16.4 from Maxwell & Delaney
+#'
+#' Data from a hypothetical inductive reasoning study.
+#'
+#'
+#' Description from pp. 841:
+#'
+#' Suppose an educational psychologist has developed an intervention to teach inductive reasoning skills to school children. She decides to test the efficacy of her intervention by conducting a randomized design. Three classrooms of students are randomly assigned to the treatment condition, and 3 other classrooms are assigned to the control.
+#'
+#' Table 16.4 shows hypothetical data collected from 29 children who participated in the study assessing the effectiveness of the intervention to increase inductive reasoning skills. We want to call your attention to several aspects of the data. First, the 15 children with condition values of 0 received the control, whereas the 14 children with condition values of 1 received the treatment. Second, 4 of the children in the control condition were students in control Classroom 1, 6 of them [...]
+#'
+#' Note that it would make a lot more sense to change the labeling of room from 1 to 3 nested within cond to 1 to 6. However, I keep this in line with the original. The random effects term in the call to mixed is therefore a little bit uncommon.#'
+#'
+#' @docType data
+#' @keywords dataset
+#' @name md_16.4
+#' @usage md_16.4
+#' @format A data.frame with 24 rows and 3 variables.
+#' @source Maxwell, S. E., & Delaney, H. D. (2004). Designing experiments and analyzing data: a model-comparisons perspective. Mahwah, N.J.: Lawrence Erlbaum Associates. p. 574
+#'
+#' @encoding UTF-8
+#'
+#' @examples
+#' # data for next examples (Maxwell & Delaney, Table 16.4)
+#' data(md_16.4)
+#' str(md_16.4)
+#'
+#' ### replicate results from Table 16.6 (Maxwell & Delaney, 2004, p. 845)
+#' # p-values (almost) hold:
+#' (mixed2 <- mixed(induct ~ cond + (1|room:cond), md_16.4))
+#' # (1|room:cond) is needed because room is nested within cond.
+#'
+#'
+NULL
diff --git a/R/methods.afex_aov.R b/R/methods.afex_aov.R
index a6cdaab..c2fc08c 100644
--- a/R/methods.afex_aov.R
+++ b/R/methods.afex_aov.R
@@ -1,136 +1,150 @@
-#' Methods for afex_aov objects
-#'
-#' Methods defined for objects returned from the ANOVA functions \code{\link{aov_car}} et al. of class \code{afex_aov} containing both the ANOVA fitted via \code{car::Anova} and base R's \code{aov}.
-#'
-#' @return
-#' \describe{
-#' \item{\code{anova}}{Returns an ANOVA table of class \code{c("anova", "data.frame")}. Information such as effect size (\code{es}) or df-correction are calculated each time this method is called.}
-#' \item{\code{summary}}{For ANOVAs containing within-subject factors it returns the full output of the within-subject tests: the uncorrected results, results containing Greenhousse-Geisser and Hyunh-Feldt correction, and the results of the Mauchly test of sphericity (all achieved via \code{summary.Anova.mlm}). For other ANOVAs, the \code{anova} table is simply returned.}
-#' \item{\code{print}}{Prints (and invisibly returns) the ANOVA table as constructed from \code{\link{nice}} (i.e., as strings rounded nicely). Arguments in \code{...} are passed to \code{nice} allowing to pass arguments such as \code{es} and \code{correction}.}
-#' \item{\code{recover.data} and \code{lsm.basis}}{Provide the backbone for using \code{\link{lsmeans}} and related functions from \pkg{lsmeans} directly on \code{afex_aov} objects by returning a \code{\link{ref.grid}} object. Should not be called directly but through the functionality provided by \pkg{lsmeans}.}
-#'
-#' }
-#'
-#' @param object,x object of class \code{afex_aov} as returned from \code{\link{aov_car}} and related functions.
-#' @param ... further arguments passed through, see description of return value for details.
-#' @param trms,xlev,grid same as for \code{\link{lsm.basis}}.
-#'
-#' @name afex_aov-methods
-NULL
-
-#### methods for afex_aov
-
-#' @rdname afex_aov-methods
-#' @inheritParams nice
-#' @export
-anova.afex_aov <- function(object, es = afex_options("es_aov"), observed = NULL, correction = afex_options("correction_aov"), MSE = TRUE, intercept = FALSE, ...) {
- # internal functions:
- # check arguments
- es <- match.arg(es, c("none", "ges", "pes"), several.ok = TRUE)
- correction <- match.arg(correction, c("GG", "HF", "none"))
- if (class(object$Anova)[1] == "Anova.mlm") {
- tmp <- suppressWarnings(summary(object$Anova, multivariate = FALSE))
- t.out <- tmp[["univariate.tests"]]
- #browser()
- #t.out <- cbind(t.out, orig_den_df = t.out[, "den Df"])
- if (correction[1] == "GG") {
- tmp[["pval.adjustments"]] <- tmp[["pval.adjustments"]][!is.na(tmp[["pval.adjustments"]][,"GG eps"]),, drop = FALSE]
- t.out[row.names(tmp[["pval.adjustments"]]), "num Df"] <- t.out[row.names(tmp[["pval.adjustments"]]), "num Df"] * tmp[["pval.adjustments"]][,"GG eps"]
- t.out[row.names(tmp[["pval.adjustments"]]), "den Df"] <- t.out[row.names(tmp[["pval.adjustments"]]), "den Df"] * tmp[["pval.adjustments"]][,"GG eps"]
- t.out[row.names(tmp[["pval.adjustments"]]), "Pr(>F)"] <- tmp[["pval.adjustments"]][,"Pr(>F[GG])"]
- } else {
- if (correction[1] == "HF") {
- if (any(tmp[["pval.adjustments"]][,"HF eps"] > 1)) warning("HF eps > 1 treated as 1")
- tmp[["pval.adjustments"]] <- tmp[["pval.adjustments"]][!is.na(tmp[["pval.adjustments"]][,"HF eps"]),, drop = FALSE]
- t.out[row.names(tmp[["pval.adjustments"]]), "num Df"] <- t.out[row.names(tmp[["pval.adjustments"]]), "num Df"] * pmin(1, tmp[["pval.adjustments"]][,"HF eps"])
- t.out[row.names(tmp[["pval.adjustments"]]), "den Df"] <- t.out[row.names(tmp[["pval.adjustments"]]), "den Df"] * pmin(1, tmp[["pval.adjustments"]][,"HF eps"])
- t.out[row.names(tmp[["pval.adjustments"]]), "Pr(>F)"] <- tmp[["pval.adjustments"]][,"Pr(>F[HF])"]
- } else {
- if (correction[1] == "none") {
- TRUE
- } else stop("None supported argument to correction.")
- }
- }
- tmp.df <- t.out
- tmp2 <- as.data.frame(unclass(tmp.df))
- } else if (class(object$Anova)[1] == "anova") {
- #browser()
- tmp.df <- cbind(object$Anova[-nrow(object$Anova),], data.frame("Error SS" = object$Anova[nrow(object$Anova), "Sum Sq"], "den Df" = object$Anova[nrow(object$Anova), "Df"], check.names = FALSE))
- colnames(tmp.df)[1:3] <- c("SS", "num Df", "F")
- #tmp.df$orig_den_df <- tmp.df[, "den Df"]
- tmp2 <- as.data.frame(tmp.df)
- } else stop("Non-supported object passed. Slot 'Anova' needs to be of class 'Anova.mlm' or 'anova'.")
- tmp2[,"MSE"] <- tmp2[,"Error SS"]/tmp2[,"den Df"]
- # calculate es
- es_df <- data.frame(row.names = rownames(tmp2))
- if ("pes" %in% es) {
- es_df$pes <- tmp2$SS/(tmp2$SS + tmp2[,"Error SS"])
- }
- if ("ges" %in% es) {
- # This code is basically a copy from ezANOVA by Mike Lawrence!
- if(!is.null(observed)){
- obs <- rep(FALSE,nrow(tmp2))
- for(i in observed){
- if (!any(str_detect(rownames(tmp2),str_c("\\b",i,"\\b")))) stop(str_c("Observed variable not in data: ", i))
- obs <- obs | str_detect(rownames(tmp2),str_c("\\b",i,"\\b"))
- }
- obs_SSn1 <- sum(tmp2$SS*obs)
- obs_SSn2 <- tmp2$SS*obs
- }else{
- obs_SSn1 <- 0
- obs_SSn2 <- 0
- }
- es_df$ges <- tmp2$SS/(tmp2$SS+sum(unique(tmp2[,"Error SS"]))+obs_SSn1-obs_SSn2)
- }
- anova_table <- cbind(tmp2[,c("num Df", "den Df", "MSE", "F")], es_df, "Pr(>F)" = tmp2[,c("Pr(>F)")])
- class(anova_table) <- c("anova", "data.frame")
- attr(anova_table, "heading") <- c(paste0("Anova Table (Type ", object$information$type , " tests)\n"), paste("Response:", object$information$dv))
- #browser()
- if (!MSE) anova_table$MSE <- NULL
- if (!intercept) if (row.names(anova_table)[1] == "(Intercept)") anova_table <- anova_table[-1,, drop = FALSE]
- anova_table
-}
-
-#' @rdname afex_aov-methods
-#' @method print afex_aov
-#' @export
-print.afex_aov <- function(x, ...) {
- out <- nice(x$anova_table, ...)
- print(out)
- invisible(out)
-}
-
-
-#' @rdname afex_aov-methods
-#' @method summary afex_aov
-#' @export
-summary.afex_aov <- function(object, ...) {
- if (class(object$Anova)[1] == "Anova.mlm") {
- return(summary(object$Anova, multivariate = FALSE))
- } else if (class(object$Anova)[1] == "anova") {
- return(object$anova_table)
- } else stop("Non-supported object passed. Slot 'Anova' needs to be of class 'Anova.mlm' or 'anova'.")
-}
-
-
-#--------------------------------------------------------------
-### afex package - mixed objects ###
-# just need to provide an 'lsmeans' method here
-
-#' @rdname afex_aov-methods
-#' @importFrom lsmeans recover.data lsm.basis
-#' @method recover.data afex_aov
-#' @export
-recover.data.afex_aov = function(object, ...) {
- #do.call(do.call(":::", args = list(pkg = "lsmeans", name = "recover.data.aovlist")), args = list(object = object$aov, data = object$data$long, list(...)))
- recover.data(object = object$aov, ...)
-}
-
-#' @rdname afex_aov-methods
-#' @method lsm.basis afex_aov
-#' @export
-lsm.basis.afex_aov = function(object, trms, xlev, grid, ...) {
- #do.call(do.call(":::", args = list(pkg = "lsmeans", name = "lsm.basis.aovlist")), args = list(object = object$aov, trms = trms, xlev = xlev, grid = grid))
- lsm.basis(object$aov, trms, xlev, grid, ...)
-}
-
+#' Methods for afex_aov objects
+#'
+#' Methods defined for objects returned from the ANOVA functions \code{\link{aov_car}} et al. of class \code{afex_aov} containing both the ANOVA fitted via \code{car::Anova} and base R's \code{aov}.
+#'
+#' @param object,x object of class \code{afex_aov} as returned from \code{\link{aov_car}} and related functions.
+#' @param p.adjust.method \code{character} indicating if p-values for individual effects should be adjusted for multiple comparisons (see \link[stats]{p.adjust} and details).
+#' @param ... further arguments passed through, see description of return value for details.
+#' @param trms,xlev,grid same as for \code{\link{lsm.basis}}.
+#'
+#' @return
+#' \describe{
+#' \item{\code{anova}}{Returns an ANOVA table of class \code{c("anova", "data.frame")}. Information such as effect size (\code{es}) or df-correction are calculated each time this method is called.}
+#' \item{\code{summary}}{For ANOVAs containing within-subject factors it returns the full output of the within-subject tests: the uncorrected results, results containing Greenhousse-Geisser and Hyunh-Feldt correction, and the results of the Mauchly test of sphericity (all achieved via \code{summary.Anova.mlm}). For other ANOVAs, the \code{anova} table is simply returned.}
+#' \item{\code{print}}{Prints (and invisibly returns) the ANOVA table as constructed from \code{\link{nice}} (i.e., as strings rounded nicely). Arguments in \code{...} are passed to \code{nice} allowing to pass arguments such as \code{es} and \code{correction}.}
+#' \item{\code{recover.data} and \code{lsm.basis}}{Provide the backbone for using \code{\link{lsmeans}} and related functions from \pkg{lsmeans} directly on \code{afex_aov} objects by returning a \code{\link{ref.grid}} object. Should not be called directly but through the functionality provided by \pkg{lsmeans}.}
+#'
+#' }
+#'
+#' @details
+#' Exploratory ANOVA, for which no detailed hypotheses have been specified a priori, harbor a multiple comparison problem (Cramer et al., 2015). To avoid an inflation of familywise Type I error rate, results need to be corrected for multiple comparisons using \code{p.adjust.method}.
+#' \code{p.adjust.method} defaults to the method specified in the call to \code{\link{aov_car}} in \code{anova_table}. If no method was specified and \code{p.adjust.method = NULL} p-values are not adjusted.
+#'
+#' @references
+#' Cramer, A. O. J., van Ravenzwaaij, D., Matzke, D., Steingroever, H., Wetzels, R., Grasman, R. P. P. P., ... Wagenmakers, E.-J. (2015). Hidden multiplicity in exploratory multiway ANOVA: Prevalence and remedies. \emph{Psychonomic Bulletin & Review}, 1–8. doi:\href{http://doi.org/10.3758/s13423-015-0913-5}{10.3758/s13423-015-0913-5}
+#'
+#' @name afex_aov-methods
+#' @importFrom stats p.adjust
+NULL
+
+#### methods for afex_aov
+
+#' @rdname afex_aov-methods
+#' @inheritParams nice
+#' @export
+anova.afex_aov <- function(object, es = afex_options("es_aov"), observed = NULL, correction = afex_options("correction_aov"), MSE = TRUE, intercept = FALSE, p.adjust.method = NULL, ...) {
+ # internal functions:
+ # check arguments
+ es <- match.arg(es, c("none", "ges", "pes"), several.ok = TRUE)
+ correction <- match.arg(correction, c("GG", "HF", "none"))
+ if (class(object$Anova)[1] == "Anova.mlm") {
+ tmp <- suppressWarnings(summary(object$Anova, multivariate = FALSE))
+ t.out <- tmp[["univariate.tests"]]
+ #browser()
+ #t.out <- cbind(t.out, orig_den_df = t.out[, "den Df"])
+ if (correction[1] == "GG") {
+ tmp[["pval.adjustments"]] <- tmp[["pval.adjustments"]][!is.na(tmp[["pval.adjustments"]][,"GG eps"]),, drop = FALSE]
+ t.out[row.names(tmp[["pval.adjustments"]]), "num Df"] <- t.out[row.names(tmp[["pval.adjustments"]]), "num Df"] * tmp[["pval.adjustments"]][,"GG eps"]
+ t.out[row.names(tmp[["pval.adjustments"]]), "den Df"] <- t.out[row.names(tmp[["pval.adjustments"]]), "den Df"] * tmp[["pval.adjustments"]][,"GG eps"]
+ t.out[row.names(tmp[["pval.adjustments"]]), "Pr(>F)"] <- tmp[["pval.adjustments"]][,"Pr(>F[GG])"]
+ } else {
+ if (correction[1] == "HF") {
+ if (any(tmp[["pval.adjustments"]][,"HF eps"] > 1)) warning("HF eps > 1 treated as 1")
+ tmp[["pval.adjustments"]] <- tmp[["pval.adjustments"]][!is.na(tmp[["pval.adjustments"]][,"HF eps"]),, drop = FALSE]
+ t.out[row.names(tmp[["pval.adjustments"]]), "num Df"] <- t.out[row.names(tmp[["pval.adjustments"]]), "num Df"] * pmin(1, tmp[["pval.adjustments"]][,"HF eps"])
+ t.out[row.names(tmp[["pval.adjustments"]]), "den Df"] <- t.out[row.names(tmp[["pval.adjustments"]]), "den Df"] * pmin(1, tmp[["pval.adjustments"]][,"HF eps"])
+ t.out[row.names(tmp[["pval.adjustments"]]), "Pr(>F)"] <- tmp[["pval.adjustments"]][,"Pr(>F[HF])"]
+ } else {
+ if (correction[1] == "none") {
+ TRUE
+ } else stop("None supported argument to correction.")
+ }
+ }
+ tmp.df <- t.out
+ tmp2 <- as.data.frame(unclass(tmp.df))
+ } else if (class(object$Anova)[1] == "anova") {
+ #browser()
+ tmp.df <- cbind(object$Anova[-nrow(object$Anova),], data.frame("Error SS" = object$Anova[nrow(object$Anova), "Sum Sq"], "den Df" = object$Anova[nrow(object$Anova), "Df"], check.names = FALSE))
+ colnames(tmp.df)[1:3] <- c("SS", "num Df", "F")
+ #tmp.df$orig_den_df <- tmp.df[, "den Df"]
+ tmp2 <- as.data.frame(tmp.df)
+ } else stop("Non-supported object passed. Slot 'Anova' needs to be of class 'Anova.mlm' or 'anova'.")
+ tmp2[,"MSE"] <- tmp2[,"Error SS"]/tmp2[,"den Df"]
+ # calculate es
+ es_df <- data.frame(row.names = rownames(tmp2))
+ if ("pes" %in% es) {
+ es_df$pes <- tmp2$SS/(tmp2$SS + tmp2[,"Error SS"])
+ }
+ if ("ges" %in% es) {
+ # This code is basically a copy from ezANOVA by Mike Lawrence!
+ if(!is.null(observed)){
+ obs <- rep(FALSE,nrow(tmp2))
+ for(i in observed){
+ if (!any(str_detect(rownames(tmp2),str_c("\\b",i,"\\b")))) stop(str_c("Observed variable not in data: ", i))
+ obs <- obs | str_detect(rownames(tmp2),str_c("\\b",i,"\\b"))
+ }
+ obs_SSn1 <- sum(tmp2$SS*obs)
+ obs_SSn2 <- tmp2$SS*obs
+ } else {
+ obs_SSn1 <- 0
+ obs_SSn2 <- 0
+ }
+ es_df$ges <- tmp2$SS/(tmp2$SS+sum(unique(tmp2[,"Error SS"]))+obs_SSn1-obs_SSn2)
+ }
+ anova_table <- cbind(tmp2[,c("num Df", "den Df", "MSE", "F")], es_df, "Pr(>F)" = tmp2[,c("Pr(>F)")])
+ class(anova_table) <- c("anova", "data.frame")
+ attr(anova_table, "heading") <- c(paste0("Anova Table (Type ", object$information$type , " tests)\n"), paste("Response:", object$information$dv))
+ #browser()
+ if (!MSE) anova_table$MSE <- NULL
+ if (!intercept) if (row.names(anova_table)[1] == "(Intercept)") anova_table <- anova_table[-1,, drop = FALSE]
+ # Correct for multiple comparisons
+ if(is.null(p.adjust.method)) p.adjust.method <- ifelse(is.null(attr(object$anova_table, "p.adjust.method")), "none", attr(object$anova_table, "p.adjust.method"))
+ anova_table[,"Pr(>F)"] <- p.adjust(anova_table[,"Pr(>F)"], method = p.adjust.method)
+ attr(anova_table, "p.adjust.method") <- p.adjust.method
+ anova_table
+}
+
+#' @rdname afex_aov-methods
+#' @method print afex_aov
+#' @export
+print.afex_aov <- function(x, ...) {
+ out <- nice(x$anova_table, ...)
+ print(out)
+ invisible(out)
+}
+
+
+#' @rdname afex_aov-methods
+#' @method summary afex_aov
+#' @export
+summary.afex_aov <- function(object, ...) {
+ if (class(object$Anova)[1] == "Anova.mlm") {
+ if(attr(object$anova_table, "p.adjust.method") != "none") message("Note, results are NOT adjusted for multiple comparisons as requested\n(p.adjust.method = '", attr(object$anova_table, "p.adjust.method"), "')\nbecause the desired method of sphericity correction is unknown.\nFor adjusted p-values print the object (to see object$anova_table), or call\none of anova.afex_aov() or nice().")
+ return(summary(object$Anova, multivariate = FALSE))
+ } else if (class(object$Anova)[1] == "anova") {
+ return(object$anova_table)
+ } else stop("Non-supported object passed. Slot 'Anova' needs to be of class 'Anova.mlm' or 'anova'.")
+}
+
+
+#--------------------------------------------------------------
+### afex package - mixed objects ###
+# just need to provide an 'lsmeans' method here
+
+#' @rdname afex_aov-methods
+#' @importFrom lsmeans recover.data lsm.basis
+#' @method recover.data afex_aov
+#' @export
+recover.data.afex_aov = function(object, ...) {
+ #do.call(do.call(":::", args = list(pkg = "lsmeans", name = "recover.data.aovlist")), args = list(object = object$aov, data = object$data$long, list(...)))
+ recover.data(object = object$aov, ...)
+}
+
+#' @rdname afex_aov-methods
+#' @method lsm.basis afex_aov
+#' @export
+lsm.basis.afex_aov = function(object, trms, xlev, grid, ...) {
+ #do.call(do.call(":::", args = list(pkg = "lsmeans", name = "lsm.basis.aovlist")), args = list(object = object$aov, trms = trms, xlev = xlev, grid = grid))
+ lsm.basis(object$aov, trms, xlev, grid, ...)
+}
+
diff --git a/R/mixed.R b/R/mixed.R
index 305f44f..0bdee12 100644
--- a/R/mixed.R
+++ b/R/mixed.R
@@ -1,663 +1,665 @@
-#' p-values for fixed effects of mixed-model via lme4::lmer()
-#'
-#' Calculates p-values for all fixed effects in a mixed model. This is done by first fitting (with \code{\link[lme4]{lmer}}) the full model and then versions thereof in which a single effect is removed and comparing the reduced model to the full model. The default is to calculate type 3 like p-values using the Kenward-Roger approximation for degrees-of-freedom (using \code{\link[pbkrtest]{KRmodcomp}}; for LMMs only). Other methods for obtaining p-values are parametric bootstrap (\code{me [...]
-#'
-#'
-#' @param formula a formula describing the full mixed-model to be fitted. As this formula is passed to \code{lmer}, it needs at least one random term.
-#' @param data data.frame containing the data. Should have all the variables present in \code{fixed}, \code{random}, and \code{dv} as columns.
-#' @param type type of test on which effects are based. Default is to use type 3 tests, taken from \code{\link{afex_options}}.
-#' @param method character vector indicating which methods for obtaining p-values should be used: \code{"KR"} corresponds to the Kenward-Roger approximation for degrees of freedom (only working with linear mixed models), \code{"PB"} calculates p-values based on parametric bootstrap, \code{"LRT"} calculates p-values via the likelihood ratio tests implemented in the \code{anova} method for \code{merMod} objects (only recommended for models with many [i.e., > 50] levels for the random facto [...]
-#' @param per.parameter \code{character} vector specifying for which variable tests should be run for each parameter (instead for the overall effect). Can be useful e.g., for testing ordered factors. Relatively untested so results should be compared with a second run without setting this argument. Uses \code{\link{grep}} for selecting parameters among the fixed effects so regular expressions (\code{\link{regex}}) are possible. See Examples.
-#' @param args.test \code{list} of arguments passed to the function calculating the p-values. See Details.
-#' @param test.intercept logical. Whether or not the intercept should also be fitted and tested for significance. Default is \code{FALSE}. Only relevant if \code{type = 3}.
-#' @param check.contrasts \code{logical}. Should contrasts be checked and (if necessary) changed to \code{"contr.sum"}? See Details. The default (\code{"TRUE"}) is taken from \code{\link{afex_options}}.
-#' @param expand_re logical. Should random effects terms be expanded (i.e., factors transformed into numerical variables) before fitting with \code{(g)lmer}? Allows to use "||" notation with factors.
-#' @param set.data.arg \code{logical}. Should the data argument in the slot \code{call} of the \code{merMod} object returned from \code{lmer} be set to the passed data argument? Otherwise the name will be \code{data}. Helpful if fitted objects are used afterwards (e.g., using \pkg{lsmeans}). Default is \code{TRUE}.
-#' @param progress if \code{TRUE}, shows progress with a text progress bar and other status messages during fitting.
-#' @param cl A vector identifying a cluster; used for distributing the estimation of the different models using several cores. See examples. If \code{ckeck.contrasts}, mixed sets the current contrasts (\code{getOption("contrasts")}) at the nodes. Note this does \emph{not} distribute calculation of p-values (e.g., when using \code{method = "PB"}) across the cluster. Use \code{args.test} for this.
-#' @param return the default is to return an object of class \code{"mixed"}. \code{return = "merMod"} will skip the calculation of all submodels and p-values and simply return the full model fitted with lmer. Can be useful in combination with \code{expand_re = TRUE} which allows to use "||" with factors.
-#' @param ... further arguments (such as \code{weights}/\code{family}) passed to \code{\link{lmer}}/\code{\link{glmer}}.
-#'
-#'
-#' @return An object of class \code{"mixed"} (i.e., a list) with the following elements:
-#'
-#' \enumerate{
-#' \item \code{anova_table} a data.frame containing the statistics returned from \code{\link[pbkrtest]{KRmodcomp}}. The \code{stat} column in this data.frame gives the value of the test statistic, an F-value for \code{method = "KR"} and a chi-square value for the other two methods.
-#' \item \code{full.model} the \code{"lmerMod"} object returned from fitting the full mixed model.
-#' \item \code{restricted.models} a list of \code{"lmerMod"} objects from fitting the restricted models (i.e., each model lacks the corresponding effect)
-#' \item \code{tests} a list of objects returned by the function for obtaining the p-values.
-#' }
-#'
-#' It also has the following attributes, \code{"type"} and \code{"method"}.
-#'
-#' Two similar methods exist for objects of class \code{"mixed"}: \code{print} and \code{anova}. They print a nice version of the \code{anova_table} element of the returned object (which is also invisibly returned). This methods omit some columns and nicely round the other columns. The following columns are always printed:
-#' \enumerate{
-#' \item \code{Effect} name of effect
-#' \item \code{p.value} estimated p-value for the effect
-#' }
-#'
-#' For LMMs with \code{method="KR"} the following further columns are returned (note: the Kenward-Roger correction does two separate things: (1) it computes an effective number for the denominator df; (2) it scales the statistic by a calculated amount, see also \url{http://stackoverflow.com/a/25612960/289572}):
-#' \enumerate{
-#' \item \code{F} computed F statistic
-#' \item \code{ndf} numerator degrees of freedom (number of parameters used for the effect)
-#' \item \code{ddf} denominator degrees of freedom (effective residual degrees of freedom for testing the effect), computed from the Kenward-Roger correction using \code{pbkrtest::KRmodcomp}
-#' \item \code{F.scaling} scaling of F-statistic computing from Kenward-Roger approximation.
-#' }
-#'
-#' For models with \code{method="LRT"} the following further columns are returned:
-#' \enumerate{
-#' \item \code{df.large} degrees of freedom (i.e., estimated paramaters) for full model (i.e., model containing the corresponding effect)
-#' \item \code{df.small} degrees of freedom (i.e., estimated paramaters) for restricted model (i.e., model without the corresponding effect)
-#' \item \code{chisq} 2 times the difference in likelihood (obtained with \code{logLik}) between full and restricted model
-#' \item \code{df} difference in degrees of freedom between full and restricted model (p-value is based on these df).
-#' }
-#'
-#' For models with \code{method="PB"} the following further column is returned:
-#' \enumerate{
-#' \item \code{stat} 2 times the difference in likelihood (obtained with \code{logLik}) between full and restricted model (i.e., a chi-square value).
-#' }
-#'
-#' Note that \code{anova} can also be called with additional mixed and/or \code{merMod} objects. In this casethe full models are passed on to \code{anova.merMod} (with \code{refit=FALSE}, which differs from the default of \code{anova.merMod}) which produces the known LRT tables.
-#'
-#' The \code{summary} method for objects of class \code{mixed} simply calls \code{\link{summary.merMod}} on the full model.
-#'
-#' If \code{return = "merMod"}, an object of class \code{"merMod"}, as returned from \code{g/lmer}, is returned.
-#'
-#' @details For an introduction to mixed-modeling for experimental designs see Barr, Levy, Scheepers, & Tily (2013; I highly recommend reading this paper if you use this function), arguments for using the Kenward-Roger approximation for obtaining p-values are given by Judd, Westfall, and Kenny (2012). Further introductions to mixed-modeling for experimental designs are given by Baayen and colleagues (Baayen, 2008; Baayen, Davidson & Bates, 2008; Baayen & Milin, 2010). Specific recommenda [...]
-#'
-#'\subsection{p-value Calculations}{
-#'
-#' p-values are per default calculated via methods from \pkg{pbkrtest}. When \code{method = "KR"} (the default), the Kenward-Roger approximation for degrees-of-freedom is calculated using \code{\link[pbkrtest]{KRmodcomp}}, which is only applicable to linear-mixed models. The test statistic in the output is a F-value (\code{F}).
-#'
-#' \code{method = "PB"} calculates p-values using parametric bootstrap using \code{\link[pbkrtest]{PBmodcomp}}. This can be used for linear and also generalized linear mixed models (GLMM) by specifying a \code{\link[stats]{family}} argument to \code{mixed}. Note that you should specify further arguments to \code{PBmodcomp} via \code{args.test}, especially \code{nsim} (the number of simulations to form the reference distribution) or \code{cl} (for using multiple cores). For other argument [...]
-#'
-#' \code{method = "LRT"} calculates p-values via likelihood ratio tests implemented in the \code{anova} method for \code{"merMod"} objects. This is recommended by Barr et al. (2013; which did not test the other methods implemented here). Using likelihood ratio tests is only recommended for models with many levels for the random effects (> 50), but can be pretty helpful in case the other methods fail (due to memory and/or time limitations). The \href{http://glmm.wikidot.com/faq}{lme4 faq} [...]
-#' }
-#'
-#' \subsection{Implementation Details}{
-#'
-#' Type 3 tests are obtained by comparing a model in which only the tested effect is excluded with the full model (containing all effects). This corresponds to the (type 3) Wald tests given by \code{car::Anova} for \code{"lmerMod"} models. The submodels in which the tested effect is excluded are obtained by manually creating a model matrix which si then fitted in \code{"lme4"}. This is done to avoid R's "feature" to not allow this behavior.
-#'
-#' Type 2 tests are truly sequential. They are obtained by comparing a model in which the tested effect and all higher oder effect (e.g., all three-way interactions for testing a two-way interaction) are excluded with a model in which only effects up to the order of the tested effect are present and all higher order effects absent. In other words, there are multiple full models, one for each order of effects. Consequently, the results for lower order effects are identical of whether or n [...]
-#'
-#' If \code{check.contrasts = TRUE}, contrasts will be set to \code{"contr.sum"} for all factors in the formula if default contrasts are not equal to \code{"contr.sum"} or \code{attrib(factor, "contrasts") != "contr.sum"}. Furthermore, the current contrasts (obtained via \code{getOption("contrasts")}) will be set at the cluster nodes if \code{cl} is not \code{NULL}.
-#' }
-#'
-#' \subsection{Expand Random Effects}{
-#' The latest addition, motivated by Bates et al. (2015), is the possibility to expand the random effects structure before passing it to \code{lmer} by setting \code{expand_re = TRUE}. This allows to disable estimation of correlation among random effects for random effects term containing factors using the \code{||} notation. This is achieved by first creating a model matrix for each random effects term individually, rename and append the so created columns to the data that will be fitte [...]
-#'
-#' \code{lmer_alt} is simply a wrapper for \code{mixed} that is intended to behave like \code{lmer} (or \code{glmer} if a \code{family} argument is present), but also allows to use \code{||} with factors correctly (by always using \code{expand_re = TRUE}). This means that \code{lmer_alt} per default does not enforce a specific contrast on factors and only returns the \code{"merMod"} object without calculating any additional models or p-values (this is achieved by setting \code{return = " [...]
-#'
-#' One negative consequence of using \code{expand_re = TRUE} is that the data that is fitted will not be the same as the passed data.frame which can lead to problems with e.g., the \code{predict} method. Finally, note that this functionality is relatively new so please proceed with care.
-#' }
-#'
-#' @note When \code{method = "KR"}, obtaining p-values is known to crash due too insufficient memory or other computational limitations (especially with complex random effects structures). In these cases, the other methods should be used. The RAM demand is a problem especially on 32 bit Windows which only supports up to 2 or 3GB RAM (see \href{http://cran.r-project.org/bin/windows/base/rw-FAQ.html}{R Windows FAQ}). Then it is probably a good idea to use methods "LRT" or "PB".
-#'
-#' \code{"mixed"} will throw a message if numerical variables are not centered on 0, as main effects (of other variables then the numeric one) can be hard to interpret if numerical variables appear in interactions. See Dalal & Zickar (2012).
-#'
-#' Please report bugs or unexpected behavior to maintainer via email!
-#'
-#' @author Henrik Singmann with contributions from \href{http://stackoverflow.com/q/11335923/289572}{Ben Bolker and Joshua Wiley}.
-#'
-#' @seealso \code{\link{aov_ez}} and \code{\link{aov_car}} for convenience functions to analyze experimental deisgns with classical ANOVA or ANCOVA wrapping \code{\link[car]{Anova}}.
-#'
-#' see the following for the data sets from Maxwell and Delaney (2004) used and more examples: \code{\link{md_15.1}}, \code{\link{md_16.1}}, and \code{\link{md_16.4}}.
-#'
-#' @references Baayen, R. H. (2008). \emph{Analyzing linguistic data: a practical introduction to statistics using R}. Cambridge, UK; New York: Cambridge University Press.
-#'
-#' Baayen, R. H., Davidson, D. J., & Bates, D. M. (2008). Mixed-effects modeling with crossed random effects for subjects and items. \emph{Journal of Memory and Language}, 59(4), 390-412. doi:10.1016/j.jml.2007.12.005
-#'
-#' Baayen, R. H., & Milin, P. (2010). Analyzing Reaction Times. \emph{International Journal of Psychological Research}, 3(2), 12-28.
-#'
-#' Barr, D. J. (2013). Random effects structure for testing interactions in linear mixed-effects models. \emph{Frontiers in Quantitative Psychology and Measurement}, 328. doi:10.3389/fpsyg.2013.00328
-#'
-#' Barr, D. J., Levy, R., Scheepers, C., & Tily, H. J. (2013). Random effects structure for confirmatory hypothesis testing: Keep it maximal. \emph{Journal of Memory and Language}, 68(3), 255-278. doi:10.1016/j.jml.2012.11.001
-#'
-#' Bates, D., Kliegl, R., Vasishth, S., & Baayen, H. (2015). \emph{Parsimonious Mixed Models}. arXiv:1506.04967 [stat]. Retrieved from \url{http://arxiv.org/abs/1506.04967}
-#'
-#' Dalal, D. K., & Zickar, M. J. (2012). Some Common Myths About Centering Predictor Variables in Moderated Multiple Regression and Polynomial Regression. \emph{Organizational Research Methods}, 15(3), 339-362. doi:10.1177/1094428111430540
-#'
-#' Judd, C. M., Westfall, J., & Kenny, D. A. (2012). Treating stimuli as a random factor in social psychology: A new and comprehensive solution to a pervasive but largely ignored problem. \emph{Journal of Personality and Social Psychology}, 103(1), 54-69. doi:10.1037/a0028347
-#'
-#' Maxwell, S. E., & Delaney, H. D. (2004). \emph{Designing experiments and analyzing data: a model-comparisons perspective.} Mahwah, N.J.: Lawrence Erlbaum Associates.
-#'
-#'
-#' @import pbkrtest
-#' @importFrom lme4 lmer glmer nobars getME fixef isREML
-#' @importFrom stringr str_replace
-#' @importMethodsFrom Matrix t isSymmetric "%*%" solve diag
-#' @importClassesFrom Matrix Matrix
-#' @importFrom Matrix Matrix sparseMatrix rankMatrix
-#' @importFrom parallel clusterCall clusterExport clusterEvalQ clusterApplyLB
-#' @importFrom stats logLik terms as.formula contrasts<- model.matrix model.frame anova vcov
-#' @importFrom methods is
-#' @encoding UTF-8
-#'
-#' @example examples/examples.mixed.R
-#'
-#' @export
-mixed <- function(formula, data, type = afex_options("type"), method = afex_options("method_mixed"), per.parameter = NULL, args.test = list(), test.intercept = FALSE, check.contrasts = afex_options("check.contrasts"), expand_re = FALSE, set.data.arg = TRUE, progress = TRUE, cl = NULL, return = "mixed", ...) {
- if (check.contrasts) {
- #browser()
- vars.to.check <- all.vars(formula)
- resetted <- NULL
- for (i in vars.to.check) {
- if (is.factor(data[,i])) {
- if (is.null(attr(data[,i], "contrasts")) & (options("contrasts")[[1]][1] != "contr.sum")) {
- contrasts(data[,i]) <- "contr.sum"
- resetted <- c(resetted, i)
- }
- else if (!is.null(attr(data[,i], "contrasts")) && attr(data[,i], "contrasts") != "contr.sum") {
- contrasts(data[,i]) <- "contr.sum"
- resetted <- c(resetted, i)
- }
- }
- }
- if (!is.null(resetted)) message(str_c("Contrasts set to contr.sum for the following variables: ", str_c(resetted, collapse=", ")))
- }
- #warning(str_c("Calculating Type 3 sums with contrasts = ", options("contrasts")[[1]][1], ".\n Use options(contrasts=c('contr.sum','contr.poly')) instead"))
- # browser()
- method <- match.arg(method, c("KR", "PB", "LRT", "F"), several.ok=TRUE)
- ####################
- ### Part I: prepare fitting (i.e., obtain model info, check model, ...)
- ####################
- mc <- match.call()
- #browser()
- formula.f <- as.formula(formula)
- if (class(formula) != "formula") message("Formula (the first argument) converted to formula.")
- dv <- as.character(formula.f)[[2]]
- all.terms <- attr(terms(formula.f), "term.labels")
- effect.order <- attr(terms(formula.f), "order")
- effect.order <- effect.order[!grepl("\\|", all.terms)]
- max.effect.order <- max(effect.order)
- random <- str_c(str_c("(", all.terms[grepl("\\|", all.terms)], ")"), collapse = " + ")
- rh2 <- nobars(formula.f)
- rh2[[2]] <- NULL
- m.matrix <- model.matrix(rh2, data = data)
- fixed.effects <- attr(terms(rh2, data = data), "term.labels")
- mapping <- attr(m.matrix, "assign")
- fixed.vars <- all.vars(rh2)
- # check for missing values in variables used:
- if (nrow(m.matrix) != nrow(data)) {
- data <- model.frame(as.formula(str_c(vars.to.check[1], "~", str_c(vars.to.check[-1], collapse = "+"))), data = data)
- m.matrix <- model.matrix(rh2, data = data)
- warning(str_c("Due to missing values, reduced number of observations to ", nrow(data)))
- if(set.data.arg) {
- warning("Due to missing values, set.data.arg set to FALSE.")
- set.data.arg <- FALSE
- }
- }
-
- # check if numerical variables are centered
- c.ns <- fixed.vars[vapply(data[, fixed.vars, drop = FALSE], is.numeric, TRUE)]
- if (length(c.ns) > 0) {
- non.null <- c.ns[!abs(vapply(data[, c.ns, drop = FALSE], mean, 0)) < .Machine$double.eps ^ 0.5]
- if (length(non.null) > 0) message(str_c("Numerical variables NOT centered on 0 (i.e., interpretation of all main effects might be difficult if in interactions): ", str_c(non.null, collapse = ", ")))
- }
- if (expand_re) {
- random_parts <- str_c(all.terms[grepl("\\|", all.terms)])
- which_random_double_bars <- str_detect(random_parts, "\\|\\|")
- random_units <- str_replace(random_parts, "^.+\\|\\s+", "")
- tmp_random <- lapply(str_replace(random_parts, "\\|.+$", ""), function(x) as.formula(str_c("~", x)))
- tmp_model.matrix <- vector("list", length(random_parts))
- re_contains_intercept <- rep(FALSE, length(random_parts))
- new_random <- vector("character", length(random_parts))
- for (i in seq_along(random_parts)) {
- tmp_model.matrix[[i]] <- model.matrix(tmp_random[[i]], data = data)
- if (ncol(tmp_model.matrix[[i]]) == 0) stop("Invalid random effects term, e.g., (0|id)")
- if (colnames(tmp_model.matrix[[i]])[1] == "(Intercept)") {
- tmp_model.matrix[[i]] <- tmp_model.matrix[[i]][,-1, drop = FALSE]
- re_contains_intercept[i] <- TRUE
- }
- if (ncol(tmp_model.matrix[[i]]) > 0) {
- colnames(tmp_model.matrix[[i]]) <- str_c("re", i, ".", str_replace_all(colnames(tmp_model.matrix[[i]]), ":", "_by_"))
- new_random[i] <- str_c("(", as.numeric(re_contains_intercept[i]), "+", str_c(colnames(tmp_model.matrix[[i]]), collapse = "+"), if (which_random_double_bars[i]) "||" else "|", random_units[i], ")")
- } else {
- new_random[i] <- str_c("(", as.numeric(re_contains_intercept[i]), if (which_random_double_bars[i]) "||" else "|", random_units[i], ")")
- }
- }
- data <- cbind(data, as.data.frame(do.call(cbind, tmp_model.matrix)))
- random <- str_c(new_random, collapse = "+")
- }
- ####################
- ### Part II: obtain the lmer fits
- ####################
- ## Part IIa: prepare formulas
- mf <- mc[!names(mc) %in% c("type", "method", "args.test", "progress", "check.contrasts", "per.parameter", "cl", "test.intercept", "expand_re", "return")]
- mf[["formula"]] <-as.formula(str_c(dv,deparse(rh2),"+",random)) #formula.f
- if ("family" %in% names(mf)) mf[[1]] <- as.name("glmer")
- else mf[[1]] <- as.name("lmer")
- mf[["data"]] <- as.name("data")
- if ((method[1] %in% c("PB", "LRT")) & !("family" %in% names(mf))) if ((!"REML" %in% names(mf)) || mf[["REML"]]) {
- message("REML argument to lmer() set to FALSE for method = 'PB' or 'LRT'")
- mf[["REML"]] <- FALSE
- }
- #browser()
- if (return == "merMod") {
- out <- eval(mf)
- if(set.data.arg) out at call[["data"]] <- mc[["data"]]
- return(out)
- }
- ## prepare (g)lmer formulas:
- if (type == 3 | type == "III") {
- if (attr(terms(rh2, data = data), "intercept") == 1) fixed.effects <- c("(Intercept)", fixed.effects)
- #per.parameter <- c("hour", "treatment")
- # The next part alters the mapping of parameters to effects/variables if
- # per.parameter is not NULL (this does the complete magic).
- if (!is.null(per.parameter)) {
- fixed.to.change <- c()
- for (parameter in per.parameter) {
- fixed.to.change <- c(fixed.to.change, grep(parameter, fixed.effects))
- }
- fixed.to.change <- fixed.effects[sort(unique(fixed.to.change))]
- if ("(Intercept)" %in% fixed.to.change) fixed.to.change <- fixed.to.change[-1]
- fixed.all <- dimnames(m.matrix)[[2]]
- #tf2 <- fixed.to.change[2]
- for (tf2 in fixed.to.change) {
- tf <- which(fixed.effects == tf2)
- fixed.lower <- fixed.effects[seq_len(tf-1)]
- fixed.upper <- if (tf < length(fixed.effects)) fixed.effects[(tf+1):length(fixed.effects)] else NULL
- fixed.effects <- c(fixed.lower, fixed.all[which(mapping == (tf-1))], fixed.upper)
- map.to.replace <- which(mapping == (tf-1))
- map.lower <- mapping[seq_len(map.to.replace[1]-1)]
- map.upper <- if (max(map.to.replace) < length(mapping)) mapping[(map.to.replace[length(map.to.replace)]+1):length(mapping)] else NULL
- mapping <- c(map.lower, seq_along(map.to.replace) + map.lower[length(map.lower)], map.upper + length(map.to.replace)-1)
- }
- }
- # make formulas
- formulas <- vector("list", length(fixed.effects) + 1)
- formulas[[1]] <- mf[["formula"]]
- for (i in seq_along(fixed.effects)) {
- tmp.columns <- str_c(deparse(-which(mapping == (i-1))), collapse = "")
- formulas[[i+1]] <- as.formula(str_c(dv, "~ 0 + m.matrix[,", tmp.columns, "] +", random))
- }
- names(formulas) <- c("full.model", fixed.effects)
- if (!test.intercept && fixed.effects[1] == "(Intercept)") {
- fixed.effects <- fixed.effects[-1]
- formulas[["(Intercept)"]] <- NULL
- }
- } else if (type == 2 | type == "II") {
- #warning("Implementation of Type 2 method not unproblematic.\n Check documentation or use car::Anova (Wald tests).")
- if (!is.null(per.parameter)) stop("per.parameter argument only implemented for Type 3 tests.")
- full.model.formulas <- vector("list", max.effect.order)
- submodel.formulas <- vector("list", length(fixed.effects))
- full.model.formulas[[length(full.model.formulas)]] <- mf[["formula"]]
- for (c in seq_len(max.effect.order)) {
- if (c == max.effect.order) next
- tmp.columns <- str_c(deparse(-which(mapping %in% which(effect.order > c))), collapse = "")
- full.model.formulas[[c]] <- as.formula(str_c(dv, "~ 0 + m.matrix[,", tmp.columns, "] +", random))
- }
- for (c in seq_along(fixed.effects)) {
- order.c <- effect.order[c]
- tmp.columns <- str_c(deparse(-which(mapping == (c) | mapping %in% if (order.c == max.effect.order) -1 else which(effect.order > order.c))), collapse = "")
- submodel.formulas[[c]] <- as.formula(str_c(dv, "~ 0 + m.matrix[,", tmp.columns, "] +", random))
- }
- formulas <- c(full.model.formulas, submodel.formulas)
- } else stop('Only type 3 and type 2 tests implemented.')
- ## Part IIb: fit models
- # single core
- if (is.null(cl)) {
- if (progress) cat(str_c("Fitting ", length(formulas), " (g)lmer() models:\n["))
- fits <- vector("list", length(formulas))
- for (i in seq_along(formulas)) {
- mf[["formula"]] <- formulas[[i]]
- fits[[i]] <- eval(mf)
- if (progress) cat(".")
- }
- if (progress) cat("]\n")
- } else { # multicore
- eval.cl <- function(formula, m.call, progress) {
- m.call[[2]] <- formula
- res <- eval(m.call)
- if (progress) cat(".")
- return(res)
- }
- if (progress) cat(paste0("Fitting ", length(formulas), " (g)lmer() models.\n"))
- #junk <- clusterEvalQ(cl = cl, library("lme4", character.only = TRUE))
- junk <- clusterCall(cl = cl, "require", package = "lme4", character.only = TRUE)
- #junk <- clusterEvalQ(cl = cl, loadNamespace("lme4"))
- if (check.contrasts) {
- curr.contrasts <- getOption("contrasts")
- clusterExport(cl = cl, "curr.contrasts", envir = sys.nframe())
- junk <- clusterEvalQ(cl = cl, options(contrasts=curr.contrasts))
- }
- if (progress) junk <- clusterEvalQ(cl = cl, cat("["))
- fits <- clusterApplyLB(cl = cl, x = formulas, eval.cl, m.call = mf, progress = progress)
- if (progress) junk <- clusterEvalQ(cl = cl, cat("]"))
- }
- ## add correct data argument to lmer calls:
-
- ####################
- ### Part IIb: likelihood checks and refitting
- ####################
-
- check_likelihood <- function(fits) {
- if (type == 3 | type == "III") {
- logLik_full <- as.numeric(logLik(fits[[1]]))
- logLik_restricted <- as.numeric(vapply(fits[2:length(fits)], logLik, 0))
- if(any(logLik_restricted > logLik_full)) return(fixed.effects[logLik_restricted > logLik_full])
- } else if (type == 2 | type == "II") {
- logLik_full <- as.numeric(vapply(fits[1:max.effect.order],logLik, 0))
- logLik_restricted <- as.numeric(vapply(fits[(max.effect.order+1):length(fits)], logLik, 0))
- warn_logLik <- c()
- for (c in seq_along(fixed.effects)) {
- order.c <- effect.order[c]
- if(logLik_restricted[[c]] > logLik_full[[order.c]]) warn_logLik <- c(warn_logLik, fixed.effects[c])
- }
- if(length(warn_logLik)>0) return(warn_logLik)
- }
- return(TRUE)
- }
-
- # check for smaller likelihood of nested model and refit if test fails:
- if (FALSE) {
- if(!isTRUE(check_likelihood(fits))) {
- if (progress) cat("refitting...")
- refits <- lapply(fits, allFit, verbose=FALSE, data = data)
- browser()
- str(fits[[1]], 2)
- fits[[1]]@call
- sapply(allFit(fits[[1]], data=md_16.4b), function(y) try(logLik(y)))
- sapply(refits, function(x) sapply(x, function(y) tryCatch(as.numeric(logLik(y)), error = function(e) as.numeric(NA))))
-
- fits <- lapply(refits, function(x) {
- tmp_llk <- vapply(x, function(y) tryCatch(logLik(y), error = function(e) as.numeric(NA)), 0)
- x[[which.min(tmp_llk)]]
- })
- }
- }
- # check again and warn
- if(!isREML(fits[[1]]) & !isTRUE(check_likelihood(fits))) {
- warning(paste("Following nested model(s) provide better fit than full model:", paste(check_likelihood(fits), collapse = ", "), "\n It is highly recommended to try different optimizer via lmerControl or allFit!"))
- }
-
- if(set.data.arg){
- for (i in seq_along(fits)) {
- fits[[i]]@call[["data"]] <- mc[["data"]]
- }
- }
- ## prepare for p-values:
- if (type == 3 | type == "III") {
- full.model <- fits[[1]]
- fits <- fits[-1]
- } else if (type == 2 | type == "II") {
- full.model <- fits[1:max.effect.order]
- fits <- fits[(max.effect.order+1):length(fits)]
- }
- names(fits) <- fixed.effects
-
- ####################
- ### Part III: obtain p-values
- ####################
- ## obtain p-values:
- #browser()
- if (method[1] == "KR") {
- if (progress) cat(str_c("Obtaining ", length(fixed.effects), " p-values:\n["))
- tests <- vector("list", length(fixed.effects))
- for (c in seq_along(fixed.effects)) {
- if (type == 3 | type == "III") tests[[c]] <- KRmodcomp(full.model, fits[[c]])
- else if (type == 2 | type == "II") {
- order.c <- effect.order[c]
- tests[[c]] <- KRmodcomp(full.model[[order.c]], fits[[c]])
- }
- if (progress) cat(".")
- }
- if (progress) cat("]\n")
- names(tests) <- fixed.effects
- #df.out <- data.frame(Effect = fixed.effects, stringsAsFactors = FALSE)
- anova_table <- data.frame(t(vapply(tests, function(x) unlist(x[["test"]][1,]), unlist(tests[[1]][["test"]][1,]))))
- #FtestU <- vapply(tests, function(x) unlist(x[["test"]][2,]), unlist(tests[[1]][["test"]][2,]))
- #row.names(FtestU) <- str_c(row.names(FtestU), ".U")
- #anova_table <- cbind(anova_table, t(FtestU))
- rownames(anova_table) <- fixed.effects
- colnames(anova_table) <- c("F", "num Df", "den Df", "F.scaling", "Pr(>F)")
- anova_table <- anova_table[, c("num Df", "den Df", "F.scaling", "F", "Pr(>F)")]
- anova_tab_addition <- NULL
- } else if (method[1] == "PB") {
- if (progress) cat(str_c("Obtaining ", length(fixed.effects), " p-values:\n["))
- tests <- vector("list", length(fixed.effects))
- for (c in seq_along(fixed.effects)) {
- if (type == 3 | type == "III") tests[[c]] <- do.call(PBmodcomp, args = c(largeModel = full.model, smallModel = fits[[c]], args.test))
- else if (type == 2 | type == "II") {
- order.c <- effect.order[c]
- tests[[c]] <- do.call(PBmodcomp, args = c(largeModel = full.model[[order.c]], smallModel = fits[[c]], args.test))
- }
- if (progress) cat(".")
- }
- if (progress) cat("]\n")
- names(tests) <- fixed.effects
- #browser()
- #df.out<- data.frame(Effect = fixed.effects, stringsAsFactors = FALSE)
- anova_table <- data.frame(t(vapply(tests, function(x) unlist(x[["test"]][2,]), unlist(tests[[1]][["test"]][2,]))))
- anova_table <- anova_table[,-2]
- LRT <- vapply(tests, function(x) unlist(x[["test"]][1,]), unlist(tests[[1]][["test"]][1,]))
- row.names(LRT) <- str_c(row.names(LRT), ".LRT")
- anova_table <- cbind(anova_table, t(LRT))
- rownames(anova_table) <- fixed.effects
- anova_table <- anova_table[, c("stat", "df.LRT", "p.value.LRT", "p.value")]
- colnames(anova_table) <- c("Chisq", "Chi Df", "Pr(>Chisq)", "Pr(>PB)")
- anova_tab_addition <- NULL
- } else if (method[1] == "LRT") {
- tests <- vector("list", length(fixed.effects))
- for (c in seq_along(fixed.effects)) {
- if (type == 3 | type == "III") tests[[c]] <- anova(full.model, fits[[c]])
- else if (type == 2 | type == "II") {
- order.c <- effect.order[c]
- tmpModel <- full.model[[order.c]]
- tests[[c]] <- anova(tmpModel, fits[[c]])
- }
- }
- names(tests) <- fixed.effects
- df.large <- vapply(tests, function(x) x[["Df"]][2], 0)
- df.small <- vapply(tests, function(x) x[["Df"]][1], 0)
- chisq <- vapply(tests, function(x) x[["Chisq"]][2], 0)
- df <- vapply(tests, function(x) x[["Chi Df"]][2], 0)
- p.value <- vapply(tests, function(x) x[["Pr(>Chisq)"]][2], 0)
- anova_table <- data.frame(Df = df.small, Chisq = chisq, "Chi Df" = df, "Pr(>Chisq)"=p.value, stringsAsFactors = FALSE, check.names = FALSE)
- rownames(anova_table) <- fixed.effects
- if (type == 3 | type == "III") anova_tab_addition <- paste0("Df full model: ", df.large[1])
- else anova_tab_addition <- paste0("Df full model(s): ", df.large)
-
- #
- # attr(anova_table, "heading") <- c(paste0("Mixed Model Anova Table (Type ", type , " tests)\n"), paste0("Response: ", dv)
- #title <- "Analysis of Variance Table\n"
- #topnote <- paste("Model ", format(1L:nmodels), ": ", variables,
- # sep = "", collapse = "\n")
- } else if (method[1] == "F") {
- #browser()
- tests <- vector("list", length(fixed.effects))
- getFvalue <- function(largeModel, smallModel) {
- #browser()
- L <- .model2restrictionMatrix(largeModel, smallModel)
- #PhiA <- vcovAdj(largeModel, details = 0)
- PhiA <- vcov(largeModel)
- beta <- fixef(largeModel)
- betaH <- 0
- betaDiff <- cbind( beta - betaH )
- Wald <- as.numeric(t(betaDiff) %*% t(L) %*% solve(L%*%PhiA%*%t(L), L%*%betaDiff))
- q <- rankMatrix(L)
- FstatU <- Wald/q
- list(df1 = q, F = FstatU)
- }
- for (c in seq_along(fixed.effects)) {
- if (type == 3 | type == "III") tests[[c]] <- getFvalue(full.model, fits[[c]])
- else if (type == 2 | type == "II") {
- order.c <- effect.order[c]
- tmpModel <- full.model[[order.c]]
- tests[[c]] <- getFvalue(tmpModel, fits[[c]])
- }
- }
- names(tests) <- fixed.effects
- df.out <- data.frame(Effect = fixed.effects, F = vapply(tests, "[[", i = "F", 0), ndf = vapply(tests, "[[", i = "df1", 0), p.value = NA, stringsAsFactors = FALSE)
- rownames(df.out) <- NULL
- } else stop('Only methods "KR", "PB", "LRT" or "F" currently implemented.')
- ####################
- ### Part IV: prepare output
- ####################
- class(anova_table) <- c("anova", "data.frame")
- attr(anova_table, "heading") <- c(
- paste0("Mixed Model Anova Table (Type ", type , " tests)\n"),
- paste0("Model: ", deparse(formula.f)),
- paste0("Data: " ,mc[["data"]]),
- anova_tab_addition
- )
- list.out <- list(anova_table = anova_table, full.model = full.model, restricted.models = fits, tests = tests) #, type = type, method = method[[1]]
- class(list.out) <- "mixed"
- attr(list.out, "type") <- type
- attr(list.out, "method") <- method
- list.out
-}
-
-get_mixed_warnings <- function(x) {
- ntry <- function(x) tryCatch(x, error = function(e) NULL)
- if (is.list(x$full)) {
- warnings1 <- c(full = lapply(x[[2]], function(y) y at optinfo$warnings), lapply(x[[3]], function(y) y at optinfo$warnings))
- warnings2 <- c(full = lapply(x[[2]], function(y) ntry(y at optinfo$conv$lme4$messages)), lapply(x[[3]], function(y) ntry(y at optinfo$conv$lme4$messages)))
- } else {
- warnings1 <- c(full = list(x$full.model at optinfo$warnings), lapply(x[[3]], function(y) y at optinfo$warnings))
- warnings2 <- c(full = list(ntry(x$full.model at optinfo$conv$lme4$messages)), lapply(x[[3]], function(y) ntry(y at optinfo$conv$lme4$messages)))
- }
- warnings <- mapply(function(x, y) c(unlist(x), y), warnings1, warnings2, SIMPLIFY=FALSE)
- warn <- vapply(warnings, function(y) !length(y)==0, NA)
- for (i in names(warn)[warn]) warning("lme4 reported (at least) the following warnings for '", i, "':\n * ", paste(warnings[[i]], collapse = "\n * "))
-}
-
-check_likelihood <- function(object) {
- if (attr(object, "type") == 3 | attr(object, "type") == "III") {
- logLik_full <- as.numeric(logLik(object[["full.model"]]))
- logLik_restricted <- as.numeric(vapply(object[["restricted.models"]], logLik, 0))
- if(any(logLik_restricted > logLik_full)) return(rownames(object$anova_table)[logLik_restricted > logLik_full])
- } else if (attr(object, "type") == 2 | attr(object, "type") == "II") {
- NULL
-# logLik_full <- as.numeric(vapply(fits[1:max.effect.order],logLik, 0))
-# logLik_restricted <- as.numeric(vapply(fits[(max.effect.order+1):length(fits)], logLik, 0))
-# warn_logLik <- c()
-# for (c in seq_along(fixed.effects)) {
-# order.c <- effect.order[c]
-# if(logLik_restricted[[c]] > logLik_full[[order.c]]) warn_logLik <- c(warn_logLik, fixed.effects[c])
-# }
-# if(length(warn_logLik)>0) return(warn_logLik)
- }
- return(TRUE)
-}
-
-
-#' @rdname mixed
-#' @export
-lmer_alt <- function(formula, data, check.contrasts = FALSE, ...) {
- mc <- match.call()
- #assign(all.vars(mc[["data"]]), data)
- mc[[1]] <- as.name("mixed")
- mc[["return"]] <- "merMod"
- mc[["expand_re"]] <- TRUE
- mc[["progress"]] <- FALSE
- mc[["check.contrasts"]] <- check.contrasts
- #browser()
- eval(mc)
-}
-
-#' @method print mixed
-#' @export
-print.mixed <- function(x, ...) {
- if(!isREML(x[["full.model"]]) && !isTRUE(check_likelihood(x)))
- warning(paste("Following nested model(s) provide better fit than full model:", paste(check_likelihood(x), collapse = ", "), "\n It is highly recommended to try different optimizer via lmerControl or allFit!"))
- get_mixed_warnings(x)
- tmp <- nice.mixed(x, ...)
- print(tmp)
- invisible(tmp)
-}
-
-
-#anova.mixed <-
-
-#' @method summary mixed
-#' @export
-summary.mixed <- function(object, ...) summary(object = if (length(object[["full.model"]]) == 1) object[["full.model"]] else object[["full.model"]][[length(object[["full.model"]])]], ...)
-
-#' @method anova mixed
-#' @export
-anova.mixed <- function(object, ..., refit = FALSE) {
- mCall <- match.call(expand.dots = TRUE)
- dots <- list(...)
- modp <- (as.logical(vapply(dots, is, NA, "merMod")) |
- as.logical(vapply(dots, is, NA, "lm")) |
- as.logical(vapply(dots, is, NA, "mixed"))
- )
- if (any(modp)) {
- model.names <- c(deparse(mCall[["object"]]), vapply(which(modp), function(x) deparse(mCall[[x+2]]), ""))
- for (i in which(as.logical(vapply(dots, is, NA, "mixed")))) dots[[i]] <- dots[[i]]$full.model
- return(do.call(anova, args = c(object = object, dots, model.names = list(model.names), refit = refit)))
- } else {
- if(!isREML(object[["full.model"]]) && !isTRUE(check_likelihood(object)))
- warning(paste("Following nested model(s) provide better fit than full model:", paste(check_likelihood(object), collapse = ", "), "\n It is highly recommended to try different optimizer via lmerControl or allFit!"))
- get_mixed_warnings(object)
- object$anova_table
- }
-}
-
-
-
-
-## support for lsmeans for mixed objects:
-#' @importFrom lsmeans recover.data lsm.basis
-#' @method recover.data mixed
-#' @export
-recover.data.mixed <- function(object, ...) {
- recover.data(object$full.model, ...)
-}
-
-
-#' @method lsm.basis mixed
-#' @export
-lsm.basis.mixed <- function(object, trms, xlev, grid, ...) {
- lsm.basis(object$full.model, trms, xlev, grid, ...)
-}
-
-
-
-
-
-
-### old stuff (actually not usable right now)
-# is.mixed <- function(x) inherits(x, "mixed")
-
-## some code copied from pbkrtest.
-
-.restrictionMatrixBA<-function(B,A) {
- ## <A> in <B>
- ## determine L such that <A>={Bb| b in Lb=0}
- d <- rankMatrix(cbind(A,B)) - rankMatrix(B)
- if (d > 0) {
- stop('Error: <A> not subspace of <B> \n')
- }
- Q <- qr.Q(qr(cbind(A,B)))
- Q2 <- Q[,(rankMatrix(A)+1):rankMatrix(B)]
- L <- t(Q2) %*% B
- ##make rows of L2 orthogonal
- L <-t(qr.Q(qr(t(L))))
- L
-}
-
-.model2restrictionMatrix <- function (largeModel, smallModel) {
- L <- if(is.matrix(smallModel)) {
- ## ensures that L is of full row rank:
- LL <- smallModel
- q <- rankMatrix(LL)
- if (q < nrow(LL) ){
- t(qr.Q(qr(t(LL)))[,1:qr(LL)$rank])
- } else {
- smallModel
- }
- } else { #smallModel is mer model
- .restrictionMatrixBA(getME(largeModel,'X'),getME(smallModel,'X'))
- }
- L<-.makeSparse(L)
- L
-}
-
-.makeSparse<-function(X) {
- X<-as.matrix(X)
- w<-cbind(c(row(X)),c(col(X)),c(X))
- w<-w[abs(w[,3])>1e-16,,drop=FALSE]
- Y<-sparseMatrix(w[,1],w[,2],x=w[,3],dims=dim(X))
-}
+#' p-values for fixed effects of mixed-model via lme4::lmer()
+#'
+#' Calculates p-values for all fixed effects in a mixed model. This is done by first fitting (with \code{\link[lme4]{lmer}}) the full model and then versions thereof in which a single effect is removed and comparing the reduced model to the full model. The default is to calculate type 3 like p-values using the Kenward-Roger approximation for degrees-of-freedom (using \code{\link[pbkrtest]{KRmodcomp}}; for LMMs only). Other methods for obtaining p-values are parametric bootstrap (\code{me [...]
+#'
+#'
+#' @param formula a formula describing the full mixed-model to be fitted. As this formula is passed to \code{lmer}, it needs at least one random term.
+#' @param data data.frame containing the data. Should have all the variables present in \code{fixed}, \code{random}, and \code{dv} as columns.
+#' @param type type of test on which effects are based. Default is to use type 3 tests, taken from \code{\link{afex_options}}.
+#' @param method character vector indicating which methods for obtaining p-values should be used: \code{"KR"} corresponds to the Kenward-Roger approximation for degrees of freedom (only working with linear mixed models), \code{"PB"} calculates p-values based on parametric bootstrap, \code{"LRT"} calculates p-values via the likelihood ratio tests implemented in the \code{anova} method for \code{merMod} objects (only recommended for models with many [i.e., > 50] levels for the random facto [...]
+#' @param per.parameter \code{character} vector specifying for which variable tests should be run for each parameter (instead for the overall effect). Can be useful e.g., for testing ordered factors. Relatively untested so results should be compared with a second run without setting this argument. Uses \code{\link{grep}} for selecting parameters among the fixed effects so regular expressions (\code{\link{regex}}) are possible. See Examples.
+#' @param args.test \code{list} of arguments passed to the function calculating the p-values. See Details.
+#' @param test.intercept logical. Whether or not the intercept should also be fitted and tested for significance. Default is \code{FALSE}. Only relevant if \code{type = 3}.
+#' @param check.contrasts \code{logical}. Should contrasts be checked and (if necessary) changed to \code{"contr.sum"}? See Details. The default (\code{"TRUE"}) is taken from \code{\link{afex_options}}.
+#' @param expand_re logical. Should random effects terms be expanded (i.e., factors transformed into numerical variables) before fitting with \code{(g)lmer}? Allows to use "||" notation with factors.
+#' @param set.data.arg \code{logical}. Should the data argument in the slot \code{call} of the \code{merMod} object returned from \code{lmer} be set to the passed data argument? Otherwise the name will be \code{data}. Helpful if fitted objects are used afterwards (e.g., using \pkg{lsmeans}). Default is \code{TRUE}.
+#' @param progress if \code{TRUE}, shows progress with a text progress bar and other status messages during fitting.
+#' @param cl A vector identifying a cluster; used for distributing the estimation of the different models using several cores. See examples. If \code{ckeck.contrasts}, mixed sets the current contrasts (\code{getOption("contrasts")}) at the nodes. Note this does \emph{not} distribute calculation of p-values (e.g., when using \code{method = "PB"}) across the cluster. Use \code{args.test} for this.
+#' @param return the default is to return an object of class \code{"mixed"}. \code{return = "merMod"} will skip the calculation of all submodels and p-values and simply return the full model fitted with lmer. Can be useful in combination with \code{expand_re = TRUE} which allows to use "||" with factors.
+#' @param ... further arguments (such as \code{weights}/\code{family}) passed to \code{\link{lmer}}/\code{\link{glmer}}.
+#'
+#'
+#' @return An object of class \code{"mixed"} (i.e., a list) with the following elements:
+#'
+#' \enumerate{
+#' \item \code{anova_table} a data.frame containing the statistics returned from \code{\link[pbkrtest]{KRmodcomp}}. The \code{stat} column in this data.frame gives the value of the test statistic, an F-value for \code{method = "KR"} and a chi-square value for the other two methods.
+#' \item \code{full.model} the \code{"lmerMod"} object returned from fitting the full mixed model.
+#' \item \code{restricted.models} a list of \code{"lmerMod"} objects from fitting the restricted models (i.e., each model lacks the corresponding effect)
+#' \item \code{tests} a list of objects returned by the function for obtaining the p-values.
+#' }
+#'
+#' It also has the following attributes, \code{"type"} and \code{"method"}.
+#'
+#' Two similar methods exist for objects of class \code{"mixed"}: \code{print} and \code{anova}. They print a nice version of the \code{anova_table} element of the returned object (which is also invisibly returned). This methods omit some columns and nicely round the other columns. The following columns are always printed:
+#' \enumerate{
+#' \item \code{Effect} name of effect
+#' \item \code{p.value} estimated p-value for the effect
+#' }
+#'
+#' For LMMs with \code{method="KR"} the following further columns are returned (note: the Kenward-Roger correction does two separate things: (1) it computes an effective number for the denominator df; (2) it scales the statistic by a calculated amount, see also \url{http://stackoverflow.com/a/25612960/289572}):
+#' \enumerate{
+#' \item \code{F} computed F statistic
+#' \item \code{ndf} numerator degrees of freedom (number of parameters used for the effect)
+#' \item \code{ddf} denominator degrees of freedom (effective residual degrees of freedom for testing the effect), computed from the Kenward-Roger correction using \code{pbkrtest::KRmodcomp}
+#' \item \code{F.scaling} scaling of F-statistic computing from Kenward-Roger approximation.
+#' }
+#'
+#' For models with \code{method="LRT"} the following further columns are returned:
+#' \enumerate{
+#' \item \code{df.large} degrees of freedom (i.e., estimated paramaters) for full model (i.e., model containing the corresponding effect)
+#' \item \code{df.small} degrees of freedom (i.e., estimated paramaters) for restricted model (i.e., model without the corresponding effect)
+#' \item \code{chisq} 2 times the difference in likelihood (obtained with \code{logLik}) between full and restricted model
+#' \item \code{df} difference in degrees of freedom between full and restricted model (p-value is based on these df).
+#' }
+#'
+#' For models with \code{method="PB"} the following further column is returned:
+#' \enumerate{
+#' \item \code{stat} 2 times the difference in likelihood (obtained with \code{logLik}) between full and restricted model (i.e., a chi-square value).
+#' }
+#'
+#' Note that \code{anova} can also be called with additional mixed and/or \code{merMod} objects. In this casethe full models are passed on to \code{anova.merMod} (with \code{refit=FALSE}, which differs from the default of \code{anova.merMod}) which produces the known LRT tables.
+#'
+#' The \code{summary} method for objects of class \code{mixed} simply calls \code{\link{summary.merMod}} on the full model.
+#'
+#' If \code{return = "merMod"}, an object of class \code{"merMod"}, as returned from \code{g/lmer}, is returned.
+#'
+#' @details For an introduction to mixed-modeling for experimental designs see Barr, Levy, Scheepers, & Tily (2013; I highly recommend reading this paper if you use this function), arguments for using the Kenward-Roger approximation for obtaining p-values are given by Judd, Westfall, and Kenny (2012). Further introductions to mixed-modeling for experimental designs are given by Baayen and colleagues (Baayen, 2008; Baayen, Davidson & Bates, 2008; Baayen & Milin, 2010). Specific recommenda [...]
+#'
+#'\subsection{p-value Calculations}{
+#'
+#' p-values are per default calculated via methods from \pkg{pbkrtest}. When \code{method = "KR"} (the default), the Kenward-Roger approximation for degrees-of-freedom is calculated using \code{\link[pbkrtest]{KRmodcomp}}, which is only applicable to linear-mixed models. The test statistic in the output is a F-value (\code{F}).
+#'
+#' \code{method = "PB"} calculates p-values using parametric bootstrap using \code{\link[pbkrtest]{PBmodcomp}}. This can be used for linear and also generalized linear mixed models (GLMM) by specifying a \code{\link[stats]{family}} argument to \code{mixed}. Note that you should specify further arguments to \code{PBmodcomp} via \code{args.test}, especially \code{nsim} (the number of simulations to form the reference distribution) or \code{cl} (for using multiple cores). For other argument [...]
+#'
+#' \code{method = "LRT"} calculates p-values via likelihood ratio tests implemented in the \code{anova} method for \code{"merMod"} objects. This is recommended by Barr et al. (2013; which did not test the other methods implemented here). Using likelihood ratio tests is only recommended for models with many levels for the random effects (> 50), but can be pretty helpful in case the other methods fail (due to memory and/or time limitations). The \href{http://glmm.wikidot.com/faq}{lme4 faq} [...]
+#' }
+#'
+#' \subsection{Implementation Details}{
+#'
+#' Type 3 tests are obtained by comparing a model in which only the tested effect is excluded with the full model (containing all effects). This corresponds to the (type 3) Wald tests given by \code{car::Anova} for \code{"lmerMod"} models. The submodels in which the tested effect is excluded are obtained by manually creating a model matrix which is then fitted in \code{"lme4"}. This is done to avoid R's "feature" to not allow this behavior.
+#'
+#' Type 2 tests are truly sequential. They are obtained by comparing a model in which the tested effect and all higher oder effect (e.g., all three-way interactions for testing a two-way interaction) are excluded with a model in which only effects up to the order of the tested effect are present and all higher order effects absent. In other words, there are multiple full models, one for each order of effects. Consequently, the results for lower order effects are identical of whether or n [...]
+#'
+#' If \code{check.contrasts = TRUE}, contrasts will be set to \code{"contr.sum"} for all factors in the formula if default contrasts are not equal to \code{"contr.sum"} or \code{attrib(factor, "contrasts") != "contr.sum"}. Furthermore, the current contrasts (obtained via \code{getOption("contrasts")}) will be set at the cluster nodes if \code{cl} is not \code{NULL}.
+#' }
+#'
+#' \subsection{Expand Random Effects}{
+#' The latest addition, motivated by Bates et al. (2015), is the possibility to expand the random effects structure before passing it to \code{lmer} by setting \code{expand_re = TRUE}. This allows to disable estimation of correlation among random effects for random effects term containing factors using the \code{||} notation. This is achieved by first creating a model matrix for each random effects term individually, rename and append the so created columns to the data that will be fitte [...]
+#'
+#' \code{lmer_alt} is simply a wrapper for \code{mixed} that is intended to behave like \code{lmer} (or \code{glmer} if a \code{family} argument is present), but also allows to use \code{||} with factors correctly (by always using \code{expand_re = TRUE}). This means that \code{lmer_alt} per default does not enforce a specific contrast on factors and only returns the \code{"merMod"} object without calculating any additional models or p-values (this is achieved by setting \code{return = " [...]
+#'
+#' One negative consequence of using \code{expand_re = TRUE} is that the data that is fitted will not be the same as the passed data.frame which can lead to problems with e.g., the \code{predict} method. Finally, note that this functionality is relatively new so please proceed with care.
+#' }
+#'
+#' @note When \code{method = "KR"}, obtaining p-values is known to crash due too insufficient memory or other computational limitations (especially with complex random effects structures). In these cases, the other methods should be used. The RAM demand is a problem especially on 32 bit Windows which only supports up to 2 or 3GB RAM (see \href{http://cran.r-project.org/bin/windows/base/rw-FAQ.html}{R Windows FAQ}). Then it is probably a good idea to use methods "LRT" or "PB".
+#'
+#' \code{"mixed"} will throw a message if numerical variables are not centered on 0, as main effects (of other variables then the numeric one) can be hard to interpret if numerical variables appear in interactions. See Dalal & Zickar (2012).
+#'
+#' Formulas longer than 500 characters will most likely fail due to the use of \code{\link{deparse}}.
+#'
+#' Please report bugs or unexpected behavior by opening a guthub issue: \url{https://github.com/singmann/afex/issues}
+#'
+#' @author Henrik Singmann with contributions from \href{http://stackoverflow.com/q/11335923/289572}{Ben Bolker and Joshua Wiley}.
+#'
+#' @seealso \code{\link{aov_ez}} and \code{\link{aov_car}} for convenience functions to analyze experimental deisgns with classical ANOVA or ANCOVA wrapping \code{\link[car]{Anova}}.
+#'
+#' see the following for the data sets from Maxwell and Delaney (2004) used and more examples: \code{\link{md_15.1}}, \code{\link{md_16.1}}, and \code{\link{md_16.4}}.
+#'
+#' @references Baayen, R. H. (2008). \emph{Analyzing linguistic data: a practical introduction to statistics using R}. Cambridge, UK; New York: Cambridge University Press.
+#'
+#' Baayen, R. H., Davidson, D. J., & Bates, D. M. (2008). Mixed-effects modeling with crossed random effects for subjects and items. \emph{Journal of Memory and Language}, 59(4), 390-412. doi:10.1016/j.jml.2007.12.005
+#'
+#' Baayen, R. H., & Milin, P. (2010). Analyzing Reaction Times. \emph{International Journal of Psychological Research}, 3(2), 12-28.
+#'
+#' Barr, D. J. (2013). Random effects structure for testing interactions in linear mixed-effects models. \emph{Frontiers in Quantitative Psychology and Measurement}, 328. doi:10.3389/fpsyg.2013.00328
+#'
+#' Barr, D. J., Levy, R., Scheepers, C., & Tily, H. J. (2013). Random effects structure for confirmatory hypothesis testing: Keep it maximal. \emph{Journal of Memory and Language}, 68(3), 255-278. doi:10.1016/j.jml.2012.11.001
+#'
+#' Bates, D., Kliegl, R., Vasishth, S., & Baayen, H. (2015). \emph{Parsimonious Mixed Models}. arXiv:1506.04967 [stat]. Retrieved from \url{http://arxiv.org/abs/1506.04967}
+#'
+#' Dalal, D. K., & Zickar, M. J. (2012). Some Common Myths About Centering Predictor Variables in Moderated Multiple Regression and Polynomial Regression. \emph{Organizational Research Methods}, 15(3), 339-362. doi:10.1177/1094428111430540
+#'
+#' Judd, C. M., Westfall, J., & Kenny, D. A. (2012). Treating stimuli as a random factor in social psychology: A new and comprehensive solution to a pervasive but largely ignored problem. \emph{Journal of Personality and Social Psychology}, 103(1), 54-69. doi:10.1037/a0028347
+#'
+#' Maxwell, S. E., & Delaney, H. D. (2004). \emph{Designing experiments and analyzing data: a model-comparisons perspective.} Mahwah, N.J.: Lawrence Erlbaum Associates.
+#'
+#'
+#' @import pbkrtest
+#' @importFrom lme4 lmer glmer nobars getME fixef isREML
+#' @importFrom stringr str_replace
+#' @importMethodsFrom Matrix t isSymmetric "%*%" solve diag
+#' @importClassesFrom Matrix Matrix
+#' @importFrom Matrix Matrix sparseMatrix rankMatrix
+#' @importFrom parallel clusterCall clusterExport clusterEvalQ clusterApplyLB
+#' @importFrom stats logLik terms as.formula contrasts<- model.matrix model.frame anova vcov
+#' @importFrom methods is
+#' @encoding UTF-8
+#'
+#' @example examples/examples.mixed.R
+#'
+#' @export
+mixed <- function(formula, data, type = afex_options("type"), method = afex_options("method_mixed"), per.parameter = NULL, args.test = list(), test.intercept = FALSE, check.contrasts = afex_options("check.contrasts"), expand_re = FALSE, set.data.arg = TRUE, progress = TRUE, cl = NULL, return = "mixed", ...) {
+ if (check.contrasts) {
+ #browser()
+ vars.to.check <- all.vars(formula)
+ resetted <- NULL
+ for (i in vars.to.check) {
+ if (is.factor(data[,i])) {
+ if (is.null(attr(data[,i], "contrasts")) & (options("contrasts")[[1]][1] != "contr.sum")) {
+ contrasts(data[,i]) <- "contr.sum"
+ resetted <- c(resetted, i)
+ }
+ else if (!is.null(attr(data[,i], "contrasts")) && attr(data[,i], "contrasts") != "contr.sum") {
+ contrasts(data[,i]) <- "contr.sum"
+ resetted <- c(resetted, i)
+ }
+ }
+ }
+ if (!is.null(resetted)) message(str_c("Contrasts set to contr.sum for the following variables: ", str_c(resetted, collapse=", ")))
+ }
+ #warning(str_c("Calculating Type 3 sums with contrasts = ", options("contrasts")[[1]][1], ".\n Use options(contrasts=c('contr.sum','contr.poly')) instead"))
+ # browser()
+ method <- match.arg(method, c("KR", "PB", "LRT", "F"), several.ok=TRUE)
+ ####################
+ ### Part I: prepare fitting (i.e., obtain model info, check model, ...)
+ ####################
+ mc <- match.call()
+ #browser()
+ formula.f <- as.formula(formula)
+ if (class(formula) != "formula") message("Formula (the first argument) converted to formula.")
+ dv <- as.character(formula.f)[[2]]
+ all.terms <- attr(terms(formula.f), "term.labels")
+ effect.order <- attr(terms(formula.f), "order")
+ effect.order <- effect.order[!grepl("\\|", all.terms)]
+ max.effect.order <- max(effect.order)
+ random <- str_c(str_c("(", all.terms[grepl("\\|", all.terms)], ")"), collapse = " + ")
+ rh2 <- nobars(formula.f)
+ rh2[[2]] <- NULL
+ m.matrix <- model.matrix(rh2, data = data)
+ fixed.effects <- attr(terms(rh2, data = data), "term.labels")
+ mapping <- attr(m.matrix, "assign")
+ fixed.vars <- all.vars(rh2)
+ # check for missing values in variables used:
+ if (nrow(m.matrix) != nrow(data)) {
+ data <- model.frame(as.formula(str_c(vars.to.check[1], "~", str_c(vars.to.check[-1], collapse = "+"))), data = data)
+ m.matrix <- model.matrix(rh2, data = data)
+ warning(str_c("Due to missing values, reduced number of observations to ", nrow(data)))
+ if(set.data.arg) {
+ warning("Due to missing values, set.data.arg set to FALSE.")
+ set.data.arg <- FALSE
+ }
+ }
+
+ # check if numerical variables are centered
+ c.ns <- fixed.vars[vapply(data[, fixed.vars, drop = FALSE], is.numeric, TRUE)]
+ if (length(c.ns) > 0) {
+ non.null <- c.ns[!abs(vapply(data[, c.ns, drop = FALSE], mean, 0)) < .Machine$double.eps ^ 0.5]
+ if (length(non.null) > 0) message(str_c("Numerical variables NOT centered on 0 (i.e., interpretation of all main effects might be difficult if in interactions): ", str_c(non.null, collapse = ", ")))
+ }
+ if (expand_re) {
+ random_parts <- str_c(all.terms[grepl("\\|", all.terms)])
+ which_random_double_bars <- str_detect(random_parts, "\\|\\|")
+ random_units <- str_replace(random_parts, "^.+\\|\\s+", "")
+ tmp_random <- lapply(str_replace(random_parts, "\\|.+$", ""), function(x) as.formula(str_c("~", x)))
+ tmp_model.matrix <- vector("list", length(random_parts))
+ re_contains_intercept <- rep(FALSE, length(random_parts))
+ new_random <- vector("character", length(random_parts))
+ for (i in seq_along(random_parts)) {
+ tmp_model.matrix[[i]] <- model.matrix(tmp_random[[i]], data = data)
+ if (ncol(tmp_model.matrix[[i]]) == 0) stop("Invalid random effects term, e.g., (0|id)")
+ if (colnames(tmp_model.matrix[[i]])[1] == "(Intercept)") {
+ tmp_model.matrix[[i]] <- tmp_model.matrix[[i]][,-1, drop = FALSE]
+ re_contains_intercept[i] <- TRUE
+ }
+ if (ncol(tmp_model.matrix[[i]]) > 0) {
+ colnames(tmp_model.matrix[[i]]) <- str_c("re", i, ".", str_replace_all(colnames(tmp_model.matrix[[i]]), ":", "_by_"))
+ new_random[i] <- str_c("(", as.numeric(re_contains_intercept[i]), "+", str_c(colnames(tmp_model.matrix[[i]]), collapse = "+"), if (which_random_double_bars[i]) "||" else "|", random_units[i], ")")
+ } else {
+ new_random[i] <- str_c("(", as.numeric(re_contains_intercept[i]), if (which_random_double_bars[i]) "||" else "|", random_units[i], ")")
+ }
+ }
+ data <- cbind(data, as.data.frame(do.call(cbind, tmp_model.matrix)))
+ random <- str_c(new_random, collapse = "+")
+ }
+ ####################
+ ### Part II: obtain the lmer fits
+ ####################
+ ## Part IIa: prepare formulas
+ mf <- mc[!names(mc) %in% c("type", "method", "args.test", "progress", "check.contrasts", "per.parameter", "cl", "test.intercept", "expand_re", "return")]
+ mf[["formula"]] <-as.formula(str_c(dv,deparse(rh2, width.cutoff = 500L),"+",random)) #formula.f
+ if ("family" %in% names(mf)) mf[[1]] <- as.name("glmer")
+ else mf[[1]] <- as.name("lmer")
+ mf[["data"]] <- as.name("data")
+ if ((method[1] %in% c("PB", "LRT")) & !("family" %in% names(mf))) if ((!"REML" %in% names(mf)) || mf[["REML"]]) {
+ message("REML argument to lmer() set to FALSE for method = 'PB' or 'LRT'")
+ mf[["REML"]] <- FALSE
+ }
+ #browser()
+ if (return == "merMod") {
+ out <- eval(mf)
+ if(set.data.arg) out at call[["data"]] <- mc[["data"]]
+ return(out)
+ }
+ ## prepare (g)lmer formulas:
+ if (type == 3 | type == "III") {
+ if (attr(terms(rh2, data = data), "intercept") == 1) fixed.effects <- c("(Intercept)", fixed.effects)
+ #per.parameter <- c("hour", "treatment")
+ # The next part alters the mapping of parameters to effects/variables if
+ # per.parameter is not NULL (this does the complete magic).
+ if (!is.null(per.parameter)) {
+ fixed.to.change <- c()
+ for (parameter in per.parameter) {
+ fixed.to.change <- c(fixed.to.change, grep(parameter, fixed.effects))
+ }
+ fixed.to.change <- fixed.effects[sort(unique(fixed.to.change))]
+ if ("(Intercept)" %in% fixed.to.change) fixed.to.change <- fixed.to.change[-1]
+ fixed.all <- dimnames(m.matrix)[[2]]
+ #tf2 <- fixed.to.change[2]
+ for (tf2 in fixed.to.change) {
+ tf <- which(fixed.effects == tf2)
+ fixed.lower <- fixed.effects[seq_len(tf-1)]
+ fixed.upper <- if (tf < length(fixed.effects)) fixed.effects[(tf+1):length(fixed.effects)] else NULL
+ fixed.effects <- c(fixed.lower, fixed.all[which(mapping == (tf-1))], fixed.upper)
+ map.to.replace <- which(mapping == (tf-1))
+ map.lower <- mapping[seq_len(map.to.replace[1]-1)]
+ map.upper <- if (max(map.to.replace) < length(mapping)) mapping[(map.to.replace[length(map.to.replace)]+1):length(mapping)] else NULL
+ mapping <- c(map.lower, seq_along(map.to.replace) + map.lower[length(map.lower)], map.upper + length(map.to.replace)-1)
+ }
+ }
+ # make formulas
+ formulas <- vector("list", length(fixed.effects) + 1)
+ formulas[[1]] <- mf[["formula"]]
+ for (i in seq_along(fixed.effects)) {
+ tmp.columns <- str_c(deparse(-which(mapping == (i-1))), collapse = "")
+ formulas[[i+1]] <- as.formula(str_c(dv, "~ 0 + m.matrix[,", tmp.columns, "] +", random))
+ }
+ names(formulas) <- c("full.model", fixed.effects)
+ if (!test.intercept && fixed.effects[1] == "(Intercept)") {
+ fixed.effects <- fixed.effects[-1]
+ formulas[["(Intercept)"]] <- NULL
+ }
+ } else if (type == 2 | type == "II") {
+ #warning("Implementation of Type 2 method not unproblematic.\n Check documentation or use car::Anova (Wald tests).")
+ if (!is.null(per.parameter)) stop("per.parameter argument only implemented for Type 3 tests.")
+ full.model.formulas <- vector("list", max.effect.order)
+ submodel.formulas <- vector("list", length(fixed.effects))
+ full.model.formulas[[length(full.model.formulas)]] <- mf[["formula"]]
+ for (c in seq_len(max.effect.order)) {
+ if (c == max.effect.order) next
+ tmp.columns <- str_c(deparse(-which(mapping %in% which(effect.order > c))), collapse = "")
+ full.model.formulas[[c]] <- as.formula(str_c(dv, "~ 0 + m.matrix[,", tmp.columns, "] +", random))
+ }
+ for (c in seq_along(fixed.effects)) {
+ order.c <- effect.order[c]
+ tmp.columns <- str_c(deparse(-which(mapping == (c) | mapping %in% if (order.c == max.effect.order) -1 else which(effect.order > order.c))), collapse = "")
+ submodel.formulas[[c]] <- as.formula(str_c(dv, "~ 0 + m.matrix[,", tmp.columns, "] +", random))
+ }
+ formulas <- c(full.model.formulas, submodel.formulas)
+ } else stop('Only type 3 and type 2 tests implemented.')
+ ## Part IIb: fit models
+ # single core
+ if (is.null(cl)) {
+ if (progress) cat(str_c("Fitting ", length(formulas), " (g)lmer() models:\n["))
+ fits <- vector("list", length(formulas))
+ for (i in seq_along(formulas)) {
+ mf[["formula"]] <- formulas[[i]]
+ fits[[i]] <- eval(mf)
+ if (progress) cat(".")
+ }
+ if (progress) cat("]\n")
+ } else { # multicore
+ eval.cl <- function(formula, m.call, progress) {
+ m.call[[2]] <- formula
+ res <- eval(m.call)
+ if (progress) cat(".")
+ return(res)
+ }
+ if (progress) cat(paste0("Fitting ", length(formulas), " (g)lmer() models.\n"))
+ #junk <- clusterEvalQ(cl = cl, library("lme4", character.only = TRUE))
+ junk <- clusterCall(cl = cl, "require", package = "lme4", character.only = TRUE)
+ #junk <- clusterEvalQ(cl = cl, loadNamespace("lme4"))
+ if (check.contrasts) {
+ curr.contrasts <- getOption("contrasts")
+ clusterExport(cl = cl, "curr.contrasts", envir = sys.nframe())
+ junk <- clusterEvalQ(cl = cl, options(contrasts=curr.contrasts))
+ }
+ if (progress) junk <- clusterEvalQ(cl = cl, cat("["))
+ fits <- clusterApplyLB(cl = cl, x = formulas, eval.cl, m.call = mf, progress = progress)
+ if (progress) junk <- clusterEvalQ(cl = cl, cat("]"))
+ }
+ ## add correct data argument to lmer calls:
+
+ ####################
+ ### Part IIb: likelihood checks and refitting
+ ####################
+
+ check_likelihood <- function(fits) {
+ if (type == 3 | type == "III") {
+ logLik_full <- as.numeric(logLik(fits[[1]]))
+ logLik_restricted <- as.numeric(vapply(fits[2:length(fits)], logLik, 0))
+ if(any(logLik_restricted > logLik_full)) return(fixed.effects[logLik_restricted > logLik_full])
+ } else if (type == 2 | type == "II") {
+ logLik_full <- as.numeric(vapply(fits[1:max.effect.order],logLik, 0))
+ logLik_restricted <- as.numeric(vapply(fits[(max.effect.order+1):length(fits)], logLik, 0))
+ warn_logLik <- c()
+ for (c in seq_along(fixed.effects)) {
+ order.c <- effect.order[c]
+ if(logLik_restricted[[c]] > logLik_full[[order.c]]) warn_logLik <- c(warn_logLik, fixed.effects[c])
+ }
+ if(length(warn_logLik)>0) return(warn_logLik)
+ }
+ return(TRUE)
+ }
+
+ # check for smaller likelihood of nested model and refit if test fails:
+ if (FALSE) {
+ if(!isTRUE(check_likelihood(fits))) {
+ if (progress) cat("refitting...")
+ refits <- lapply(fits, allFit, verbose=FALSE, data = data)
+ browser()
+ str(fits[[1]], 2)
+ fits[[1]]@call
+ sapply(allFit(fits[[1]], data=md_16.4b), function(y) try(logLik(y)))
+ sapply(refits, function(x) sapply(x, function(y) tryCatch(as.numeric(logLik(y)), error = function(e) as.numeric(NA))))
+
+ fits <- lapply(refits, function(x) {
+ tmp_llk <- vapply(x, function(y) tryCatch(logLik(y), error = function(e) as.numeric(NA)), 0)
+ x[[which.min(tmp_llk)]]
+ })
+ }
+ }
+ # check again and warn
+ if(!isREML(fits[[1]]) & !isTRUE(check_likelihood(fits))) {
+ warning(paste("Following nested model(s) provide better fit than full model:", paste(check_likelihood(fits), collapse = ", "), "\n It is highly recommended to try different optimizer via lmerControl or allFit!"))
+ }
+
+ if(set.data.arg){
+ for (i in seq_along(fits)) {
+ fits[[i]]@call[["data"]] <- mc[["data"]]
+ }
+ }
+ ## prepare for p-values:
+ if (type == 3 | type == "III") {
+ full.model <- fits[[1]]
+ fits <- fits[-1]
+ } else if (type == 2 | type == "II") {
+ full.model <- fits[1:max.effect.order]
+ fits <- fits[(max.effect.order+1):length(fits)]
+ }
+ names(fits) <- fixed.effects
+
+ ####################
+ ### Part III: obtain p-values
+ ####################
+ ## obtain p-values:
+ #browser()
+ if (method[1] == "KR") {
+ if (progress) cat(str_c("Obtaining ", length(fixed.effects), " p-values:\n["))
+ tests <- vector("list", length(fixed.effects))
+ for (c in seq_along(fixed.effects)) {
+ if (type == 3 | type == "III") tests[[c]] <- KRmodcomp(full.model, fits[[c]])
+ else if (type == 2 | type == "II") {
+ order.c <- effect.order[c]
+ tests[[c]] <- KRmodcomp(full.model[[order.c]], fits[[c]])
+ }
+ if (progress) cat(".")
+ }
+ if (progress) cat("]\n")
+ names(tests) <- fixed.effects
+ #df.out <- data.frame(Effect = fixed.effects, stringsAsFactors = FALSE)
+ anova_table <- data.frame(t(vapply(tests, function(x) unlist(x[["test"]][1,]), unlist(tests[[1]][["test"]][1,]))))
+ #FtestU <- vapply(tests, function(x) unlist(x[["test"]][2,]), unlist(tests[[1]][["test"]][2,]))
+ #row.names(FtestU) <- str_c(row.names(FtestU), ".U")
+ #anova_table <- cbind(anova_table, t(FtestU))
+ rownames(anova_table) <- fixed.effects
+ colnames(anova_table) <- c("F", "num Df", "den Df", "F.scaling", "Pr(>F)")
+ anova_table <- anova_table[, c("num Df", "den Df", "F.scaling", "F", "Pr(>F)")]
+ anova_tab_addition <- NULL
+ } else if (method[1] == "PB") {
+ if (progress) cat(str_c("Obtaining ", length(fixed.effects), " p-values:\n["))
+ tests <- vector("list", length(fixed.effects))
+ for (c in seq_along(fixed.effects)) {
+ if (type == 3 | type == "III") tests[[c]] <- do.call(PBmodcomp, args = c(largeModel = full.model, smallModel = fits[[c]], args.test))
+ else if (type == 2 | type == "II") {
+ order.c <- effect.order[c]
+ tests[[c]] <- do.call(PBmodcomp, args = c(largeModel = full.model[[order.c]], smallModel = fits[[c]], args.test))
+ }
+ if (progress) cat(".")
+ }
+ if (progress) cat("]\n")
+ names(tests) <- fixed.effects
+ #browser()
+ #df.out<- data.frame(Effect = fixed.effects, stringsAsFactors = FALSE)
+ anova_table <- data.frame(t(vapply(tests, function(x) unlist(x[["test"]][2,]), unlist(tests[[1]][["test"]][2,]))))
+ anova_table <- anova_table[,-2]
+ LRT <- vapply(tests, function(x) unlist(x[["test"]][1,]), unlist(tests[[1]][["test"]][1,]))
+ row.names(LRT) <- str_c(row.names(LRT), ".LRT")
+ anova_table <- cbind(anova_table, t(LRT))
+ rownames(anova_table) <- fixed.effects
+ anova_table <- anova_table[, c("stat", "df.LRT", "p.value.LRT", "p.value")]
+ colnames(anova_table) <- c("Chisq", "Chi Df", "Pr(>Chisq)", "Pr(>PB)")
+ anova_tab_addition <- NULL
+ } else if (method[1] == "LRT") {
+ tests <- vector("list", length(fixed.effects))
+ for (c in seq_along(fixed.effects)) {
+ if (type == 3 | type == "III") tests[[c]] <- anova(full.model, fits[[c]])
+ else if (type == 2 | type == "II") {
+ order.c <- effect.order[c]
+ tmpModel <- full.model[[order.c]]
+ tests[[c]] <- anova(tmpModel, fits[[c]])
+ }
+ }
+ names(tests) <- fixed.effects
+ df.large <- vapply(tests, function(x) x[["Df"]][2], 0)
+ df.small <- vapply(tests, function(x) x[["Df"]][1], 0)
+ chisq <- vapply(tests, function(x) x[["Chisq"]][2], 0)
+ df <- vapply(tests, function(x) x[["Chi Df"]][2], 0)
+ p.value <- vapply(tests, function(x) x[["Pr(>Chisq)"]][2], 0)
+ anova_table <- data.frame(Df = df.small, Chisq = chisq, "Chi Df" = df, "Pr(>Chisq)"=p.value, stringsAsFactors = FALSE, check.names = FALSE)
+ rownames(anova_table) <- fixed.effects
+ if (type == 3 | type == "III") anova_tab_addition <- paste0("Df full model: ", df.large[1])
+ else anova_tab_addition <- paste0("Df full model(s): ", df.large)
+
+ #
+ # attr(anova_table, "heading") <- c(paste0("Mixed Model Anova Table (Type ", type , " tests)\n"), paste0("Response: ", dv)
+ #title <- "Analysis of Variance Table\n"
+ #topnote <- paste("Model ", format(1L:nmodels), ": ", variables,
+ # sep = "", collapse = "\n")
+ } else if (method[1] == "F") {
+ #browser()
+ tests <- vector("list", length(fixed.effects))
+ getFvalue <- function(largeModel, smallModel) {
+ #browser()
+ L <- .model2restrictionMatrix(largeModel, smallModel)
+ #PhiA <- vcovAdj(largeModel, details = 0)
+ PhiA <- vcov(largeModel)
+ beta <- fixef(largeModel)
+ betaH <- 0
+ betaDiff <- cbind( beta - betaH )
+ Wald <- as.numeric(t(betaDiff) %*% t(L) %*% solve(L%*%PhiA%*%t(L), L%*%betaDiff))
+ q <- rankMatrix(L)
+ FstatU <- Wald/q
+ list(df1 = q, F = FstatU)
+ }
+ for (c in seq_along(fixed.effects)) {
+ if (type == 3 | type == "III") tests[[c]] <- getFvalue(full.model, fits[[c]])
+ else if (type == 2 | type == "II") {
+ order.c <- effect.order[c]
+ tmpModel <- full.model[[order.c]]
+ tests[[c]] <- getFvalue(tmpModel, fits[[c]])
+ }
+ }
+ names(tests) <- fixed.effects
+ df.out <- data.frame(Effect = fixed.effects, F = vapply(tests, "[[", i = "F", 0), ndf = vapply(tests, "[[", i = "df1", 0), p.value = NA, stringsAsFactors = FALSE)
+ rownames(df.out) <- NULL
+ } else stop('Only methods "KR", "PB", "LRT" or "F" currently implemented.')
+ ####################
+ ### Part IV: prepare output
+ ####################
+ class(anova_table) <- c("anova", "data.frame")
+ attr(anova_table, "heading") <- c(
+ paste0("Mixed Model Anova Table (Type ", type , " tests)\n"),
+ paste0("Model: ", deparse(formula.f)),
+ paste0("Data: " ,mc[["data"]]),
+ anova_tab_addition
+ )
+ list.out <- list(anova_table = anova_table, full.model = full.model, restricted.models = fits, tests = tests) #, type = type, method = method[[1]]
+ class(list.out) <- "mixed"
+ attr(list.out, "type") <- type
+ attr(list.out, "method") <- method
+ list.out
+}
+
+get_mixed_warnings <- function(x) {
+ ntry <- function(x) tryCatch(x, error = function(e) NULL)
+ if (is.list(x$full)) {
+ warnings1 <- c(full = lapply(x[[2]], function(y) y at optinfo$warnings), lapply(x[[3]], function(y) y at optinfo$warnings))
+ warnings2 <- c(full = lapply(x[[2]], function(y) ntry(y at optinfo$conv$lme4$messages)), lapply(x[[3]], function(y) ntry(y at optinfo$conv$lme4$messages)))
+ } else {
+ warnings1 <- c(full = list(x$full.model at optinfo$warnings), lapply(x[[3]], function(y) y at optinfo$warnings))
+ warnings2 <- c(full = list(ntry(x$full.model at optinfo$conv$lme4$messages)), lapply(x[[3]], function(y) ntry(y at optinfo$conv$lme4$messages)))
+ }
+ warnings <- mapply(function(x, y) c(unlist(x), y), warnings1, warnings2, SIMPLIFY=FALSE)
+ warn <- vapply(warnings, function(y) !length(y)==0, NA)
+ for (i in names(warn)[warn]) warning("lme4 reported (at least) the following warnings for '", i, "':\n * ", paste(warnings[[i]], collapse = "\n * "))
+}
+
+check_likelihood <- function(object) {
+ if (attr(object, "type") == 3 | attr(object, "type") == "III") {
+ logLik_full <- as.numeric(logLik(object[["full.model"]]))
+ logLik_restricted <- as.numeric(vapply(object[["restricted.models"]], logLik, 0))
+ if(any(logLik_restricted > logLik_full)) return(rownames(object$anova_table)[logLik_restricted > logLik_full])
+ } else if (attr(object, "type") == 2 | attr(object, "type") == "II") {
+ NULL
+# logLik_full <- as.numeric(vapply(fits[1:max.effect.order],logLik, 0))
+# logLik_restricted <- as.numeric(vapply(fits[(max.effect.order+1):length(fits)], logLik, 0))
+# warn_logLik <- c()
+# for (c in seq_along(fixed.effects)) {
+# order.c <- effect.order[c]
+# if(logLik_restricted[[c]] > logLik_full[[order.c]]) warn_logLik <- c(warn_logLik, fixed.effects[c])
+# }
+# if(length(warn_logLik)>0) return(warn_logLik)
+ }
+ return(TRUE)
+}
+
+
+#' @rdname mixed
+#' @export
+lmer_alt <- function(formula, data, check.contrasts = FALSE, ...) {
+ mc <- match.call()
+ #assign(all.vars(mc[["data"]]), data)
+ mc[[1]] <- as.name("mixed")
+ mc[["return"]] <- "merMod"
+ mc[["expand_re"]] <- TRUE
+ mc[["progress"]] <- FALSE
+ mc[["check.contrasts"]] <- check.contrasts
+ #browser()
+ eval(mc)
+}
+
+#' @method print mixed
+#' @export
+print.mixed <- function(x, ...) {
+ if(!isREML(x[["full.model"]]) && !isTRUE(check_likelihood(x)))
+ warning(paste("Following nested model(s) provide better fit than full model:", paste(check_likelihood(x), collapse = ", "), "\n It is highly recommended to try different optimizer via lmerControl or allFit!"))
+ get_mixed_warnings(x)
+ tmp <- nice.mixed(x, ...)
+ print(tmp)
+ invisible(tmp)
+}
+
+
+#anova.mixed <-
+
+#' @method summary mixed
+#' @export
+summary.mixed <- function(object, ...) summary(object = if (length(object[["full.model"]]) == 1) object[["full.model"]] else object[["full.model"]][[length(object[["full.model"]])]], ...)
+
+#' @method anova mixed
+#' @export
+anova.mixed <- function(object, ..., refit = FALSE) {
+ mCall <- match.call(expand.dots = TRUE)
+ dots <- list(...)
+ modp <- (as.logical(vapply(dots, is, NA, "merMod")) |
+ as.logical(vapply(dots, is, NA, "lm")) |
+ as.logical(vapply(dots, is, NA, "mixed"))
+ )
+ if (any(modp)) {
+ model.names <- c(deparse(mCall[["object"]]), vapply(which(modp), function(x) deparse(mCall[[x+2]]), ""))
+ for (i in which(as.logical(vapply(dots, is, NA, "mixed")))) dots[[i]] <- dots[[i]]$full.model
+ return(do.call(anova, args = c(object = object, dots, model.names = list(model.names), refit = refit)))
+ } else {
+ if(!isREML(object[["full.model"]]) && !isTRUE(check_likelihood(object)))
+ warning(paste("Following nested model(s) provide better fit than full model:", paste(check_likelihood(object), collapse = ", "), "\n It is highly recommended to try different optimizer via lmerControl or allFit!"))
+ get_mixed_warnings(object)
+ object$anova_table
+ }
+}
+
+
+
+
+## support for lsmeans for mixed objects:
+#' @importFrom lsmeans recover.data lsm.basis
+#' @method recover.data mixed
+#' @export
+recover.data.mixed <- function(object, ...) {
+ recover.data(object$full.model, ...)
+}
+
+
+#' @method lsm.basis mixed
+#' @export
+lsm.basis.mixed <- function(object, trms, xlev, grid, ...) {
+ lsm.basis(object$full.model, trms, xlev, grid, ...)
+}
+
+
+
+
+
+
+### old stuff (actually not usable right now)
+# is.mixed <- function(x) inherits(x, "mixed")
+
+## some code copied from pbkrtest.
+
+.restrictionMatrixBA<-function(B,A) {
+ ## <A> in <B>
+ ## determine L such that <A>={Bb| b in Lb=0}
+ d <- rankMatrix(cbind(A,B)) - rankMatrix(B)
+ if (d > 0) {
+ stop('Error: <A> not subspace of <B> \n')
+ }
+ Q <- qr.Q(qr(cbind(A,B)))
+ Q2 <- Q[,(rankMatrix(A)+1):rankMatrix(B)]
+ L <- t(Q2) %*% B
+ ##make rows of L2 orthogonal
+ L <-t(qr.Q(qr(t(L))))
+ L
+}
+
+.model2restrictionMatrix <- function (largeModel, smallModel) {
+ L <- if(is.matrix(smallModel)) {
+ ## ensures that L is of full row rank:
+ LL <- smallModel
+ q <- rankMatrix(LL)
+ if (q < nrow(LL) ){
+ t(qr.Q(qr(t(LL)))[,1:qr(LL)$rank])
+ } else {
+ smallModel
+ }
+ } else { #smallModel is mer model
+ .restrictionMatrixBA(getME(largeModel,'X'),getME(smallModel,'X'))
+ }
+ L<-.makeSparse(L)
+ L
+}
+
+.makeSparse<-function(X) {
+ X<-as.matrix(X)
+ w<-cbind(c(row(X)),c(col(X)),c(X))
+ w<-w[abs(w[,3])>1e-16,,drop=FALSE]
+ Y<-sparseMatrix(w[,1],w[,2],x=w[,3],dims=dim(X))
+}
diff --git a/R/nice.R b/R/nice.R
index 2365565..eeb2e1c 100644
--- a/R/nice.R
+++ b/R/nice.R
@@ -1,140 +1,146 @@
-#' Make nice ANOVA table for printing.
-#'
-#' This generic function produces a nice ANOVA table for printin for objects of class. \code{nice_anova} takes an object from \code{\link[car]{Anova}} possible created by the convenience functions \code{\link{aov_ez}} or \code{\link{aov_car}}. When within-subject factors are present, either sphericity corrected or uncorrected degrees of freedom can be reported.
-#'
-#'
-#' @param object An object of class \code{"Anova.mlm"} or \code{"anova"} as returned from \code{\link[car]{Anova}} or the \pkg{afex} ANOVA functions (see \code{\link{aov_car}}).
-#' @param es Effect Size to be reported. The default is given by \code{afex_options("es_aov")}, which is initially set to \code{"ges"} (i.e., reporting generalized eta-squared, see details). Also supported is partial eta-squared (\code{"pes"}) or \code{"none"}.
-#' @param observed character vector referring to the observed (i.e., non manipulated) variables/effects in the design. Important for calculation of generalized eta-squared (ignored if \code{es} is not \code{"ges"}), see details.
-#' @param correction Character. Which sphericity correction of the degrees of freedom should be reported for the within-subject factors. The default is given by \code{afex_options("correction_aov")}, which is initially set to \code{"GG"} corresponding to the Greenhouse-Geisser correction. Possible values are \code{"GG"}, \code{"HF"} (i.e., Hyunh-Feldt correction), and \code{"none"} (i.e., no correction).
-#' @param sig.symbols Character. What should be the symbols designating significance? When entering an vector with \code{length(sig.symbol) < 4} only those elements of the default (\code{c(" +", " *", " **", " ***")}) will be replaced. \code{sig.symbols = ""} will display the stars but not the \code{+}, \code{sig.symbols = rep("", 4)} will display no symbols.
-#' @param MSE logical. Should the column containing the Mean Sqaured Error (MSE) be displayed? Default is \code{TRUE}.
-#' @param intercept logical. Should intercept (if present) be included in the ANOVA table? Default is \code{FALSE} which hides the intercept.
-#' @param ... currently ignored.
-#'
-#' @return A \code{data.frame} with the ANOVA table consisting of characters. The columns that are always present are: \code{Effect}, \code{df} (degrees of freedom), \code{F}, and \code{p}.
-#'
-#' \code{ges} contains the generalized eta-squared effect size measure (Bakeman, 2005), \code{pes} contains partial eta-squared (if requested).
-#'
-#' @details The returned \code{data.frame} is print-ready when adding to a document with proper methods. I recommend \pkg{ascii} and \pkg{xtable}. \pkg{ascii} provides conversion to \href{http://www.methods.co.nz/asciidoc/}{AsciiDoc} but most notably to \href{http://orgmode.org/}{org-mode} (see \code{\link[ascii]{ascii}} and \code{\link[ascii]{print-ascii}}). \pkg{xtable} converts a \code{data.frame} into LaTeX code with many possible options (e.g., allowing for \code{"longtable"} or \co [...]
-#'
-#' Conversion functions to other formats (such as HTML, ODF, or Word) can be found at the \href{http://cran.r-project.org/web/views/ReproducibleResearch.html}{Reproducible Research Task View}.
-#'
-#' The default reports generalized eta squared (Olejnik & Algina, 2003), the "recommended effect size for repeated measured designs" (Bakeman, 2005). Note that it is important that all measured variables (as opposed to experimentally manipulated variables), such as e.g., age, gender, weight, ..., must be declared via \code{observed} to obtain the correct effect size estimate. Partial eta squared (\code{"pes"}) does not require this.
-#'
-#' @seealso \code{\link{aov_ez}} and \code{\link{aov_car}} are the convenience functions to create the object appropriate for \code{nice_anova}.
-#'
-#' @author The code for calculating generalized eta-squared was written by Mike Lawrence.\cr Everything else was written by Henrik Singmann.
-#'
-#' @references Bakeman, R. (2005). Recommended effect size statistics for repeated measures designs. \emph{Behavior Research Methods}, 37(3), 379-384. doi:10.3758/BF03192707
-
-#'
-#' Olejnik, S., & Algina, J. (2003). Generalized Eta and Omega Squared Statistics: Measures of Effect Size for Some Common Research Designs. \emph{Psychological Methods}, 8(4), 434-447. doi:10.1037/1082-989X.8.4.434
-#'
-#' @name nice
-#' @importFrom stats anova
-#' @export nice
-#'
-#' @encoding UTF-8
-#'
-#' @examples
-#'
-#' ## example from Olejnik & Algina (2003)
-#' # "Repeated Measures Design" (pp. 439):
-#' data(md_12.1)
-#' # create object of class afex_aov:
-#' rmd <- aov_ez("id", "rt", md_12.1, within = c("angle", "noise"))
-#' # use different es:
-#' nice(rmd, es = "pes") # noise: .82
-#' nice(rmd, es = "ges") # noise: .39
-#'
-#' # exampel using obk.long (see ?obk.long), a long version of the OBrienKaiser dataset from car.
-#' data(obk.long)
-#' # create object of class afex_aov:
-#' tmp.aov <- aov_car(value ~ treatment * gender + Error(id/phase*hour), data = obk.long)
-#'
-#' nice(tmp.aov, observed = "gender")
-#'
-#' nice(tmp.aov, observed = "gender", sig.symbol = rep("", 4))
-#'
-#' \dontrun{
-#' # use package ascii or xtable for formatting of tables ready for printing.
-#'
-#' full <- nice(tmp.aov, observed = "gender")
-#'
-#' require(ascii)
-#' print(ascii(full, include.rownames = FALSE, caption = "ANOVA 1"), type = "org")
-#'
-#' require(xtable)
-#' print.xtable(xtable(full, caption = "ANOVA 2"), include.rownames = FALSE)
-#' }
-#'
-#'
-nice <- function(object, ...) UseMethod("nice", object)
-
-
-#' @rdname nice
-#' @method nice afex_aov
-#' @export
-nice.afex_aov <- function(object, es = afex_options("es_aov"), observed = NULL, correction = afex_options("correction_aov"), MSE = TRUE, intercept = FALSE, sig.symbols = c(" +", " *", " **", " ***"), ...) {
- anova_table <- as.data.frame(anova(object, es = es, observed = observed, correction = correction, MSE = MSE, intercept = intercept))
- nice.anova(anova_table, MSE = MSE, intercept = intercept, sig.symbols = sig.symbols)
-}
-
-#' @rdname nice
-#' @method nice anova
-#' @export
-nice.anova <- function(object, MSE = TRUE, intercept = FALSE, sig.symbols = c(" +", " *", " **", " ***"), ...) {
- # internal functions:
- is.wholenumber <- function(x, tol = .Machine$double.eps^0.5) abs(x - round(x)) < tol
- make.fs <- function(anova, symbols) {
- ifelse(anova[["Pr(>F)"]] < 0.001, str_c(formatC(anova[["F"]], digits = 2, format = "f"), symbols[4]),
- ifelse(anova[["Pr(>F)"]] < 0.01, str_c(formatC(anova[["F"]], digits = 2, format = "f"), symbols[3]),
- ifelse(anova[["Pr(>F)"]] < 0.05, str_c(formatC(anova[["F"]], digits = 2, format = "f"), symbols[2]),
- ifelse(anova[["Pr(>F)"]] < 0.1, str_c(formatC(anova[["F"]], digits = 2, format = "f"), symbols[1]), formatC(anova[["F"]], digits = 2, format = "f")))))
- }
- anova_table <- object
- anova_table[,"df"] <- paste(ifelse(is.wholenumber(anova_table[,"num Df"]), anova_table[,"num Df"], formatC(anova_table[,"num Df"], digits = 2, format = "f")), ifelse(is.wholenumber(anova_table[,"den Df"]),anova_table[,"den Df"], formatC(anova_table[,"den Df"], digits = 2, format = "f")), sep = ", ")
- symbols.use <- c(" +", " *", " **", " ***")
- symbols.use[seq_along(sig.symbols)] <- sig.symbols
- df.out <- data.frame(Effect = row.names(anova_table), df = anova_table[,"df"], stringsAsFactors = FALSE)
- if (!is.null(anova_table$MSE)) df.out <- cbind(df.out, data.frame(MSE = formatC(anova_table[,"MSE"], digits = 2, format = "f"), stringsAsFactors = FALSE))
- df.out <- cbind(df.out, data.frame(F = make.fs(anova_table, symbols.use), stringsAsFactors = FALSE))
- if (!is.null(anova_table$ges)) df.out$ges <- round_ps(anova_table$ges)
- if (!is.null(anova_table$pes)) df.out$pes <- round_ps(anova_table$pes)
- df.out$p.value <- round_ps(anova_table[,"Pr(>F)"])
- if (!intercept) if (df.out[1,1] == "(Intercept)") df.out <- df.out[-1,, drop = FALSE]
- rownames(df.out) <- NULL
- df.out
-}
-
-make.stat <- function(anova, stat, symbols) {
- ifelse(anova[[paste0("Pr(>", stat,")")]] < 0.001, str_c(formatC(anova[[stat]], digits = 2, format = "f"), symbols[4]),
- ifelse(anova[[paste0("Pr(>", stat,")")]] < 0.01, str_c(formatC(anova[[stat]], digits = 2, format = "f"), symbols[3]),
- ifelse(anova[[paste0("Pr(>", stat,")")]] < 0.05, str_c(formatC(anova[[stat]], digits = 2, format = "f"), symbols[2]),
- ifelse(anova[[paste0("Pr(>", stat,")")]] < 0.1, str_c(formatC(anova[[stat]], digits = 2, format = "f"), symbols[1]), formatC(anova[[stat]], digits = 2, format = "f")))))
-}
-is.wholenumber <- function(x, tol = .Machine$double.eps^0.5) abs(x - round(x)) < tol
-
-
-#' @rdname nice
-#' @method nice mixed
-#' @export
-nice.mixed <- function(object, sig.symbols = c(" +", " *", " **", " ***"), ...) {
- anova_table <- object$anova_table
- symbols.use <- c(" +", " *", " **", " ***")
- symbols.use[seq_along(sig.symbols)] <- sig.symbols
- if (attr(object, "method") == "KR") {
- anova_table[,"df"] <- paste(ifelse(is.wholenumber(anova_table[,"num Df"]), round(anova_table[,"num Df"]), formatC(anova_table[,"num Df"], digits = 2, format = "f")), ifelse(is.wholenumber(anova_table[,"den Df"]), round(anova_table[,"den Df"]), formatC(anova_table[,"den Df"], digits = 2, format = "f")), sep = ", ")
- df.out <- data.frame(Effect = row.names(anova_table), df = anova_table[,"df"], "F.scaling" = formatC(anova_table[,"F.scaling"], digits = 2, format = "f"), stringsAsFactors = FALSE, check.names = FALSE)
- df.out <- cbind(df.out, data.frame(F = make.stat(anova_table, stat = "F", symbols.use), stringsAsFactors = FALSE))
- df.out$p.value <- round_ps(anova_table[,"Pr(>F)"])
- } else if (attr(object, "method") == "PB") {
- anova_table[,"Pr(>Chisq)"] <- anova_table[,"Pr(>PB)"]
- df.out <- data.frame(Effect = row.names(anova_table), df = anova_table[,"Chi Df"], Chisq = make.stat(anova_table, stat = "Chisq", symbols.use), p.value = round_ps(anova_table[,"Pr(>Chisq)"]), stringsAsFactors = FALSE, check.names = FALSE)
- } else if (attr(object, "method") == "LRT") {
- df.out <- data.frame(Effect = row.names(anova_table), df = anova_table[,"Chi Df"], Chisq = make.stat(anova_table, stat = "Chisq", symbols.use), p.value = round_ps(anova_table[,"Pr(>Chisq)"]), stringsAsFactors = FALSE, check.names = FALSE)
- } else stop("method of mixed object not supported.")
- rownames(df.out) <- NULL
- return(df.out)
-}
+#' Make nice ANOVA table for printing.
+#'
+#' This generic function produces a nice ANOVA table for printin for objects of class. \code{nice_anova} takes an object from \code{\link[car]{Anova}} possible created by the convenience functions \code{\link{aov_ez}} or \code{\link{aov_car}}. When within-subject factors are present, either sphericity corrected or uncorrected degrees of freedom can be reported.
+#'
+#'
+#' @param object An object of class \code{"Anova.mlm"} or \code{"anova"} as returned from \code{\link[car]{Anova}} or the \pkg{afex} ANOVA functions (see \code{\link{aov_car}}).
+#' @param es Effect Size to be reported. The default is given by \code{afex_options("es_aov")}, which is initially set to \code{"ges"} (i.e., reporting generalized eta-squared, see details). Also supported is partial eta-squared (\code{"pes"}) or \code{"none"}.
+#' @param observed character vector referring to the observed (i.e., non manipulated) variables/effects in the design. Important for calculation of generalized eta-squared (ignored if \code{es} is not \code{"ges"}), see details.
+#' @param correction Character. Which sphericity correction of the degrees of freedom should be reported for the within-subject factors. The default is given by \code{afex_options("correction_aov")}, which is initially set to \code{"GG"} corresponding to the Greenhouse-Geisser correction. Possible values are \code{"GG"}, \code{"HF"} (i.e., Hyunh-Feldt correction), and \code{"none"} (i.e., no correction).
+#' @param p.adjust.method \code{character} indicating if p-values for individual effects should be adjusted for multiple comparisons (see \link[stats]{p.adjust} and details). The default \code{NULL} corresponds to no adjustment.
+#' @param sig.symbols Character. What should be the symbols designating significance? When entering an vector with \code{length(sig.symbol) < 4} only those elements of the default (\code{c(" +", " *", " **", " ***")}) will be replaced. \code{sig.symbols = ""} will display the stars but not the \code{+}, \code{sig.symbols = rep("", 4)} will display no symbols.
+#' @param MSE logical. Should the column containing the Mean Sqaured Error (MSE) be displayed? Default is \code{TRUE}.
+#' @param intercept logical. Should intercept (if present) be included in the ANOVA table? Default is \code{FALSE} which hides the intercept.
+#' @param ... currently ignored.
+#'
+#' @return A \code{data.frame} with the ANOVA table consisting of characters. The columns that are always present are: \code{Effect}, \code{df} (degrees of freedom), \code{F}, and \code{p}.
+#'
+#' \code{ges} contains the generalized eta-squared effect size measure (Bakeman, 2005), \code{pes} contains partial eta-squared (if requested).
+#'
+#' @details The returned \code{data.frame} is print-ready when adding to a document with proper methods. Either directly via \pkg{knitr} or similar approaches such as via packages \pkg{ascii} or \pkg{xtable} (nowadays \pkg{knitr} is probably the best approach, see \href{http://yihui.name/knitr/}{here}). \pkg{ascii} provides conversion to \href{http://www.methods.co.nz/asciidoc/}{AsciiDoc} and \href{http://orgmode.org/}{org-mode} (see \code{\link[ascii]{ascii}} and \code{\link[ascii]{prin [...]
+#'
+#' Conversion functions to other formats (such as HTML, ODF, or Word) can be found at the \href{http://cran.r-project.org/web/views/ReproducibleResearch.html}{Reproducible Research Task View}.
+#'
+#' The default reports generalized eta squared (Olejnik & Algina, 2003), the "recommended effect size for repeated measured designs" (Bakeman, 2005). Note that it is important that all measured variables (as opposed to experimentally manipulated variables), such as e.g., age, gender, weight, ..., must be declared via \code{observed} to obtain the correct effect size estimate. Partial eta squared (\code{"pes"}) does not require this.
+#'
+#' Exploratory ANOVA, for which no detailed hypotheses have been specified a priori, harbor a multiple comparison problem (Cramer et al., 2015). To avoid an inflation of familywise Type I error rate, results need to be corrected for multiple comparisons using \code{p.adjust.method}.
+#' \code{p.adjust.method} defaults to the method specified in the call to \code{\link{aov_car}} in \code{anova_table}. If no method was specified and \code{p.adjust.method = NULL} p-values are not adjusted.
+#'
+#' @seealso \code{\link{aov_ez}} and \code{\link{aov_car}} are the convenience functions to create the object appropriate for \code{nice_anova}.
+#'
+#' @author The code for calculating generalized eta-squared was written by Mike Lawrence.\cr Everything else was written by Henrik Singmann.
+#'
+#' @references Bakeman, R. (2005). Recommended effect size statistics for repeated measures designs. \emph{Behavior Research Methods}, 37(3), 379-384. doi:10.3758/BF03192707
+#'
+#' Cramer, A. O. J., van Ravenzwaaij, D., Matzke, D., Steingroever, H., Wetzels, R., Grasman, R. P. P. P., ... Wagenmakers, E.-J. (2015). Hidden multiplicity in exploratory multiway ANOVA: Prevalence and remedies. \emph{Psychonomic Bulletin & Review}, 1–8. doi:\href{http://doi.org/10.3758/s13423-015-0913-5}{10.3758/s13423-015-0913-5}
+#'
+#' Olejnik, S., & Algina, J. (2003). Generalized Eta and Omega Squared Statistics: Measures of Effect Size for Some Common Research Designs. \emph{Psychological Methods}, 8(4), 434-447. doi:10.1037/1082-989X.8.4.434
+#'
+#' @name nice
+#' @importFrom stats anova
+#' @export nice
+#'
+#' @encoding UTF-8
+#'
+#' @examples
+#'
+#' ## example from Olejnik & Algina (2003)
+#' # "Repeated Measures Design" (pp. 439):
+#' data(md_12.1)
+#' # create object of class afex_aov:
+#' rmd <- aov_ez("id", "rt", md_12.1, within = c("angle", "noise"))
+#' # use different es:
+#' nice(rmd, es = "pes") # noise: .82
+#' nice(rmd, es = "ges") # noise: .39
+#'
+#' # exampel using obk.long (see ?obk.long), a long version of the OBrienKaiser dataset from car.
+#' data(obk.long)
+#' # create object of class afex_aov:
+#' tmp.aov <- aov_car(value ~ treatment * gender + Error(id/phase*hour), data = obk.long)
+#'
+#' nice(tmp.aov, observed = "gender")
+#'
+#' nice(tmp.aov, observed = "gender", sig.symbol = rep("", 4))
+#'
+#' \dontrun{
+#' # use package ascii or xtable for formatting of tables ready for printing.
+#'
+#' full <- nice(tmp.aov, observed = "gender")
+#'
+#' require(ascii)
+#' print(ascii(full, include.rownames = FALSE, caption = "ANOVA 1"), type = "org")
+#'
+#' require(xtable)
+#' print.xtable(xtable(full, caption = "ANOVA 2"), include.rownames = FALSE)
+#' }
+#'
+#'
+nice <- function(object, ...) UseMethod("nice", object)
+
+
+#' @rdname nice
+#' @method nice afex_aov
+#' @export
+nice.afex_aov <- function(object, es = afex_options("es_aov"), observed = NULL, correction = afex_options("correction_aov"), MSE = TRUE, intercept = FALSE, sig.symbols = c(" +", " *", " **", " ***"), p.adjust.method = NULL, ...) {
+ if(is.null(p.adjust.method)) p.adjust.method <- ifelse(is.null(attr(object$anova_table, "p.adjust.method")), "none", attr(object$anova_table, "p.adjust.method"))
+ anova_table <- as.data.frame(anova(object, es = es, observed = observed, correction = correction, MSE = MSE, intercept = intercept, p.adjust.method = p.adjust.method))
+ nice.anova(anova_table, MSE = MSE, intercept = intercept, sig.symbols = sig.symbols)
+}
+
+#' @rdname nice
+#' @method nice anova
+#' @export
+nice.anova <- function(object, MSE = TRUE, intercept = FALSE, sig.symbols = c(" +", " *", " **", " ***"), ...) {
+ # internal functions:
+ is.wholenumber <- function(x, tol = .Machine$double.eps^0.5) abs(x - round(x)) < tol
+ make.fs <- function(anova, symbols) {
+ ifelse(anova[["Pr(>F)"]] < 0.001, str_c(formatC(anova[["F"]], digits = 2, format = "f"), symbols[4]),
+ ifelse(anova[["Pr(>F)"]] < 0.01, str_c(formatC(anova[["F"]], digits = 2, format = "f"), symbols[3]),
+ ifelse(anova[["Pr(>F)"]] < 0.05, str_c(formatC(anova[["F"]], digits = 2, format = "f"), symbols[2]),
+ ifelse(anova[["Pr(>F)"]] < 0.1, str_c(formatC(anova[["F"]], digits = 2, format = "f"), symbols[1]), formatC(anova[["F"]], digits = 2, format = "f")))))
+ }
+ anova_table <- object
+ anova_table[,"df"] <- paste(ifelse(is.wholenumber(anova_table[,"num Df"]), anova_table[,"num Df"], formatC(anova_table[,"num Df"], digits = 2, format = "f")), ifelse(is.wholenumber(anova_table[,"den Df"]),anova_table[,"den Df"], formatC(anova_table[,"den Df"], digits = 2, format = "f")), sep = ", ")
+ symbols.use <- c(" +", " *", " **", " ***")
+ symbols.use[seq_along(sig.symbols)] <- sig.symbols
+ df.out <- data.frame(Effect = row.names(anova_table), df = anova_table[,"df"], stringsAsFactors = FALSE)
+ if (!is.null(anova_table$MSE)) df.out <- cbind(df.out, data.frame(MSE = formatC(anova_table[,"MSE"], digits = 2, format = "f"), stringsAsFactors = FALSE))
+ df.out <- cbind(df.out, data.frame(F = make.fs(anova_table, symbols.use), stringsAsFactors = FALSE))
+ if (!is.null(anova_table$ges)) df.out$ges <- round_ps(anova_table$ges)
+ if (!is.null(anova_table$pes)) df.out$pes <- round_ps(anova_table$pes)
+ df.out$p.value <- round_ps(anova_table[,"Pr(>F)"])
+ if (!intercept) if (df.out[1,1] == "(Intercept)") df.out <- df.out[-1,, drop = FALSE]
+ rownames(df.out) <- NULL
+ df.out
+}
+
+make.stat <- function(anova, stat, symbols) {
+ ifelse(anova[[paste0("Pr(>", stat,")")]] < 0.001, str_c(formatC(anova[[stat]], digits = 2, format = "f"), symbols[4]),
+ ifelse(anova[[paste0("Pr(>", stat,")")]] < 0.01, str_c(formatC(anova[[stat]], digits = 2, format = "f"), symbols[3]),
+ ifelse(anova[[paste0("Pr(>", stat,")")]] < 0.05, str_c(formatC(anova[[stat]], digits = 2, format = "f"), symbols[2]),
+ ifelse(anova[[paste0("Pr(>", stat,")")]] < 0.1, str_c(formatC(anova[[stat]], digits = 2, format = "f"), symbols[1]), formatC(anova[[stat]], digits = 2, format = "f")))))
+}
+is.wholenumber <- function(x, tol = .Machine$double.eps^0.5) abs(x - round(x)) < tol
+
+
+#' @rdname nice
+#' @method nice mixed
+#' @export
+nice.mixed <- function(object, sig.symbols = c(" +", " *", " **", " ***"), ...) {
+ anova_table <- object$anova_table
+ symbols.use <- c(" +", " *", " **", " ***")
+ symbols.use[seq_along(sig.symbols)] <- sig.symbols
+ if (attr(object, "method") == "KR") {
+ anova_table[,"df"] <- paste(ifelse(is.wholenumber(anova_table[,"num Df"]), round(anova_table[,"num Df"]), formatC(anova_table[,"num Df"], digits = 2, format = "f")), ifelse(is.wholenumber(anova_table[,"den Df"]), round(anova_table[,"den Df"]), formatC(anova_table[,"den Df"], digits = 2, format = "f")), sep = ", ")
+ df.out <- data.frame(Effect = row.names(anova_table), df = anova_table[,"df"], "F.scaling" = formatC(anova_table[,"F.scaling"], digits = 2, format = "f"), stringsAsFactors = FALSE, check.names = FALSE)
+ df.out <- cbind(df.out, data.frame(F = make.stat(anova_table, stat = "F", symbols.use), stringsAsFactors = FALSE))
+ df.out$p.value <- round_ps(anova_table[,"Pr(>F)"])
+ } else if (attr(object, "method") == "PB") {
+ anova_table[,"Pr(>Chisq)"] <- anova_table[,"Pr(>PB)"]
+ df.out <- data.frame(Effect = row.names(anova_table), df = anova_table[,"Chi Df"], Chisq = make.stat(anova_table, stat = "Chisq", symbols.use), p.value = round_ps(anova_table[,"Pr(>Chisq)"]), stringsAsFactors = FALSE, check.names = FALSE)
+ } else if (attr(object, "method") == "LRT") {
+ df.out <- data.frame(Effect = row.names(anova_table), df = anova_table[,"Chi Df"], Chisq = make.stat(anova_table, stat = "Chisq", symbols.use), p.value = round_ps(anova_table[,"Pr(>Chisq)"]), stringsAsFactors = FALSE, check.names = FALSE)
+ } else stop("method of mixed object not supported.")
+ rownames(df.out) <- NULL
+ return(df.out)
+}
diff --git a/R/obk.long-data.R b/R/obk.long-data.R
index 9db1e4c..883c2f0 100644
--- a/R/obk.long-data.R
+++ b/R/obk.long-data.R
@@ -1,46 +1,46 @@
-#' O'Brien Kaiser's Repeated-Measures Dataset with Covariate
-#'
-#' This is the long version of the \code{OBrienKaiser} dataset from the \pkg{car} pakage adding a random covariate \code{age}. Originally the dataset ist taken from O'Brien and Kaiser (1985). The description from \code{\link[car]{OBrienKaiser}} says: "These contrived repeated-measures data are taken from O'Brien and Kaiser (1985). The data are from an imaginary study in which 16 female and male subjects, who are divided into three treatments, are measured at a pretest, postest, and a fol [...]
-#'
-#' @docType data
-#' @keywords dataset
-#' @name obk.long
-#' @usage obk.long
-#' @format A data frame with 240 rows and 7 variables.
-#' @source O'Brien, R. G., & Kaiser, M. K. (1985). MANOVA method for analyzing repeated measures designs: An extensive primer. \emph{Psychological Bulletin}, 97, 316-333. doi:10.1037/0033-2909.97.2.316
-#'
-#' @encoding UTF-8
-#'
-#' @examples
-#' # The dataset is constructed as follows:
-#' data("OBrienKaiser", package = "car")
-#' set.seed(1)
-#' OBrienKaiser2 <- within(OBrienKaiser, {
-#' id <- factor(1:nrow(OBrienKaiser))
-#' age <- scale(sample(18:35, nrow(OBrienKaiser), replace = TRUE), scale = FALSE)})
-#' attributes(OBrienKaiser2$age) <- NULL # needed or resahpe2::melt throws an error.
-#' OBrienKaiser2$age <- as.numeric(OBrienKaiser2$age)
-#' obk.long <- reshape2::melt(OBrienKaiser2, id.vars = c("id", "treatment", "gender", "age"))
-#' obk.long[,c("phase", "hour")] <- lapply(as.data.frame(do.call(rbind,
-#' strsplit(as.character(obk.long$variable), "\\."),)), factor)
-#' obk.long <- obk.long[,c("id", "treatment", "gender", "age", "phase", "hour", "value")]
-#' obk.long <- obk.long[order(obk.long$id),]
-#' rownames(obk.long) <- NULL
-#' str(obk.long)
-#' ## 'data.frame': 240 obs. of 7 variables:
-#' ## $ id : Factor w/ 16 levels "1","2","3","4",..: 1 1 1 1 1 1 1 1 1 1 ...
-#' ## $ treatment: Factor w/ 3 levels "control","A",..: 1 1 1 1 1 1 1 1 1 1 ...
-#' ## $ gender : Factor w/ 2 levels "F","M": 2 2 2 2 2 2 2 2 2 2 ...
-#' ## $ age : num -4.75 -4.75 -4.75 -4.75 -4.75 -4.75 -4.75 -4.75 -4.75 -4.75 ...
-#' ## $ phase : Factor w/ 3 levels "fup","post","pre": 3 3 3 3 3 2 2 2 2 2 ...
-#' ## $ hour : Factor w/ 5 levels "1","2","3","4",..: 1 2 3 4 5 1 2 3 4 5 ...
-#' ## $ value : num 1 2 4 2 1 3 2 5 3 2 ...
-#' head(obk.long)
-#' ## id treatment gender age phase hour value
-#' ## 1 1 control M -4.75 pre 1 1
-#' ## 2 1 control M -4.75 pre 2 2
-#' ## 3 1 control M -4.75 pre 3 4
-#' ## 4 1 control M -4.75 pre 4 2
-#' ## 5 1 control M -4.75 pre 5 1
-#' ## 6 1 control M -4.75 post 1 3
-NULL
+#' O'Brien Kaiser's Repeated-Measures Dataset with Covariate
+#'
+#' This is the long version of the \code{OBrienKaiser} dataset from the \pkg{car} pakage adding a random covariate \code{age}. Originally the dataset ist taken from O'Brien and Kaiser (1985). The description from \code{\link[car]{OBrienKaiser}} says: "These contrived repeated-measures data are taken from O'Brien and Kaiser (1985). The data are from an imaginary study in which 16 female and male subjects, who are divided into three treatments, are measured at a pretest, postest, and a fol [...]
+#'
+#' @docType data
+#' @keywords dataset
+#' @name obk.long
+#' @usage obk.long
+#' @format A data frame with 240 rows and 7 variables.
+#' @source O'Brien, R. G., & Kaiser, M. K. (1985). MANOVA method for analyzing repeated measures designs: An extensive primer. \emph{Psychological Bulletin}, 97, 316-333. doi:10.1037/0033-2909.97.2.316
+#'
+#' @encoding UTF-8
+#'
+#' @examples
+#' # The dataset is constructed as follows:
+#' data("OBrienKaiser", package = "car")
+#' set.seed(1)
+#' OBrienKaiser2 <- within(OBrienKaiser, {
+#' id <- factor(1:nrow(OBrienKaiser))
+#' age <- scale(sample(18:35, nrow(OBrienKaiser), replace = TRUE), scale = FALSE)})
+#' attributes(OBrienKaiser2$age) <- NULL # needed or resahpe2::melt throws an error.
+#' OBrienKaiser2$age <- as.numeric(OBrienKaiser2$age)
+#' obk.long <- reshape2::melt(OBrienKaiser2, id.vars = c("id", "treatment", "gender", "age"))
+#' obk.long[,c("phase", "hour")] <- lapply(as.data.frame(do.call(rbind,
+#' strsplit(as.character(obk.long$variable), "\\."),)), factor)
+#' obk.long <- obk.long[,c("id", "treatment", "gender", "age", "phase", "hour", "value")]
+#' obk.long <- obk.long[order(obk.long$id),]
+#' rownames(obk.long) <- NULL
+#' str(obk.long)
+#' ## 'data.frame': 240 obs. of 7 variables:
+#' ## $ id : Factor w/ 16 levels "1","2","3","4",..: 1 1 1 1 1 1 1 1 1 1 ...
+#' ## $ treatment: Factor w/ 3 levels "control","A",..: 1 1 1 1 1 1 1 1 1 1 ...
+#' ## $ gender : Factor w/ 2 levels "F","M": 2 2 2 2 2 2 2 2 2 2 ...
+#' ## $ age : num -4.75 -4.75 -4.75 -4.75 -4.75 -4.75 -4.75 -4.75 -4.75 -4.75 ...
+#' ## $ phase : Factor w/ 3 levels "fup","post","pre": 3 3 3 3 3 2 2 2 2 2 ...
+#' ## $ hour : Factor w/ 5 levels "1","2","3","4",..: 1 2 3 4 5 1 2 3 4 5 ...
+#' ## $ value : num 1 2 4 2 1 3 2 5 3 2 ...
+#' head(obk.long)
+#' ## id treatment gender age phase hour value
+#' ## 1 1 control M -4.75 pre 1 1
+#' ## 2 1 control M -4.75 pre 2 2
+#' ## 3 1 control M -4.75 pre 3 4
+#' ## 4 1 control M -4.75 pre 4 2
+#' ## 5 1 control M -4.75 pre 5 1
+#' ## 6 1 control M -4.75 post 1 3
+NULL
diff --git a/R/round_ps.R b/R/round_ps.R
index 5e1dcda..0e1b39f 100644
--- a/R/round_ps.R
+++ b/R/round_ps.R
@@ -1,28 +1,28 @@
-#' Helper function which rounds p-values
-#'
-#' p-values are rounded in a sane way: .99 - .01 to two digits, < .01 to three digits, < .001 to four digits.
-#'
-#' @usage round_ps(x)
-#'
-#' @param x a numeric vector
-#'
-#' @return A character vector with the same length of x.
-#'
-#' @author Henrik Singmann
-#'
-#' @encoding UTF-8
-#'
-#' @export round_ps
-#' @examples
-#' round_ps(runif(10))
-#'
-#' round_ps(runif(10, 0, .01))
-#'
-#' round_ps(runif(10, 0, .001))
-#'
-#' round_ps(0.0000000099)
-#'
-
-round_ps <- function(x) {
- substr(as.character(ifelse(x < 0.0001, " <.0001", ifelse(x < 0.001, formatC(x, digits = 4, format = "f"), ifelse(x < 0.01, formatC(x, digits = 3, format = "f"), ifelse(round(x, 2) == 1, " >.99", formatC(x, digits = 2, format = "f")))))), 2, 7)
-}
+#' Helper function which rounds p-values
+#'
+#' p-values are rounded in a sane way: .99 - .01 to two digits, < .01 to three digits, < .001 to four digits.
+#'
+#' @usage round_ps(x)
+#'
+#' @param x a numeric vector
+#'
+#' @return A character vector with the same length of x.
+#'
+#' @author Henrik Singmann
+#'
+#' @encoding UTF-8
+#'
+#' @export round_ps
+#' @examples
+#' round_ps(runif(10))
+#'
+#' round_ps(runif(10, 0, .01))
+#'
+#' round_ps(runif(10, 0, .001))
+#'
+#' round_ps(0.0000000099)
+#'
+
+round_ps <- function(x) {
+ substr(as.character(ifelse(x < 0.0001, " <.0001", ifelse(x < 0.001, formatC(x, digits = 4, format = "f"), ifelse(x < 0.01, formatC(x, digits = 3, format = "f"), ifelse(round(x, 2) == 1, " >.99", formatC(x, digits = 2, format = "f")))))), 2, 7)
+}
diff --git a/R/set_contrasts.R b/R/set_contrasts.R
index fe18cf5..71ca845 100644
--- a/R/set_contrasts.R
+++ b/R/set_contrasts.R
@@ -1,45 +1,45 @@
-#' Set global contrasts
-#'
-#' These functions are simple wrappers to set contrasts globally via \code{options(contrasts = ...)}.
-#'
-#' @usage set_sum_contrasts()
-#'
-#' set_deviation_contrasts()
-#'
-#' set_effects_contrasts()
-#'
-#' set_default_contrasts()
-#'
-#' set_treatment_contrasts()
-#'
-#'
-#' @details \code{set_deviation_contrasts} and \code{set_effects_contrasts} are wrappers for \code{set_sum_contrasts}. Likewise, \code{set_default_contrasts} is a wrapper to \code{set_treatment_contrasts()}.
-#'
-#' @return nothing. These functions are called for their side effects to change the global options.
-#'
-#' @name set_sum_contrasts
-#' @aliases set_sum_contrasts set_deviation_contrasts set_effects_contrasts set_treatment_contrasts set_default_contrasts
-#' @export set_sum_contrasts set_deviation_contrasts set_effects_contrasts set_treatment_contrasts set_default_contrasts
-#'
-
-set_sum_contrasts <- function() {
- message("setting contr.sum globally: options(contrasts=c('contr.sum', 'contr.poly'))")
- options(contrasts=c('contr.sum', 'contr.poly'))
-}
-
-set_deviation_contrasts <- function() {
- set_sum_contrasts()
-}
-
-set_effects_contrasts <- function() {
- set_sum_contrasts()
-}
-
-set_treatment_contrasts <- function() {
- message("setting contr.treatment globally: options(contrasts=c('contr.treatment', 'contr.poly'))")
- options(contrasts=c('contr.treatment', 'contr.poly'))
-}
-
-set_default_contrasts <- function() {
- set_treatment_contrasts()
-}
+#' Set global contrasts
+#'
+#' These functions are simple wrappers to set contrasts globally via \code{options(contrasts = ...)}.
+#'
+#' @usage set_sum_contrasts()
+#'
+#' set_deviation_contrasts()
+#'
+#' set_effects_contrasts()
+#'
+#' set_default_contrasts()
+#'
+#' set_treatment_contrasts()
+#'
+#'
+#' @details \code{set_deviation_contrasts} and \code{set_effects_contrasts} are wrappers for \code{set_sum_contrasts}. Likewise, \code{set_default_contrasts} is a wrapper to \code{set_treatment_contrasts()}.
+#'
+#' @return nothing. These functions are called for their side effects to change the global options.
+#'
+#' @name set_sum_contrasts
+#' @aliases set_sum_contrasts set_deviation_contrasts set_effects_contrasts set_treatment_contrasts set_default_contrasts
+#' @export set_sum_contrasts set_deviation_contrasts set_effects_contrasts set_treatment_contrasts set_default_contrasts
+#'
+
+set_sum_contrasts <- function() {
+ message("setting contr.sum globally: options(contrasts=c('contr.sum', 'contr.poly'))")
+ options(contrasts=c('contr.sum', 'contr.poly'))
+}
+
+set_deviation_contrasts <- function() {
+ set_sum_contrasts()
+}
+
+set_effects_contrasts <- function() {
+ set_sum_contrasts()
+}
+
+set_treatment_contrasts <- function() {
+ message("setting contr.treatment globally: options(contrasts=c('contr.treatment', 'contr.poly'))")
+ options(contrasts=c('contr.treatment', 'contr.poly'))
+}
+
+set_default_contrasts <- function() {
+ set_treatment_contrasts()
+}
diff --git a/R/sk2011.1-data.R b/R/sk2011.1-data.R
index 340e5ec..8c6a759 100644
--- a/R/sk2011.1-data.R
+++ b/R/sk2011.1-data.R
@@ -1,45 +1,45 @@
-#' Data from Singmann & Klauer (2011, Experiment 1)
-#'
-#' Singmann and Klauer (2011) were interested in whether or not conditional reasoning can be explained by a single process or whether multiple processes are necessary to explain it. To provide evidence for multiple processes we aimed to establish a double dissociation of two variables: instruction type and problem type. Instruction type was manipulated between-subjects, one group of participants received deductive instructions (i.e., to treat the premises as given and only draw necessar [...]
-#'
-#' If a person is wet, then the person fell into a swimming pool. \cr
-#' A person fell into a swimming pool. \cr
-#' How valid is the conclusion/How likely is it that the person is wet?
-#'
-#' For those problems we predicted that under deductive instructions responses should be lower (as the conclusion does not necessarily follow from the premises) as under probabilistic instructions. For the valid but implausible problem, an example is presented next, we predicted the opposite pattern:
-#'
-#' If a person is wet, then the person fell into a swimming pool. \cr
-#' A person is wet. \cr
-#' How valid is the conclusion/How likely is it that the person fell into a swimming pool?
-#'
-#' Our study also included valid and plausible and invalid and implausible problems.
-#'
-#' Note that the factor `plausibility` is not present in the original manuscript, there it is a results of a combination of other factors.
-#'
-#'
-#' @docType data
-#' @keywords dataset
-#' @name sk2011.1
-#' @usage sk2011.1
-#' @format A data.frame with 640 rows and 9 variables.
-#' @source Singmann, H., & Klauer, K. C. (2011). Deductive and inductive conditional inferences: Two modes of reasoning. Thinking & Reasoning, 17(3), 247-281. doi:10.1080/13546783.2011.572718
-
-#'
-#' @encoding UTF-8
-#'
-#' @examples
-#' data(sk2011.1)
-#'
-#' # Table 1 (p. 264):
-#' aov_ez("id", "response", sk2011.1[ sk2011.1$what == "affirmation",],
-#' within = c("inference", "type"), between = "instruction",
-#' args.return=(es = "pes"))
-#' aov_ez("id", "response", sk2011.1[ sk2011.1$what == "denial",],
-#' within = c("inference", "type"), between = "instruction",
-#' args.return=(es = "pes"))
-#'
-#'
-NULL
-
-
-
+#' Data from Singmann & Klauer (2011, Experiment 1)
+#'
+#' Singmann and Klauer (2011) were interested in whether or not conditional reasoning can be explained by a single process or whether multiple processes are necessary to explain it. To provide evidence for multiple processes we aimed to establish a double dissociation of two variables: instruction type and problem type. Instruction type was manipulated between-subjects, one group of participants received deductive instructions (i.e., to treat the premises as given and only draw necessar [...]
+#'
+#' If a person is wet, then the person fell into a swimming pool. \cr
+#' A person fell into a swimming pool. \cr
+#' How valid is the conclusion/How likely is it that the person is wet?
+#'
+#' For those problems we predicted that under deductive instructions responses should be lower (as the conclusion does not necessarily follow from the premises) as under probabilistic instructions. For the valid but implausible problem, an example is presented next, we predicted the opposite pattern:
+#'
+#' If a person is wet, then the person fell into a swimming pool. \cr
+#' A person is wet. \cr
+#' How valid is the conclusion/How likely is it that the person fell into a swimming pool?
+#'
+#' Our study also included valid and plausible and invalid and implausible problems.
+#'
+#' Note that the factor `plausibility` is not present in the original manuscript, there it is a results of a combination of other factors.
+#'
+#'
+#' @docType data
+#' @keywords dataset
+#' @name sk2011.1
+#' @usage sk2011.1
+#' @format A data.frame with 640 rows and 9 variables.
+#' @source Singmann, H., & Klauer, K. C. (2011). Deductive and inductive conditional inferences: Two modes of reasoning. Thinking & Reasoning, 17(3), 247-281. doi:10.1080/13546783.2011.572718
+
+#'
+#' @encoding UTF-8
+#'
+#' @examples
+#' data(sk2011.1)
+#'
+#' # Table 1 (p. 264):
+#' aov_ez("id", "response", sk2011.1[ sk2011.1$what == "affirmation",],
+#' within = c("inference", "type"), between = "instruction",
+#' args.return=(es = "pes"))
+#' aov_ez("id", "response", sk2011.1[ sk2011.1$what == "denial",],
+#' within = c("inference", "type"), between = "instruction",
+#' args.return=(es = "pes"))
+#'
+#'
+NULL
+
+
+
diff --git a/R/sk2011.2-data.R b/R/sk2011.2-data.R
index f0a881d..f781a0d 100644
--- a/R/sk2011.2-data.R
+++ b/R/sk2011.2-data.R
@@ -1,32 +1,32 @@
-#' Data from Singmann & Klauer (2011, Experiment 2)
-#'
-#' Singmann and Klauer (2011) were interested in whether or not conditional reasoning can be explained by a single process or whether multiple processes are necessary to explain it. To provide evidence for multiple processes we aimed to establish a double dissociation of two variables: instruction type and problem type. Instruction type was manipulated between-subjects, one group of participants received deductive instructions (i.e., to treat the premises as given and only draw necessar [...]
-#'
-#' This data set contains 63 participants in contrast to the originally reported 56 participants. The additional participants were not included in the original studies as they did not meet the inclusion criteria (i.e., no students, prior education in logic, or participated in a similar experiment). The IDs of those additional participants are: 7, 8, 9, 12, 17, 24, 30. The excluded participant reported in the paper has ID 16.
-#'
-#' content has the following levels (C = content/conditional):\cr
-#' 1 = Wenn eine Person in ein Schwimmbecken gefallen ist, dann ist sie nass.\cr
-#' 2 = Wenn ein Hund Flöhe hat, dann kratzt er sich hin und wieder.\cr
-#' 3 = Wenn eine Seifenblase mit einer Nadel gestochen wurde, dann platzt sie.\cr
-#' 4 = Wenn ein Mädchen Geschlechtsverkehr vollzogen hat, dann ist es schwanger.\cr
-#' 5 = Wenn eine Pflanze ausreichend gegossen wird, dann bleibt sie grün.\cr
-#' 6 = Wenn sich eine Person die Zähne putzt, dann bekommt sie KEIN Karies.\cr
-#' 7 = Wenn eine Person viel Cola trinkt, dann nimmt sie an Gewicht zu.\cr
-#' 8 = Wenn eine Person die Klimaanlage angeschaltet hat, dann fröstelt sie.\cr
-#' 9 = Wenn eine Person viel lernt, dann wird sie in der Klausur eine gute Note erhalten.
-#'
-#' @docType data
-#' @keywords dataset
-#' @name sk2011.2
-#' @usage sk2011.2
-#' @format A data.frame with 2268 rows and 9 variables.
-#' @source Singmann, H., & Klauer, K. C. (2011). Deductive and inductive conditional inferences: Two modes of reasoning. Thinking & Reasoning, 17(3), 247-281. doi:10.1080/13546783.2011.572718
-
-#'
-#' @encoding UTF-8
-#'
-#' @example examples/examples.sk2011.2.R
-NULL
-
-
-
+#' Data from Singmann & Klauer (2011, Experiment 2)
+#'
+#' Singmann and Klauer (2011) were interested in whether or not conditional reasoning can be explained by a single process or whether multiple processes are necessary to explain it. To provide evidence for multiple processes we aimed to establish a double dissociation of two variables: instruction type and problem type. Instruction type was manipulated between-subjects, one group of participants received deductive instructions (i.e., to treat the premises as given and only draw necessar [...]
+#'
+#' This data set contains 63 participants in contrast to the originally reported 56 participants. The additional participants were not included in the original studies as they did not meet the inclusion criteria (i.e., no students, prior education in logic, or participated in a similar experiment). The IDs of those additional participants are: 7, 8, 9, 12, 17, 24, 30. The excluded participant reported in the paper has ID 16.
+#'
+#' content has the following levels (C = content/conditional):\cr
+#' 1 = Wenn eine Person in ein Schwimmbecken gefallen ist, dann ist sie nass.\cr
+#' 2 = Wenn ein Hund Flöhe hat, dann kratzt er sich hin und wieder.\cr
+#' 3 = Wenn eine Seifenblase mit einer Nadel gestochen wurde, dann platzt sie.\cr
+#' 4 = Wenn ein Mädchen Geschlechtsverkehr vollzogen hat, dann ist es schwanger.\cr
+#' 5 = Wenn eine Pflanze ausreichend gegossen wird, dann bleibt sie grün.\cr
+#' 6 = Wenn sich eine Person die Zähne putzt, dann bekommt sie KEIN Karies.\cr
+#' 7 = Wenn eine Person viel Cola trinkt, dann nimmt sie an Gewicht zu.\cr
+#' 8 = Wenn eine Person die Klimaanlage angeschaltet hat, dann fröstelt sie.\cr
+#' 9 = Wenn eine Person viel lernt, dann wird sie in der Klausur eine gute Note erhalten.
+#'
+#' @docType data
+#' @keywords dataset
+#' @name sk2011.2
+#' @usage sk2011.2
+#' @format A data.frame with 2268 rows and 9 variables.
+#' @source Singmann, H., & Klauer, K. C. (2011). Deductive and inductive conditional inferences: Two modes of reasoning. Thinking & Reasoning, 17(3), 247-281. doi:10.1080/13546783.2011.572718
+
+#'
+#' @encoding UTF-8
+#'
+#' @example examples/examples.sk2011.2.R
+NULL
+
+
+
diff --git a/inst/doc/anova_posthoc.R b/inst/doc/anova_posthoc.R
index 283e0e4..840c4f7 100644
--- a/inst/doc/anova_posthoc.R
+++ b/inst/doc/anova_posthoc.R
@@ -23,7 +23,7 @@ a1 # the default print method prints a data.frame produced by nice
knitr::kable(nice(a1))
## ---- results='asis'--------------------------------------------------------------------
-print(xtable::xtable(a1$anova_table, digits = c(rep(2, 5), 3, 4)), type = "html")
+print(xtable::xtable(anova(a1), digits = c(rep(2, 5), 3, 4)), type = "html")
## ---------------------------------------------------------------------------------------
m1 <- lsmeans(a1, ~ inference)
diff --git a/inst/doc/anova_posthoc.Rmd b/inst/doc/anova_posthoc.Rmd
index ae78229..97e17a6 100644
--- a/inst/doc/anova_posthoc.Rmd
+++ b/inst/doc/anova_posthoc.Rmd
@@ -77,7 +77,7 @@ knitr::kable(nice(a1))
Alternatively, the `anova` method for `afex_aov` objects returns a `data.frame` of class `anova` that can be passed to, for example, `xtable` for nice formatting:
```{r, results='asis'}
-print(xtable::xtable(a1$anova_table, digits = c(rep(2, 5), 3, 4)), type = "html")
+print(xtable::xtable(anova(a1), digits = c(rep(2, 5), 3, 4)), type = "html")
```
# Post-Hoc Contrasts and Plotting
diff --git a/inst/doc/anova_posthoc.html b/inst/doc/anova_posthoc.html
index 9eb605e..ddb6dad 100644
--- a/inst/doc/anova_posthoc.html
+++ b/inst/doc/anova_posthoc.html
@@ -10,7 +10,7 @@
<meta name="author" content="Henrik Singmann" />
-<meta name="date" content="2015-08-17" />
+<meta name="date" content="2015-10-24" />
<title>ANOVA and Post-Hoc Contrasts: Reanalysis of Singmann and Klauer (2011)</title>
@@ -18,41 +18,23 @@
<style type="text/css">code{white-space: pre;}</style>
<style type="text/css">
-div.sourceCode { overflow-x: auto; }
table.sourceCode, tr.sourceCode, td.lineNumbers, td.sourceCode {
margin: 0; padding: 0; vertical-align: baseline; border: none; }
table.sourceCode { width: 100%; line-height: 100%; }
td.lineNumbers { text-align: right; padding-right: 4px; padding-left: 4px; color: #aaaaaa; border-right: 1px solid #aaaaaa; }
td.sourceCode { padding-left: 5px; }
-code > span.kw { color: #007020; font-weight: bold; } /* Keyword */
-code > span.dt { color: #902000; } /* DataType */
-code > span.dv { color: #40a070; } /* DecVal */
-code > span.bn { color: #40a070; } /* BaseN */
-code > span.fl { color: #40a070; } /* Float */
-code > span.ch { color: #4070a0; } /* Char */
-code > span.st { color: #4070a0; } /* String */
-code > span.co { color: #60a0b0; font-style: italic; } /* Comment */
-code > span.ot { color: #007020; } /* Other */
-code > span.al { color: #ff0000; font-weight: bold; } /* Alert */
-code > span.fu { color: #06287e; } /* Function */
-code > span.er { color: #ff0000; font-weight: bold; } /* Error */
-code > span.wa { color: #60a0b0; font-weight: bold; font-style: italic; } /* Warning */
-code > span.cn { color: #880000; } /* Constant */
-code > span.sc { color: #4070a0; } /* SpecialChar */
-code > span.vs { color: #4070a0; } /* VerbatimString */
-code > span.ss { color: #bb6688; } /* SpecialString */
-code > span.im { } /* Import */
-code > span.va { color: #19177c; } /* Variable */
-code > span.cf { color: #007020; font-weight: bold; } /* ControlFlow */
-code > span.op { color: #666666; } /* Operator */
-code > span.bu { } /* BuiltIn */
-code > span.ex { } /* Extension */
-code > span.pp { color: #bc7a00; } /* Preprocessor */
-code > span.at { color: #7d9029; } /* Attribute */
-code > span.do { color: #ba2121; font-style: italic; } /* Documentation */
-code > span.an { color: #60a0b0; font-weight: bold; font-style: italic; } /* Annotation */
-code > span.cv { color: #60a0b0; font-weight: bold; font-style: italic; } /* CommentVar */
-code > span.in { color: #60a0b0; font-weight: bold; font-style: italic; } /* Information */
+code > span.kw { color: #007020; font-weight: bold; }
+code > span.dt { color: #902000; }
+code > span.dv { color: #40a070; }
+code > span.bn { color: #40a070; }
+code > span.fl { color: #40a070; }
+code > span.ch { color: #4070a0; }
+code > span.st { color: #4070a0; }
+code > span.co { color: #60a0b0; font-style: italic; }
+code > span.ot { color: #007020; }
+code > span.al { color: #ff0000; font-weight: bold; }
+code > span.fu { color: #06287e; }
+code > span.er { color: #ff0000; font-weight: bold; }
</style>
<style type="text/css">
pre:not([class]) {
@@ -61,7 +43,7 @@ code > span.in { color: #60a0b0; font-weight: bold; font-style: italic; } /* Inf
</style>
-<link href="data:text/css;charset=utf-8,body%20%7B%0Abackground%2Dcolor%3A%20%23fff%3B%0Amargin%3A%201em%20auto%3B%0Amax%2Dwidth%3A%20700px%3B%0Aoverflow%3A%20visible%3B%0Apadding%2Dleft%3A%202em%3B%0Apadding%2Dright%3A%202em%3B%0Afont%2Dfamily%3A%20%22Open%20Sans%22%2C%20%22Helvetica%20Neue%22%2C%20Helvetica%2C%20Arial%2C%20sans%2Dserif%3B%0Afont%2Dsize%3A%2014px%3B%0Aline%2Dheight%3A%201%2E35%3B%0A%7D%0A%23header%20%7B%0Atext%2Dalign%3A%20center%3B%0A%7D%0A%23TOC%20%7B%0Aclear%3A%20bot [...]
+<link href="data:text/css,body%20%7B%0A%20%20background%2Dcolor%3A%20%23fff%3B%0A%20%20margin%3A%201em%20auto%3B%0A%20%20max%2Dwidth%3A%20700px%3B%0A%20%20overflow%3A%20visible%3B%0A%20%20padding%2Dleft%3A%202em%3B%0A%20%20padding%2Dright%3A%202em%3B%0A%20%20font%2Dfamily%3A%20%22Open%20Sans%22%2C%20%22Helvetica%20Neue%22%2C%20Helvetica%2C%20Arial%2C%20sans%2Dserif%3B%0A%20%20font%2Dsize%3A%2014px%3B%0A%20%20line%2Dheight%3A%201%2E35%3B%0A%7D%0A%0A%23header%20%7B%0A%20%20text%2Dalign%3A% [...]
</head>
@@ -72,7 +54,7 @@ code > span.in { color: #60a0b0; font-weight: bold; font-style: italic; } /* Inf
<div id="header">
<h1 class="title">ANOVA and Post-Hoc Contrasts: Reanalysis of Singmann and Klauer (2011)</h1>
<h4 class="author"><em>Henrik Singmann</em></h4>
-<h4 class="date"><em>2015-08-17</em></h4>
+<h4 class="date"><em>2015-10-24</em></h4>
</div>
@@ -84,26 +66,22 @@ code > span.in { color: #60a0b0; font-weight: bold; font-style: italic; } /* Inf
<h1>Description of Experiment and Data</h1>
<p>Singmann and Klauer (2011) were interested in whether or not conditional reasoning can be explained by a single process or whether multiple processes are necessary to explain it. To provide evidence for multiple processes we aimed to establish a double dissociation of two variables: instruction type and problem type. Instruction type was manipulated between-subjects, one group of participants received deductive instructions (i.e., to treat the premises as given and only draw necessary [...]
<blockquote>
-<p>If a person is wet, then the person fell into a swimming pool.<br />
-A person fell into a swimming pool.<br />
-How valid is the conclusion/How likely is it that the person is wet?</p>
+<p>If a person is wet, then the person fell into a swimming pool.<br />A person fell into a swimming pool.<br />How valid is the conclusion/How likely is it that the person is wet?</p>
</blockquote>
<p>For those problems we predicted that under deductive instructions responses should be lower (as the conclusion does not necessarily follow from the premises) as under probabilistic instructions. For the valid but implausible problem, an example is presented next, we predicted the opposite pattern:</p>
<blockquote>
-<p>If a person is wet, then the person fell into a swimming pool.<br />
-A person is wet.<br />
-How valid is the conclusion/How likely is it that the person fell into a swimming pool?</p>
+<p>If a person is wet, then the person fell into a swimming pool.<br />A person is wet.<br />How valid is the conclusion/How likely is it that the person fell into a swimming pool?</p>
</blockquote>
<p>Our study also included valid and plausible and invalid and implausible problems.</p>
<p>In contrast to the analysis reported in the manuscript, we initially do not separate the analysis into affirmation and denial problems, but first report an analysis on the full set of inferences, MP, MT, AC, and DA, where MP and MT are valid and AC and DA invalid. We report a reanalysis of our Experiment 1 only. Note that the factor <code>plausibility</code> is not present in the original manuscript, there it is a results of a combination of other factors.</p>
</div>
<div id="data-and-r-preperation" class="section level1">
<h1>Data and R Preperation</h1>
-<div class="sourceCode"><pre class="sourceCode r"><code class="sourceCode r"><span class="kw">require</span>(afex) <span class="co"># needed for ANOVA, lsmeans is loaded automatically.</span>
+<pre class="sourceCode r"><code class="sourceCode r"><span class="kw">require</span>(afex) <span class="co"># needed for ANOVA, lsmeans is loaded automatically.</span>
<span class="kw">require</span>(multcomp) <span class="co"># for advanced control for multiple testing/Type 1 errors.</span>
-<span class="kw">require</span>(lattice) <span class="co"># for plots</span></code></pre></div>
-<div class="sourceCode"><pre class="sourceCode r"><code class="sourceCode r"><span class="kw">data</span>(sk2011<span class="fl">.1</span>)
-<span class="kw">str</span>(sk2011<span class="fl">.1</span>)</code></pre></div>
+<span class="kw">require</span>(lattice) <span class="co"># for plots</span></code></pre>
+<pre class="sourceCode r"><code class="sourceCode r"><span class="kw">data</span>(sk2011<span class="fl">.1</span>)
+<span class="kw">str</span>(sk2011<span class="fl">.1</span>)</code></pre>
<pre><code>## 'data.frame': 640 obs. of 9 variables:
## $ id : Factor w/ 40 levels "8","9","10","12",..: 3 3 3 3 3 3 3 3 3 3 ...
## $ instruction : Factor w/ 2 levels "deductive","probabilistic": 2 2 2 2 2 2 2 2 2 2 ...
@@ -115,7 +93,7 @@ How valid is the conclusion/How likely is it that the person fell into a swimmin
## $ response : int 100 60 94 70 100 99 98 49 82 50 ...
## $ content : Factor w/ 4 levels "C1","C2","C3",..: 1 1 1 1 2 2 2 2 3 3 ...</code></pre>
<p>An important feature in the data is that each participant provided two responses for each cell of the design (the content is different for each of those, each participant saw all four contents). These two data points will be aggregated automatically by <code>afex</code>.</p>
-<div class="sourceCode"><pre class="sourceCode r"><code class="sourceCode r"><span class="kw">with</span>(sk2011<span class="fl">.1</span>, <span class="kw">table</span>(inference, id, plausibility))</code></pre></div>
+<pre class="sourceCode r"><code class="sourceCode r"><span class="kw">with</span>(sk2011<span class="fl">.1</span>, <span class="kw">table</span>(inference, id, plausibility))</code></pre>
<pre><code>## , , plausibility = plausible
##
## id
@@ -149,13 +127,13 @@ How valid is the conclusion/How likely is it that the person fell into a swimmin
<div id="anova" class="section level1">
<h1>ANOVA</h1>
<p>To get the full ANOVA table for the model, we simply pass it to <code>aov_ez</code> (<code>aov_car</code> or <code>aov4</code> would be alternatives producing the same results) using the design as described above. We save the returned object for further analysis.</p>
-<div class="sourceCode"><pre class="sourceCode r"><code class="sourceCode r">a1 <-<span class="st"> </span><span class="kw">aov_ez</span>(<span class="st">"id"</span>, <span class="st">"response"</span>, sk2011<span class="fl">.1</span>, <span class="dt">between =</span> <span class="st">"instruction"</span>,
- <span class="dt">within =</span> <span class="kw">c</span>(<span class="st">"inference"</span>, <span class="st">"plausibility"</span>))</code></pre></div>
+<pre class="sourceCode r"><code class="sourceCode r">a1 <-<span class="st"> </span><span class="kw">aov_ez</span>(<span class="st">"id"</span>, <span class="st">"response"</span>, sk2011<span class="fl">.1</span>, <span class="dt">between =</span> <span class="st">"instruction"</span>,
+ <span class="dt">within =</span> <span class="kw">c</span>(<span class="st">"inference"</span>, <span class="st">"plausibility"</span>))</code></pre>
<pre><code>## Warning in aov_car(formula = as.formula(formula), data = data, fun.aggregate =
## fun.aggregate, : More than one observation per cell, aggregating the data using mean (i.e,
## fun.aggregate = mean)!</code></pre>
<pre><code>## Contrasts set to contr.sum for the following variables: instruction</code></pre>
-<div class="sourceCode"><pre class="sourceCode r"><code class="sourceCode r">a1 <span class="co"># the default print method prints a data.frame produced by nice </span></code></pre></div>
+<pre class="sourceCode r"><code class="sourceCode r">a1 <span class="co"># the default print method prints a data.frame produced by nice </span></code></pre>
<pre><code>## Effect df MSE F ges p.value
## 1 instruction 1, 38 2027.42 0.31 .003 .58
## 2 inference 2.66, 101.12 959.12 5.81 ** .06 .002
@@ -166,7 +144,7 @@ How valid is the conclusion/How likely is it that the person fell into a swimmin
## 7 instruction:inference:plausibility 2.29, 87.11 318.91 3.98 * .01 .02</code></pre>
<p>As mentioned before, the two responses per cell of the design and participants are aggregated for the analysis as indicated by the warning message. Furthermore, the degrees of freedom are Greenhouse-Geisser corrected per default for all effects involving <code>inference</code>, as <code>inference</code> is a within-subject factor with more than two levels (i.e., MP, MT, AC, & DA). In line with our expectations, the three-way interaction is significant.</p>
<p>The object printed per default for <code>afex_aov</code> objects (produced by <code>nice</code>) can also be printed nicely using <code>knitr</code>:</p>
-<div class="sourceCode"><pre class="sourceCode r"><code class="sourceCode r">knitr::<span class="kw">kable</span>(<span class="kw">nice</span>(a1))</code></pre></div>
+<pre class="sourceCode r"><code class="sourceCode r">knitr::<span class="kw">kable</span>(<span class="kw">nice</span>(a1))</code></pre>
<table>
<thead>
<tr class="header">
@@ -238,9 +216,9 @@ How valid is the conclusion/How likely is it that the person fell into a swimmin
</tbody>
</table>
<p>Alternatively, the <code>anova</code> method for <code>afex_aov</code> objects returns a <code>data.frame</code> of class <code>anova</code> that can be passed to, for example, <code>xtable</code> for nice formatting:</p>
-<div class="sourceCode"><pre class="sourceCode r"><code class="sourceCode r"><span class="kw">print</span>(xtable::<span class="kw">xtable</span>(a1$anova_table, <span class="dt">digits =</span> <span class="kw">c</span>(<span class="kw">rep</span>(<span class="dv">2</span>, <span class="dv">5</span>), <span class="dv">3</span>, <span class="dv">4</span>)), <span class="dt">type =</span> <span class="st">"html"</span>)</code></pre></div>
-<!-- html table generated in R 3.3.0 by xtable 1.7-4 package -->
-<!-- Mon Aug 17 21:50:59 2015 -->
+<pre class="sourceCode r"><code class="sourceCode r"><span class="kw">print</span>(xtable::<span class="kw">xtable</span>(<span class="kw">anova</span>(a1), <span class="dt">digits =</span> <span class="kw">c</span>(<span class="kw">rep</span>(<span class="dv">2</span>, <span class="dv">5</span>), <span class="dv">3</span>, <span class="dv">4</span>)), <span class="dt">type =</span> <span class="st">"html"</span>)</code></pre>
+<!-- html table generated in R 3.2.2 by xtable 1.7-4 package -->
+<!-- Sat Oct 24 23:27:23 2015 -->
<table border="1">
<tr>
<th>
@@ -435,9 +413,9 @@ instruction:inference:plausibility
<div id="main-effects-only" class="section level3">
<h3>Main Effects Only</h3>
<p>This object can now be passed to <code>lsmeans</code>, for example to obtain the marginal means of the four inferences:</p>
-<div class="sourceCode"><pre class="sourceCode r"><code class="sourceCode r">m1 <-<span class="st"> </span><span class="kw">lsmeans</span>(a1, ~<span class="st"> </span>inference)</code></pre></div>
+<pre class="sourceCode r"><code class="sourceCode r">m1 <-<span class="st"> </span><span class="kw">lsmeans</span>(a1, ~<span class="st"> </span>inference)</code></pre>
<pre><code>## NOTE: Results may be misleading due to involvement in interactions</code></pre>
-<div class="sourceCode"><pre class="sourceCode r"><code class="sourceCode r">m1</code></pre></div>
+<pre class="sourceCode r"><code class="sourceCode r">m1</code></pre>
<pre><code>## inference lsmean SE df lower.CL upper.CL
## MP 87.51250 3.783074 126.87 80.02641 94.99859
## MT 76.68125 3.783074 126.87 69.19516 84.16734
@@ -447,7 +425,7 @@ instruction:inference:plausibility
## Results are averaged over the levels of: instruction, plausibility
## Confidence level used: 0.95</code></pre>
<p>This object can now also be used to compare whether or not there are differences between the levels of the factor:</p>
-<div class="sourceCode"><pre class="sourceCode r"><code class="sourceCode r"><span class="kw">pairs</span>(m1)</code></pre></div>
+<pre class="sourceCode r"><code class="sourceCode r"><span class="kw">pairs</span>(m1)</code></pre>
<pre><code>## contrast estimate SE df t.ratio p.value
## MP - MT 10.83125 4.611854 114 2.349 0.0933
## MP - AC 18.10000 4.611854 114 3.925 0.0008
@@ -459,18 +437,18 @@ instruction:inference:plausibility
## Results are averaged over the levels of: instruction, plausibility
## P value adjustment: tukey method for comparing a family of 4 estimates</code></pre>
<p>To obtain more powerful p-value adjustments, we can furthermore pass it to <code>multcomp</code> (Bretz, Hothorn, & Westfall, 2011):</p>
-<div class="sourceCode"><pre class="sourceCode r"><code class="sourceCode r"><span class="kw">summary</span>(<span class="kw">as.glht</span>(<span class="kw">pairs</span>(m1)), <span class="dt">test=</span><span class="kw">adjusted</span>(<span class="st">"free"</span>))</code></pre></div>
+<pre class="sourceCode r"><code class="sourceCode r"><span class="kw">summary</span>(<span class="kw">as.glht</span>(<span class="kw">pairs</span>(m1)), <span class="dt">test=</span><span class="kw">adjusted</span>(<span class="st">"free"</span>))</code></pre>
<pre><code>##
## Simultaneous Tests for General Linear Hypotheses
##
## Linear Hypotheses:
## Estimate Std. Error t value Pr(>|t|)
-## MP - MT == 0 10.831 4.612 2.349 0.068930 .
-## MP - AC == 0 18.100 4.612 3.925 0.000795 ***
+## MP - MT == 0 10.831 4.612 2.349 0.068998 .
+## MP - AC == 0 18.100 4.612 3.925 0.000797 ***
## MP - DA == 0 4.556 4.612 0.988 0.325273
-## MT - AC == 0 7.269 4.612 1.576 0.281427
+## MT - AC == 0 7.269 4.612 1.576 0.281795
## MT - DA == 0 -6.275 4.612 -1.361 0.296932
-## AC - DA == 0 -13.544 4.612 -2.937 0.017718 *
+## AC - DA == 0 -13.544 4.612 -2.937 0.017434 *
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## (Adjusted p values reported -- free method)</code></pre>
@@ -478,9 +456,9 @@ instruction:inference:plausibility
<div id="a-simple-interaction" class="section level3">
<h3>A Simple interaction</h3>
<p>We could now also be interested in the marginal means of the inferences across the two instruction types. <code>lsmeans</code> offers two ways to do so. The first splits the contrasts across levels of the factor.</p>
-<div class="sourceCode"><pre class="sourceCode r"><code class="sourceCode r">m2 <-<span class="st"> </span><span class="kw">lsmeans</span>(a1, ~<span class="st"> </span>inference|instruction)</code></pre></div>
+<pre class="sourceCode r"><code class="sourceCode r">m2 <-<span class="st"> </span><span class="kw">lsmeans</span>(a1, ~<span class="st"> </span>inference|instruction)</code></pre>
<pre><code>## NOTE: Results may be misleading due to involvement in interactions</code></pre>
-<div class="sourceCode"><pre class="sourceCode r"><code class="sourceCode r">m2</code></pre></div>
+<pre class="sourceCode r"><code class="sourceCode r">m2</code></pre>
<pre><code>## instruction = deductive:
## inference lsmean SE df lower.CL upper.CL
## MP 97.2875 5.350074 126.87 86.70057 107.87443
@@ -498,7 +476,7 @@ instruction:inference:plausibility
## Results are averaged over the levels of: plausibility
## Confidence level used: 0.95</code></pre>
<p>Consequently test are also only performed within each level:</p>
-<div class="sourceCode"><pre class="sourceCode r"><code class="sourceCode r"><span class="kw">pairs</span>(m2)</code></pre></div>
+<pre class="sourceCode r"><code class="sourceCode r"><span class="kw">pairs</span>(m2)</code></pre>
<pre><code>## instruction = deductive:
## contrast estimate SE df t.ratio p.value
## MP - MT 26.8875 6.522147 114 4.122 0.0004
@@ -520,9 +498,9 @@ instruction:inference:plausibility
## Results are averaged over the levels of: plausibility
## P value adjustment: tukey method for comparing a family of 4 estimates</code></pre>
<p>The second version treats all factor combinations together, producing a considerably larger number of pairwise comparisons:</p>
-<div class="sourceCode"><pre class="sourceCode r"><code class="sourceCode r">m3 <-<span class="st"> </span><span class="kw">lsmeans</span>(a1, ~<span class="st"> </span>inference:instruction)</code></pre></div>
+<pre class="sourceCode r"><code class="sourceCode r">m3 <-<span class="st"> </span><span class="kw">lsmeans</span>(a1, ~<span class="st"> </span>inference:instruction)</code></pre>
<pre><code>## NOTE: Results may be misleading due to involvement in interactions</code></pre>
-<div class="sourceCode"><pre class="sourceCode r"><code class="sourceCode r">m3</code></pre></div>
+<pre class="sourceCode r"><code class="sourceCode r">m3</code></pre>
<pre><code>## inference instruction lsmean SE df lower.CL upper.CL
## MP deductive 97.2875 5.350074 126.87 86.70057 107.87443
## MT deductive 70.4000 5.350074 126.87 59.81307 80.98693
@@ -535,7 +513,7 @@ instruction:inference:plausibility
##
## Results are averaged over the levels of: plausibility
## Confidence level used: 0.95</code></pre>
-<div class="sourceCode"><pre class="sourceCode r"><code class="sourceCode r"><span class="kw">pairs</span>(m3)</code></pre></div>
+<pre class="sourceCode r"><code class="sourceCode r"><span class="kw">pairs</span>(m3)</code></pre>
<pre><code>## contrast estimate SE df t.ratio p.value
## MP,deductive - MT,deductive 26.8875 6.522147 114.00 4.122 0.0018
## MP,deductive - AC,deductive 35.8000 6.522147 114.00 5.489 <.0001
@@ -572,19 +550,19 @@ instruction:inference:plausibility
<div id="running-custom-contrasts" class="section level3">
<h3>Running Custom Contrasts</h3>
<p>Objects returned from <code>lsmeans</code> can also be used to test specific contrasts. For this, we can simply create a list, where each element corresponds to one contrasts. A contrast is defined as a vector of constants on the reference grid (i.e., the object returned from <code>lsmeans</code>, here <code>m3</code>). For example, we might be interested in whether there is a difference between the valid and invalid inferences in each of the two conditions.</p>
-<div class="sourceCode"><pre class="sourceCode r"><code class="sourceCode r">c1 <-<span class="st"> </span><span class="kw">list</span>(
+<pre class="sourceCode r"><code class="sourceCode r">c1 <-<span class="st"> </span><span class="kw">list</span>(
<span class="dt">v_i.ded =</span> <span class="kw">c</span>(<span class="fl">0.5</span>, <span class="fl">0.5</span>, -<span class="fl">0.5</span>, -<span class="fl">0.5</span>, <span class="dv">0</span>, <span class="dv">0</span>, <span class="dv">0</span>, <span class="dv">0</span>),
<span class="dt">v_i.prob =</span> <span class="kw">c</span>(<span class="dv">0</span>, <span class="dv">0</span>, <span class="dv">0</span>, <span class="dv">0</span>, <span class="fl">0.5</span>, <span class="fl">0.5</span>, -<span class="fl">0.5</span>, -<span class="fl">0.5</span>)
)
-<span class="kw">contrast</span>(m3, c1, <span class="dt">adjust =</span> <span class="st">"holm"</span>)</code></pre></div>
+<span class="kw">contrast</span>(m3, c1, <span class="dt">adjust =</span> <span class="st">"holm"</span>)</code></pre>
<pre><code>## contrast estimate SE df t.ratio p.value
## v_i.ded 12.19375 4.611854 114 2.644 0.0187
## v_i.prob -0.36875 4.611854 114 -0.080 0.9364
##
## Results are averaged over the levels of: plausibility
## P value adjustment: holm method for 2 tests</code></pre>
-<div class="sourceCode"><pre class="sourceCode r"><code class="sourceCode r"><span class="kw">summary</span>(<span class="kw">as.glht</span>(<span class="kw">contrast</span>(m3, c1)), <span class="dt">test =</span><span class="kw">adjusted</span>(<span class="st">"free"</span>))</code></pre></div>
+<pre class="sourceCode r"><code class="sourceCode r"><span class="kw">summary</span>(<span class="kw">as.glht</span>(<span class="kw">contrast</span>(m3, c1)), <span class="dt">test =</span><span class="kw">adjusted</span>(<span class="st">"free"</span>))</code></pre>
<pre><code>##
## Simultaneous Tests for General Linear Hypotheses
##
@@ -601,20 +579,20 @@ instruction:inference:plausibility
<div id="plotting" class="section level2">
<h2>Plotting</h2>
<p>Function <code>lsmip</code> from package <code>lsmeans</code> can be used for plotting the data directly from an <code>afex_aov</code> object. As said initially, we are interested in the three-way interaction of instruction with inference, plausibility, and instruction. A plot of this interaction could be the following:</p>
-<div class="sourceCode"><pre class="sourceCode r"><code class="sourceCode r"><span class="kw">lsmip</span>(a1, instruction ~<span class="st"> </span>inference|plausibility)</code></pre></div>
-<p><img src="data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAtAAAAGACAIAAAALU8KhAAAACXBIWXMAAA7DAAAOwwHHb6hkAAAgAElEQVR4nOzdeVzM+R8H8NdU0n3fh6tIulCRClli15Hsoi23qPBj17rKOnLklnuF3HKLnLvOJedWFCmUMxKJKKGavr8/ZrXpmo6Z+c7xfj76Y+Y73+M13/ka7/l+P9/Ph8MwDAghhBBChEmO7QCEEEIIkX5UcBBCCCFE6KjgIIQQQojQUcFBCCGEEKGjgoMQQgghQkcFByGEEEKEjgoOQgghhAgdFRyEEEIIEToqOAghhBAidFRwEEIIIUToqOAghBBCiNBRwUEIIYQQoaOCgxBCCCFCRwUHIYQQQoSOCg5CCCGECB0VHIQQQggROio4CCGEECJ0VHAQQgghROio4CCEEEKI0FHBQQghhBCho4KDEEIIIUJHBQchhBBCh [...]
+<pre class="sourceCode r"><code class="sourceCode r"><span class="kw">lsmip</span>(a1, instruction ~<span class="st"> </span>inference|plausibility)</code></pre>
+<p><img src="data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAtAAAAGACAIAAAALU8KhAAAACXBIWXMAAA7DAAAOwwHHb6hkAAAgAElEQVR4nOzdeVxN6R8H8M/ppj2JSikpspUKRVTW7GQJURpCZJ/xG4wwlrGNbcY6IyJbypayj50YRMSYMooiLUilzdJyfn/ccSdtt+Xee+7yfb/6495zn3PO556u69s5z3kehmVZEEIIIYSIkxLXAQghhBAi/6jgIIQQQojYUcFBCCGEELGjgoMQQgghYkcFByGEEELEjgoOQgghhIgdFRyEEEIIETsqOAghhBAidlRwEEIIIUTsqOAghBBCiNhRwUEIIYQQsaOCgxBCCCFiRwUHIYQQQsSOCg5CCCGEiB0VHIQQQggROyo4CCGEECJ2VHAQQgghROyo4CCEEEKI2FHBQQghhBCxo4KDEEIIIWJHBQchhBBCxI4KDkIII [...]
</div>
</div>
<div id="replicate-analysis-from-singmann-and-klauer-2011" class="section level1">
<h1>Replicate Analysis from Singmann and Klauer (2011)</h1>
<p>As this plot is not very helpful, we now fit a new ANOVA model in which we separate the data in affirmation and denial inferences, as done in the original manuscript and plot the data then a second time.</p>
-<div class="sourceCode"><pre class="sourceCode r"><code class="sourceCode r">a2 <-<span class="st"> </span><span class="kw">aov_ez</span>(<span class="st">"id"</span>, <span class="st">"response"</span>, sk2011<span class="fl">.1</span>, <span class="dt">between =</span> <span class="st">"instruction"</span>,
- <span class="dt">within =</span> <span class="kw">c</span>(<span class="st">"validity"</span>, <span class="st">"plausibility"</span>, <span class="st">"what"</span>))</code></pre></div>
+<pre class="sourceCode r"><code class="sourceCode r">a2 <-<span class="st"> </span><span class="kw">aov_ez</span>(<span class="st">"id"</span>, <span class="st">"response"</span>, sk2011<span class="fl">.1</span>, <span class="dt">between =</span> <span class="st">"instruction"</span>,
+ <span class="dt">within =</span> <span class="kw">c</span>(<span class="st">"validity"</span>, <span class="st">"plausibility"</span>, <span class="st">"what"</span>))</code></pre>
<pre><code>## Warning in aov_car(formula = as.formula(formula), data = data, fun.aggregate =
## fun.aggregate, : More than one observation per cell, aggregating the data using mean (i.e,
## fun.aggregate = mean)!</code></pre>
<pre><code>## Contrasts set to contr.sum for the following variables: instruction</code></pre>
-<div class="sourceCode"><pre class="sourceCode r"><code class="sourceCode r">a2</code></pre></div>
+<pre class="sourceCode r"><code class="sourceCode r">a2</code></pre>
<pre><code>## Effect df MSE F ges p.value
## 1 instruction 1, 38 2027.42 0.31 .003 .58
## 2 validity 1, 38 678.65 4.12 * .01 .05
@@ -632,14 +610,14 @@ instruction:inference:plausibility
## 14 validity:plausibility:what 1, 38 154.62 0.03 <.0001 .85
## 15 instruction:validity:plausibility:what 1, 38 154.62 0.42 .0003 .52</code></pre>
<p>Then we plot the data from this ANOVA.</p>
-<div class="sourceCode"><pre class="sourceCode r"><code class="sourceCode r"><span class="kw">lsmip</span>(a2, ~instruction ~<span class="st"> </span>plausibility+validity|what,
+<pre class="sourceCode r"><code class="sourceCode r"><span class="kw">lsmip</span>(a2, ~instruction ~<span class="st"> </span>plausibility+validity|what,
<span class="dt">scales =</span> <span class="kw">list</span>(<span class="dt">x=</span><span class="kw">list</span>(
<span class="dt">at =</span> <span class="dv">1</span>:<span class="dv">4</span>,
<span class="dt">labels =</span> <span class="kw">c</span>(<span class="st">"pl:v"</span>, <span class="st">"im:v"</span>, <span class="st">"pl:i"</span>, <span class="st">"im:i"</span>)
- )))</code></pre></div>
-<p><img src="data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAtAAAAGACAIAAAALU8KhAAAACXBIWXMAAA7DAAAOwwHHb6hkAAAgAElEQVR4nOzdd1zV1R/H8dcFRKayHAjkxA2aCKKSWs4caG7EvccvyyyzcmBqbrS0xG0pbkVylJVWrjK0nLhwknvhXsD398c1RBHuBe+933vx83z0x73nfsf73q7w4XvO9xyNoigIIYQQQhiTldoBhBBCCJH7ScEhhBBCCKOTgkMIIYQQRicFhxBCCCGMTgoOIYQQQhidFBxCCCGEMDopOIQQQghhdFJwCCGEEMLopOAQQgghhNFJwSGEEEIIo5OCQwghhBBGJwWHEEIIIYxOCg4hhBBCGJ0UHEIIIYQwOik4hBBCCGF0UnAIIYQQwuik4BBCCCGE0UnBIYQQQgijk4JDCCGEEEYnBYcQQgghjE4KDiGEEEIYnRQcQgghh [...]
+ )))</code></pre>
+<p><img src="data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAtAAAAGACAIAAAALU8KhAAAACXBIWXMAAA7DAAAOwwHHb6hkAAAgAElEQVR4nOzdd1zV1R/H8dcFRaYIKoKgouJCcaE4c0TmxC0OzBy4zVFqQ38qaZpb08oJWu4B4ipHZo7KmZqiCY7CgXvgFvj+/rh2wwEX8N77vRc/z0d/cM/9jve9XS8fvud8z9EoioIQQgghhDFZqR1ACCGEENmfFBxCCCGEMDopOIQQQghhdFJwCCGEEMLopOAQQgghhNFJwSGEEEIIo5OCQwghhBBGJwWHEEIIIYxOCg4hhBBCGJ0UHEIIIYQwOik4hBBCCGF0UnAIIYQQwuik4BBCCCGE0UnBIYQQQgijk4JDCCGEEEYnBYcQQgghjE4KDiGEEEIYnRQcQgghhDA6KTiEEEIIYXRScAghhBDC6KTgEEIIIYTRScEhh [...]
<p>We see the critical predicted cross-over interaction in the left of those two graphs. For valid but implausible problems (<code>im:v</code>) deductive responses are larger than probabilistic responses. The opposite is true for invalid but plausible problems (<code>pl:i</code>). We now tests these differences at each of the four x-axis ticks in each plot using custom contrasts (<code>diff_1</code> to <code>diff_4</code>). Furthermore, we test for a validity effect and plausibility effe [...]
-<div class="sourceCode"><pre class="sourceCode r"><code class="sourceCode r">(m4 <-<span class="st"> </span><span class="kw">lsmeans</span>(a2, ~instruction+plausibility+validity|what))</code></pre></div>
+<pre class="sourceCode r"><code class="sourceCode r">(m4 <-<span class="st"> </span><span class="kw">lsmeans</span>(a2, ~instruction+plausibility+validity|what))</code></pre>
<pre><code>## what = affirmation:
## instruction plausibility validity lsmean SE df lower.CL upper.CL
## deductive plausible valid 99.475 6.01019 183.89 87.6172 111.3328
@@ -663,7 +641,7 @@ instruction:inference:plausibility
## probabilistic implausible invalid 80.750 6.01019 183.89 68.8922 92.6078
##
## Confidence level used: 0.95</code></pre>
-<div class="sourceCode"><pre class="sourceCode r"><code class="sourceCode r">c2 <-<span class="st"> </span><span class="kw">list</span>(
+<pre class="sourceCode r"><code class="sourceCode r">c2 <-<span class="st"> </span><span class="kw">list</span>(
<span class="dt">diff_1 =</span> <span class="kw">c</span>(<span class="dv">1</span>, -<span class="dv">1</span>, <span class="dv">0</span>, <span class="dv">0</span>, <span class="dv">0</span>, <span class="dv">0</span>, <span class="dv">0</span>, <span class="dv">0</span>),
<span class="dt">diff_2 =</span> <span class="kw">c</span>(<span class="dv">0</span>, <span class="dv">0</span>, <span class="dv">1</span>, -<span class="dv">1</span>, <span class="dv">0</span>, <span class="dv">0</span>, <span class="dv">0</span>, <span class="dv">0</span>),
<span class="dt">diff_3 =</span> <span class="kw">c</span>(<span class="dv">0</span>, <span class="dv">0</span>, <span class="dv">0</span>, <span class="dv">0</span>, <span class="dv">1</span>, -<span class="dv">1</span>, <span class="dv">0</span>, <span class="dv">0</span>),
@@ -673,7 +651,7 @@ instruction:inference:plausibility
<span class="dt">plau_ded =</span> <span class="kw">c</span>(<span class="fl">0.5</span>, <span class="dv">0</span>, -<span class="fl">0.5</span>, <span class="dv">0</span>, -<span class="fl">0.5</span>, <span class="dv">0</span>, <span class="fl">0.5</span>, <span class="dv">0</span>),
<span class="dt">plau_prob =</span> <span class="kw">c</span>(<span class="dv">0</span>, <span class="fl">0.5</span>, <span class="dv">0</span>, -<span class="fl">0.5</span>, <span class="dv">0</span>, <span class="fl">0.5</span>, <span class="dv">0</span>, -<span class="fl">0.5</span>)
)
-<span class="kw">contrast</span>(m4, c2, <span class="dt">adjust =</span> <span class="st">"holm"</span>)</code></pre></div>
+<span class="kw">contrast</span>(m4, c2, <span class="dt">adjust =</span> <span class="st">"holm"</span>)</code></pre>
<pre><code>## what = affirmation:
## contrast estimate SE df t.ratio p.value
## diff_1 4.1750 8.499692 183.89 0.491 1.0000
@@ -698,7 +676,7 @@ instruction:inference:plausibility
##
## P value adjustment: holm method for 8 tests</code></pre>
<p>As the resulting eight contrasts have different numbers of degrees-of-freedom, we can only pass them to <code>multcomp</code> in small batches. This gives us more powerful Type 1 error corrections but overall a reduced correction as we now control for three families of tests (i.e., overall Type 1 error probability of .15).</p>
-<div class="sourceCode"><pre class="sourceCode r"><code class="sourceCode r"><span class="kw">summary</span>(<span class="kw">as.glht</span>(<span class="kw">contrast</span>(m4, c2[<span class="dv">1</span>:<span class="dv">4</span>])), <span class="dt">test =</span><span class="kw">adjusted</span>(<span class="st">"free"</span>))</code></pre></div>
+<pre class="sourceCode r"><code class="sourceCode r"><span class="kw">summary</span>(<span class="kw">as.glht</span>(<span class="kw">contrast</span>(m4, c2[<span class="dv">1</span>:<span class="dv">4</span>])), <span class="dt">test =</span><span class="kw">adjusted</span>(<span class="st">"free"</span>))</code></pre>
<pre><code>## $`what = affirmation`
##
## Simultaneous Tests for General Linear Hypotheses
@@ -706,8 +684,8 @@ instruction:inference:plausibility
## Linear Hypotheses:
## Estimate Std. Error t value Pr(>|t|)
## diff_1 == 0 4.175 8.500 0.491 0.623874
-## diff_2 == 0 34.925 8.500 4.109 0.000227 ***
-## diff_3 == 0 -23.600 8.500 -2.777 0.017218 *
+## diff_2 == 0 34.925 8.500 4.109 0.000234 ***
+## diff_3 == 0 -23.600 8.500 -2.777 0.017357 *
## diff_4 == 0 -8.100 8.500 -0.953 0.564739
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
@@ -720,14 +698,14 @@ instruction:inference:plausibility
##
## Linear Hypotheses:
## Estimate Std. Error t value Pr(>|t|)
-## diff_1 == 0 -22.425 8.500 -2.638 0.0331 *
-## diff_2 == 0 -2.700 8.500 -0.318 0.9554
-## diff_3 == 0 -0.925 8.500 -0.109 0.9554
-## diff_4 == 0 -3.650 8.500 -0.429 0.9554
+## diff_1 == 0 -22.425 8.500 -2.638 0.033 *
+## diff_2 == 0 -2.700 8.500 -0.318 0.955
+## diff_3 == 0 -0.925 8.500 -0.109 0.955
+## diff_4 == 0 -3.650 8.500 -0.429 0.955
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## (Adjusted p values reported -- free method)</code></pre>
-<div class="sourceCode"><pre class="sourceCode r"><code class="sourceCode r"><span class="kw">summary</span>(<span class="kw">as.glht</span>(<span class="kw">contrast</span>(m4, c2[<span class="dv">5</span>:<span class="dv">6</span>])), <span class="dt">test =</span><span class="kw">adjusted</span>(<span class="st">"free"</span>))</code></pre></div>
+<pre class="sourceCode r"><code class="sourceCode r"><span class="kw">summary</span>(<span class="kw">as.glht</span>(<span class="kw">contrast</span>(m4, c2[<span class="dv">5</span>:<span class="dv">6</span>])), <span class="dt">test =</span><span class="kw">adjusted</span>(<span class="st">"free"</span>))</code></pre>
<pre><code>## $`what = affirmation`
##
## Simultaneous Tests for General Linear Hypotheses
@@ -750,7 +728,7 @@ instruction:inference:plausibility
## val_ded == 0 -11.412 6.877 -1.659 0.192
## val_prob == 0 -1.137 6.877 -0.165 0.869
## (Adjusted p values reported -- free method)</code></pre>
-<div class="sourceCode"><pre class="sourceCode r"><code class="sourceCode r"><span class="kw">summary</span>(<span class="kw">as.glht</span>(<span class="kw">contrast</span>(m4, c2[<span class="dv">7</span>:<span class="dv">8</span>])), <span class="dt">test =</span><span class="kw">adjusted</span>(<span class="st">"free"</span>))</code></pre></div>
+<pre class="sourceCode r"><code class="sourceCode r"><span class="kw">summary</span>(<span class="kw">as.glht</span>(<span class="kw">contrast</span>(m4, c2[<span class="dv">7</span>:<span class="dv">8</span>])), <span class="dt">test =</span><span class="kw">adjusted</span>(<span class="st">"free"</span>))</code></pre>
<pre><code>## $`what = affirmation`
##
## Simultaneous Tests for General Linear Hypotheses
diff --git a/man/afex-package.Rd b/man/afex-package.Rd
index 6311286..1e51efe 100644
--- a/man/afex-package.Rd
+++ b/man/afex-package.Rd
@@ -11,8 +11,8 @@ Analysis of Factorial Experiments.
\tabular{ll}{
Package: \tab afex\cr
Type: \tab Package\cr
-Version: \tab 0.14-2\cr
-Date: \tab 2015-08-17\cr
+Version: \tab 0.15-2\cr
+Date: \tab 2015-10-24\cr
Depends: \tab R (>= 3.0.0), lme4 (>= 1.0.5), reshape2, lsmeans (>= 2.17)\cr
Encoding: \tab UTF-8\cr
License: \tab GPL (>=3)\cr
@@ -22,7 +22,7 @@ URL: \tab https://github.com/singmann/afex\cr
Provides convenience functions for analyzing factorial experiments using ANOVA or mixed models. aov_ez(), aov_car(), and aov_4() allow specification of between, within (i.e., repeated-measures), or mixed between-within (i.e., split-plot) ANOVAs for data in long format (i.e., one observation per row), potentially aggregating multiple observations per individual and cell of the design. mixed() fits mixed models using lme4::lmer() and computes p-values for all fixed effects using either Ken [...]
}
\author{
-Henrik Singmann, Ben Bolker, Jake Westfall, with contributions from Søren Højsgaard, John Fox, Michael A. Lawrence, Ulf Mertens
+Henrik Singmann, Ben Bolker, Jake Westfall, with contributions from Søren Højsgaard, John Fox, Michael A. Lawrence, Ulf Mertens, Frederik Aust
}
\keyword{package}
diff --git a/man/afex_aov-methods.Rd b/man/afex_aov-methods.Rd
index 2665ad9..de0c77f 100644
--- a/man/afex_aov-methods.Rd
+++ b/man/afex_aov-methods.Rd
@@ -11,7 +11,7 @@
\usage{
\method{anova}{afex_aov}(object, es = afex_options("es_aov"),
observed = NULL, correction = afex_options("correction_aov"),
- MSE = TRUE, intercept = FALSE, ...)
+ MSE = TRUE, intercept = FALSE, p.adjust.method = NULL, ...)
\method{print}{afex_aov}(x, ...)
@@ -34,6 +34,8 @@
\item{intercept}{logical. Should intercept (if present) be included in the ANOVA table? Default is \code{FALSE} which hides the intercept.}
+\item{p.adjust.method}{\code{character} indicating if p-values for individual effects should be adjusted for multiple comparisons (see \link[stats]{p.adjust} and details).}
+
\item{...}{further arguments passed through, see description of return value for details.}
\item{trms,xlev,grid}{same as for \code{\link{lsm.basis}}.}
@@ -50,4 +52,11 @@
\description{
Methods defined for objects returned from the ANOVA functions \code{\link{aov_car}} et al. of class \code{afex_aov} containing both the ANOVA fitted via \code{car::Anova} and base R's \code{aov}.
}
+\details{
+Exploratory ANOVA, for which no detailed hypotheses have been specified a priori, harbor a multiple comparison problem (Cramer et al., 2015). To avoid an inflation of familywise Type I error rate, results need to be corrected for multiple comparisons using \code{p.adjust.method}.
+\code{p.adjust.method} defaults to the method specified in the call to \code{\link{aov_car}} in \code{anova_table}. If no method was specified and \code{p.adjust.method = NULL} p-values are not adjusted.
+}
+\references{
+Cramer, A. O. J., van Ravenzwaaij, D., Matzke, D., Steingroever, H., Wetzels, R., Grasman, R. P. P. P., ... Wagenmakers, E.-J. (2015). Hidden multiplicity in exploratory multiway ANOVA: Prevalence and remedies. \emph{Psychonomic Bulletin & Review}, 1–8. doi:\href{http://doi.org/10.3758/s13423-015-0913-5}{10.3758/s13423-015-0913-5}
+}
diff --git a/man/mixed.Rd b/man/mixed.Rd
index 6199061..8ed9dfd 100644
--- a/man/mixed.Rd
+++ b/man/mixed.Rd
@@ -106,7 +106,7 @@ p-values are per default calculated via methods from \pkg{pbkrtest}. When \code{
\subsection{Implementation Details}{
-Type 3 tests are obtained by comparing a model in which only the tested effect is excluded with the full model (containing all effects). This corresponds to the (type 3) Wald tests given by \code{car::Anova} for \code{"lmerMod"} models. The submodels in which the tested effect is excluded are obtained by manually creating a model matrix which si then fitted in \code{"lme4"}. This is done to avoid R's "feature" to not allow this behavior.
+Type 3 tests are obtained by comparing a model in which only the tested effect is excluded with the full model (containing all effects). This corresponds to the (type 3) Wald tests given by \code{car::Anova} for \code{"lmerMod"} models. The submodels in which the tested effect is excluded are obtained by manually creating a model matrix which is then fitted in \code{"lme4"}. This is done to avoid R's "feature" to not allow this behavior.
Type 2 tests are truly sequential. They are obtained by comparing a model in which the tested effect and all higher oder effect (e.g., all three-way interactions for testing a two-way interaction) are excluded with a model in which only effects up to the order of the tested effect are present and all higher order effects absent. In other words, there are multiple full models, one for each order of effects. Consequently, the results for lower order effects are identical of whether or not [...]
@@ -126,7 +126,9 @@ When \code{method = "KR"}, obtaining p-values is known to crash due too insuffic
\code{"mixed"} will throw a message if numerical variables are not centered on 0, as main effects (of other variables then the numeric one) can be hard to interpret if numerical variables appear in interactions. See Dalal & Zickar (2012).
-Please report bugs or unexpected behavior to maintainer via email!
+Formulas longer than 500 characters will most likely fail due to the use of \code{\link{deparse}}.
+
+Please report bugs or unexpected behavior by opening a guthub issue: \url{https://github.com/singmann/afex/issues}
}
\examples{
diff --git a/man/nice.Rd b/man/nice.Rd
index f765cf0..cc0cc8b 100644
--- a/man/nice.Rd
+++ b/man/nice.Rd
@@ -13,7 +13,7 @@ nice(object, ...)
\method{nice}{afex_aov}(object, es = afex_options("es_aov"),
observed = NULL, correction = afex_options("correction_aov"),
MSE = TRUE, intercept = FALSE, sig.symbols = c(" +", " *", " **",
- " ***"), ...)
+ " ***"), p.adjust.method = NULL, ...)
\method{nice}{anova}(object, MSE = TRUE, intercept = FALSE,
sig.symbols = c(" +", " *", " **", " ***"), ...)
@@ -36,6 +36,8 @@ nice(object, ...)
\item{intercept}{logical. Should intercept (if present) be included in the ANOVA table? Default is \code{FALSE} which hides the intercept.}
\item{sig.symbols}{Character. What should be the symbols designating significance? When entering an vector with \code{length(sig.symbol) < 4} only those elements of the default (\code{c(" +", " *", " **", " ***")}) will be replaced. \code{sig.symbols = ""} will display the stars but not the \code{+}, \code{sig.symbols = rep("", 4)} will display no symbols.}
+
+\item{p.adjust.method}{\code{character} indicating if p-values for individual effects should be adjusted for multiple comparisons (see \link[stats]{p.adjust} and details). The default \code{NULL} corresponds to no adjustment.}
}
\value{
A \code{data.frame} with the ANOVA table consisting of characters. The columns that are always present are: \code{Effect}, \code{df} (degrees of freedom), \code{F}, and \code{p}.
@@ -46,11 +48,14 @@ A \code{data.frame} with the ANOVA table consisting of characters. The columns t
This generic function produces a nice ANOVA table for printin for objects of class. \code{nice_anova} takes an object from \code{\link[car]{Anova}} possible created by the convenience functions \code{\link{aov_ez}} or \code{\link{aov_car}}. When within-subject factors are present, either sphericity corrected or uncorrected degrees of freedom can be reported.
}
\details{
-The returned \code{data.frame} is print-ready when adding to a document with proper methods. I recommend \pkg{ascii} and \pkg{xtable}. \pkg{ascii} provides conversion to \href{http://www.methods.co.nz/asciidoc/}{AsciiDoc} but most notably to \href{http://orgmode.org/}{org-mode} (see \code{\link[ascii]{ascii}} and \code{\link[ascii]{print-ascii}}). \pkg{xtable} converts a \code{data.frame} into LaTeX code with many possible options (e.g., allowing for \code{"longtable"} or \code{"sideways [...]
+The returned \code{data.frame} is print-ready when adding to a document with proper methods. Either directly via \pkg{knitr} or similar approaches such as via packages \pkg{ascii} or \pkg{xtable} (nowadays \pkg{knitr} is probably the best approach, see \href{http://yihui.name/knitr/}{here}). \pkg{ascii} provides conversion to \href{http://www.methods.co.nz/asciidoc/}{AsciiDoc} and \href{http://orgmode.org/}{org-mode} (see \code{\link[ascii]{ascii}} and \code{\link[ascii]{print-ascii}}). [...]
Conversion functions to other formats (such as HTML, ODF, or Word) can be found at the \href{http://cran.r-project.org/web/views/ReproducibleResearch.html}{Reproducible Research Task View}.
The default reports generalized eta squared (Olejnik & Algina, 2003), the "recommended effect size for repeated measured designs" (Bakeman, 2005). Note that it is important that all measured variables (as opposed to experimentally manipulated variables), such as e.g., age, gender, weight, ..., must be declared via \code{observed} to obtain the correct effect size estimate. Partial eta squared (\code{"pes"}) does not require this.
+
+Exploratory ANOVA, for which no detailed hypotheses have been specified a priori, harbor a multiple comparison problem (Cramer et al., 2015). To avoid an inflation of familywise Type I error rate, results need to be corrected for multiple comparisons using \code{p.adjust.method}.
+\code{p.adjust.method} defaults to the method specified in the call to \code{\link{aov_car}} in \code{anova_table}. If no method was specified and \code{p.adjust.method = NULL} p-values are not adjusted.
}
\examples{
## example from Olejnik & Algina (2003)
@@ -89,6 +94,8 @@ The code for calculating generalized eta-squared was written by Mike Lawrence.\c
\references{
Bakeman, R. (2005). Recommended effect size statistics for repeated measures designs. \emph{Behavior Research Methods}, 37(3), 379-384. doi:10.3758/BF03192707
+Cramer, A. O. J., van Ravenzwaaij, D., Matzke, D., Steingroever, H., Wetzels, R., Grasman, R. P. P. P., ... Wagenmakers, E.-J. (2015). Hidden multiplicity in exploratory multiway ANOVA: Prevalence and remedies. \emph{Psychonomic Bulletin & Review}, 1–8. doi:\href{http://doi.org/10.3758/s13423-015-0913-5}{10.3758/s13423-015-0913-5}
+
Olejnik, S., & Algina, J. (2003). Generalized Eta and Omega Squared Statistics: Measures of Effect Size for Some Common Research Designs. \emph{Psychological Methods}, 8(4), 434-447. doi:10.1037/1082-989X.8.4.434
}
\seealso{
diff --git a/tests/testthat.R b/tests/testthat.R
index 6cca884..f7f9f1f 100644
--- a/tests/testthat.R
+++ b/tests/testthat.R
@@ -1,4 +1,4 @@
-library(testthat)
-library(afex)
-
-test_check("afex")
+library(testthat)
+library(afex)
+
+test_check("afex")
diff --git a/tests/testthat/test-afex_aov.R b/tests/testthat/test-afex_aov.R
index c0d08f9..fe27a5e 100644
--- a/tests/testthat/test-afex_aov.R
+++ b/tests/testthat/test-afex_aov.R
@@ -1,53 +1,53 @@
-
-context("ANOVAs: check that afex_aov return value works")
-
-test_that("split-plot produces an afex_aov object without error", {
- data(obk.long, package = "afex")
- split_plot1 <- aov_car(value ~ treatment * gender + Error(id/(phase*hour)), data = obk.long, observed = "gender", return = "afex_aov")
- split_plot2 <- aov_4(value ~ treatment * gender + (phase*hour|id), data = obk.long, observed = "gender", return = "afex_aov")
- split_plot3 <- aov_ez("id", "value", obk.long, between = c("treatment", "gender"), within = c("phase", "hour"), observed = "gender", return = "afex_aov")
-
- expect_that(split_plot1, is_equivalent_to(split_plot2))
- expect_that(split_plot1, is_equivalent_to(split_plot3))
- expect_that(split_plot1, is_a("afex_aov"))
-
- ## is same with numeric factor:
- obk.long$hour <- as.numeric(as.character(obk.long$hour))
- split_plot4 <- aov_car(value ~ treatment * gender + Error(id/phase*hour), data = obk.long,observed = c("gender"), return = "afex_aov")
- expect_that(split_plot1, is_equivalent_to(split_plot4))
-})
-
-test_that("purely-between produces afex_aov objects without error", {
- data(obk.long, package = "afex")
- out1 <- aov_car(value ~ treatment * gender + Error(id), data = obk.long, observed = "gender", return = "afex_aov", fun.aggregate = mean)
- out2 <- aov_4(value ~ treatment * gender + (1|id), data = obk.long, observed = "gender", return = "afex_aov", fun.aggregate = mean)
- out3 <- aov_ez("id", "value", obk.long, between = c("treatment", "gender"), observed = "gender", return = "afex_aov", fun.aggregate = mean)
-
- expect_that(out1, is_equivalent_to(out2))
- expect_that(out1, is_equivalent_to(out3))
- expect_that(out1, is_a("afex_aov"))
-})
-
-test_that("purely-within produces afex_aov objects without error", {
- data(obk.long, package = "afex")
- out1 <- aov_car(value ~ Error(id/(phase*hour)), data = obk.long, return = "afex_aov")
- out2 <- aov_4(value ~ 1 + (phase*hour|id), data = obk.long, return = "afex_aov")
- out3 <- aov_ez("id", "value", obk.long, within = c("phase", "hour"), return = "afex_aov")
-
- expect_that(out1, is_equivalent_to(out2))
- expect_that(out1, is_equivalent_to(out3))
- expect_that(out1, is_a("afex_aov"))
-})
-
-
-test_that("afex_aov object contains the right things", {
- data(obk.long, package = "afex")
- out1 <- aov_car(value ~ treatment * gender + Error(id/(phase*hour)), data = obk.long, observed = "gender", return = "afex_aov")
-
- expect_that(out1[["anova_table"]], is_a(c("anova", "data.frame")))
- expect_that(out1[["aov"]], is_a(c("aovlist", "listof")))
- expect_that(out1[["Anova"]], is_a(c("Anova.mlm")))
- expect_that(out1[["lm"]], is_a(c("mlm", "lm")))
- expect_that(out1[["data"]], is_a(c("list")))
- expect_that(attr(out1, "dv"), is_a(c("character")))
-})
+
+context("ANOVAs: check that afex_aov return value works")
+
+test_that("split-plot produces an afex_aov object without error", {
+ data(obk.long, package = "afex")
+ split_plot1 <- aov_car(value ~ treatment * gender + Error(id/(phase*hour)), data = obk.long, observed = "gender", return = "afex_aov")
+ split_plot2 <- aov_4(value ~ treatment * gender + (phase*hour|id), data = obk.long, observed = "gender", return = "afex_aov")
+ split_plot3 <- aov_ez("id", "value", obk.long, between = c("treatment", "gender"), within = c("phase", "hour"), observed = "gender", return = "afex_aov")
+
+ expect_that(split_plot1, is_equivalent_to(split_plot2))
+ expect_that(split_plot1, is_equivalent_to(split_plot3))
+ expect_that(split_plot1, is_a("afex_aov"))
+
+ ## is same with numeric factor:
+ obk.long$hour <- as.numeric(as.character(obk.long$hour))
+ split_plot4 <- aov_car(value ~ treatment * gender + Error(id/phase*hour), data = obk.long,observed = c("gender"), return = "afex_aov")
+ expect_that(split_plot1, is_equivalent_to(split_plot4))
+})
+
+test_that("purely-between produces afex_aov objects without error", {
+ data(obk.long, package = "afex")
+ out1 <- aov_car(value ~ treatment * gender + Error(id), data = obk.long, observed = "gender", return = "afex_aov", fun.aggregate = mean)
+ out2 <- aov_4(value ~ treatment * gender + (1|id), data = obk.long, observed = "gender", return = "afex_aov", fun.aggregate = mean)
+ out3 <- aov_ez("id", "value", obk.long, between = c("treatment", "gender"), observed = "gender", return = "afex_aov", fun.aggregate = mean)
+
+ expect_that(out1, is_equivalent_to(out2))
+ expect_that(out1, is_equivalent_to(out3))
+ expect_that(out1, is_a("afex_aov"))
+})
+
+test_that("purely-within produces afex_aov objects without error", {
+ data(obk.long, package = "afex")
+ out1 <- aov_car(value ~ Error(id/(phase*hour)), data = obk.long, return = "afex_aov")
+ out2 <- aov_4(value ~ 1 + (phase*hour|id), data = obk.long, return = "afex_aov")
+ out3 <- aov_ez("id", "value", obk.long, within = c("phase", "hour"), return = "afex_aov")
+
+ expect_that(out1, is_equivalent_to(out2))
+ expect_that(out1, is_equivalent_to(out3))
+ expect_that(out1, is_a("afex_aov"))
+})
+
+
+test_that("afex_aov object contains the right things", {
+ data(obk.long, package = "afex")
+ out1 <- aov_car(value ~ treatment * gender + Error(id/(phase*hour)), data = obk.long, observed = "gender", return = "afex_aov")
+
+ expect_that(out1[["anova_table"]], is_a(c("anova", "data.frame")))
+ expect_that(out1[["aov"]], is_a(c("aovlist", "listof")))
+ expect_that(out1[["Anova"]], is_a(c("Anova.mlm")))
+ expect_that(out1[["lm"]], is_a(c("mlm", "lm")))
+ expect_that(out1[["data"]], is_a(c("list")))
+ expect_that(attr(out1, "dv"), is_a(c("character")))
+})
diff --git a/tests/testthat/test-aov_car-basic.car-basic.R b/tests/testthat/test-aov_car-basic.R
similarity index 63%
rename from tests/testthat/test-aov_car-basic.car-basic.R
rename to tests/testthat/test-aov_car-basic.R
index d505ef3..d1160f8 100644
--- a/tests/testthat/test-aov_car-basic.car-basic.R
+++ b/tests/testthat/test-aov_car-basic.R
@@ -1,86 +1,124 @@
-
-context("ANOVAs: replicating published results")
-
-test_that("purely within ANOVA, return='univ': Maxell & Delaney (2004), Table 12.5 and 12.6, p. 578", {
- ### replicate results from Table 12.6
- data(md_12.1)
- # valus from table:
- f <- c(40.72, 33.77, 45.31)
- ss_num <- c(289920, 285660, 105120)
- ss_error <- c(64080, 76140, 20880)
- num_df <- c(2, 1, 2)
- den_df <- c(18, 9, 18)
-
- md_ez_r <- aov_ez("id", "rt", md_12.1, within = c("angle", "noise"))
- md_car_r <- aov_car(rt ~ 1 + Error(id/angle*noise), md_12.1)
- md_aov_4_r <- aov_4(rt ~ 1 + (angle*noise|id), md_12.1)
-
- expect_that(md_ez_r, is_equivalent_to(md_car_r))
- expect_that(md_ez_r, is_equivalent_to(md_aov_4_r))
- expect_that(round(md_ez_r$anova_table[,"F"], 2), is_equivalent_to(f))
- expect_that(suppressWarnings(summary(md_ez_r$Anova)$univariate.tests[,"SS"][-1]), is_equivalent_to(ss_num))
- expect_that(suppressWarnings(summary(md_ez_r$Anova)$univariate.tests[,"Error SS"])[-1], is_equivalent_to(ss_error))
- expect_that(anova(md_ez_r, correction = "none")[,"num Df"], is_equivalent_to(num_df))
- expect_that(anova(md_ez_r, correction = "none")[,"den Df"], is_equivalent_to(den_df))
-})
-
-test_that("Analysis of Singmann & Klauer (2011, Exp. 1)", {
- data(sk2011.1, package = "afex")
-
- out1 <- aov_ez("id", "response", sk2011.1[ sk2011.1$what == "affirmation",], within = c("inference", "type"), between = "instruction", anova_table=(es = "pes"), fun.aggregate = mean, return = "afex_aov")
-
- df_num <- rep(1, 7)
- df_den <- rep(38, 7)
- MSE <- c(1072.42, 1007.21, 1007.21, 187.9, 187.9, 498.48, 498.48)
- F <- c(0.13, 13.01, 12.44, 0.06, 3.09, 29.62, 10.73)
- pes <- c(0, 0.26, 0.25, 0, 0.08, 0.44, 0.22)
- p <- c(0.72, 0.0009, 0.001, 0.81, 0.09, 0.001, 0.002)
-
- expect_that(out1$anova_table[["num Df"]], is_equivalent_to(df_num))
- expect_that(out1$anova_table[["den Df"]], is_equivalent_to(df_den))
- expect_that(out1$anova_table[["MSE"]], equals(MSE, tolerance = 0.001))
- expect_that(out1$anova_table[["F"]], equals(F, tolerance = 0.001))
- expect_that(out1$anova_table[["pes"]], equals(pes, tolerance = 0.02))
- expect_that(out1$anova_table[["Pr(>F)"]], equals(p, tolerance = 0.01))
-
-})
-
-
-test_that("Data from O'Brien & Kaiser replicates their paper (p. 328, Table 8, column 'average'", {
- data(obk.long, package = "afex")
- out1 <- aov_car(value ~ treatment * gender + Error(id/(phase*hour)), data = obk.long, observed = "gender", return = "afex_aov", anova_table = list(correction = "none"))
-
- expect_that(unname(unlist(out1[["anova_table"]]["treatment", c("num Df", "den Df", "F")])), equals(c(2, 10, 3.94), tolerance = 0.001))
- expect_that(unname(unlist(out1[["anova_table"]]["gender", c("num Df", "den Df", "F")])), equals(c(1, 10, 3.66), tolerance = 0.001))
- expect_that(round(unname(unlist(out1[["anova_table"]]["treatment:gender", c("num Df", "den Df", "F")])), 2), equals(c(2, 10, 2.86), tolerance = 0.001))
-
- ## check against own results:
- anova_tab <- structure(list(`num Df` = c(2, 1, 2, 2, 4, 2, 4, 4, 8, 4, 8,
- 8, 16, 8, 16), `den Df` = c(10, 10, 10, 20, 20, 20, 20, 40, 40,
- 40, 40, 80, 80, 80, 80), MSE = c(22.8055555555555, 22.8055555555555,
- 22.8055555555555, 4.01388888888889, 4.01388888888889, 4.01388888888889,
- 4.01388888888889, 1.5625, 1.5625, 1.5625, 1.5625, 1.20208333333333,
- 1.20208333333333, 1.20208333333333, 1.20208333333333), F = c(3.940494501098,
- 3.65912050065102, 2.85547267441343, 16.1329196993199, 4.85098375975551,
- 0.282782484190432, 0.636602429722426, 16.6856704980843, 0.0933333333333336,
- 0.450268199233716, 0.620437956204379, 1.17990398215104, 0.345292160558641,
- 0.931293452060798, 0.735935938468544), ges = c(0.198248507309966,
- 0.114806410630587, 0.179183259116394, 0.151232705544895, 0.0967823866181358,
- 0.00312317714869712, 0.0140618480455475, 0.12547183572154, 0.00160250371109459,
- 0.0038716854273722, 0.010669821220833, 0.0153706689696344, 0.00905399063368842,
- 0.012321395080303, 0.0194734697889242), `Pr(>F)` = c(0.0547069269265198,
- 0.0848002538616402, 0.104469234023772, 6.73163655770545e-05,
- 0.00672273209545241, 0.756647338927411, 0.642369488905348, 4.02664339633774e-08,
- 0.999244623719389, 0.771559070589063, 0.755484449904079, 0.32158661418337,
- 0.990124565656718, 0.495611922963992, 0.749561639456282)), .Names = c("num Df",
- "den Df", "MSE", "F", "ges", "Pr(>F)"), heading = c("Anova Table (Type 3 tests)\n",
- "Response: value"), row.names = c("treatment", "gender", "treatment:gender",
- "phase", "treatment:phase", "gender:phase", "treatment:gender:phase",
- "hour", "treatment:hour", "gender:hour", "treatment:gender:hour",
- "phase:hour", "treatment:phase:hour", "gender:phase:hour", "treatment:gender:phase:hour"
- ), class = c("data.frame"))
-
- expect_equal(out1[["anova_table"]], anova_tab, check.attributes = FALSE)
-
-})
-
+
+context("ANOVAs: replicating published results")
+
+test_that("purely within ANOVA, return='univ': Maxell & Delaney (2004), Table 12.5 and 12.6, p. 578", {
+ ### replicate results from Table 12.6
+ data(md_12.1)
+ # valus from table:
+ f <- c(40.72, 33.77, 45.31)
+ ss_num <- c(289920, 285660, 105120)
+ ss_error <- c(64080, 76140, 20880)
+ num_df <- c(2, 1, 2)
+ den_df <- c(18, 9, 18)
+
+ md_ez_r <- aov_ez("id", "rt", md_12.1, within = c("angle", "noise"))
+ md_car_r <- aov_car(rt ~ 1 + Error(id/angle*noise), md_12.1)
+ md_aov_4_r <- aov_4(rt ~ 1 + (angle*noise|id), md_12.1)
+
+ expect_that(md_ez_r, is_equivalent_to(md_car_r))
+ expect_that(md_ez_r, is_equivalent_to(md_aov_4_r))
+ expect_that(round(md_ez_r$anova_table[,"F"], 2), is_equivalent_to(f))
+ expect_that(suppressWarnings(summary(md_ez_r$Anova)$univariate.tests[,"SS"][-1]), is_equivalent_to(ss_num))
+ expect_that(suppressWarnings(summary(md_ez_r$Anova)$univariate.tests[,"Error SS"])[-1], is_equivalent_to(ss_error))
+ expect_that(anova(md_ez_r, correction = "none")[,"num Df"], is_equivalent_to(num_df))
+ expect_that(anova(md_ez_r, correction = "none")[,"den Df"], is_equivalent_to(den_df))
+})
+
+test_that("Analysis of Singmann & Klauer (2011, Exp. 1)", {
+ data(sk2011.1, package = "afex")
+
+ out1 <- aov_ez("id", "response", sk2011.1[ sk2011.1$what == "affirmation",], within = c("inference", "type"), between = "instruction", anova_table=(es = "pes"), fun.aggregate = mean, return = "afex_aov")
+
+ df_num <- rep(1, 7)
+ df_den <- rep(38, 7)
+ MSE <- c(1072.42, 1007.21, 1007.21, 187.9, 187.9, 498.48, 498.48)
+ F <- c(0.13, 13.01, 12.44, 0.06, 3.09, 29.62, 10.73)
+ pes <- c(0, 0.26, 0.25, 0, 0.08, 0.44, 0.22)
+ p <- c(0.72, 0.0009, 0.001, 0.81, 0.09, 0.001, 0.002)
+
+ expect_that(out1$anova_table[["num Df"]], is_equivalent_to(df_num))
+ expect_that(out1$anova_table[["den Df"]], is_equivalent_to(df_den))
+ expect_that(out1$anova_table[["MSE"]], equals(MSE, tolerance = 0.001))
+ expect_that(out1$anova_table[["F"]], equals(F, tolerance = 0.001))
+ expect_that(out1$anova_table[["pes"]], equals(pes, tolerance = 0.02))
+ expect_that(out1$anova_table[["Pr(>F)"]], equals(p, tolerance = 0.01))
+
+})
+
+
+test_that("Data from O'Brien & Kaiser replicates their paper (p. 328, Table 8, column 'average'", {
+ data(obk.long, package = "afex")
+ out1 <- aov_car(value ~ treatment * gender + Error(id/(phase*hour)), data = obk.long, observed = "gender", return = "afex_aov", anova_table = list(correction = "none"))
+
+ expect_that(unname(unlist(out1[["anova_table"]]["treatment", c("num Df", "den Df", "F")])), equals(c(2, 10, 3.94), tolerance = 0.001))
+ expect_that(unname(unlist(out1[["anova_table"]]["gender", c("num Df", "den Df", "F")])), equals(c(1, 10, 3.66), tolerance = 0.001))
+ expect_that(round(unname(unlist(out1[["anova_table"]]["treatment:gender", c("num Df", "den Df", "F")])), 2), equals(c(2, 10, 2.86), tolerance = 0.001))
+
+ ## check against own results:
+ anova_tab <- structure(list(`num Df` = c(2, 1, 2, 2, 4, 2, 4, 4, 8, 4, 8,
+ 8, 16, 8, 16), `den Df` = c(10, 10, 10, 20, 20, 20, 20, 40, 40,
+ 40, 40, 80, 80, 80, 80), MSE = c(22.8055555555555, 22.8055555555555,
+ 22.8055555555555, 4.01388888888889, 4.01388888888889, 4.01388888888889,
+ 4.01388888888889, 1.5625, 1.5625, 1.5625, 1.5625, 1.20208333333333,
+ 1.20208333333333, 1.20208333333333, 1.20208333333333), F = c(3.940494501098,
+ 3.65912050065102, 2.85547267441343, 16.1329196993199, 4.85098375975551,
+ 0.282782484190432, 0.636602429722426, 16.6856704980843, 0.0933333333333336,
+ 0.450268199233716, 0.620437956204379, 1.17990398215104, 0.345292160558641,
+ 0.931293452060798, 0.735935938468544), ges = c(0.198248507309966,
+ 0.114806410630587, 0.179183259116394, 0.151232705544895, 0.0967823866181358,
+ 0.00312317714869712, 0.0140618480455475, 0.12547183572154, 0.00160250371109459,
+ 0.0038716854273722, 0.010669821220833, 0.0153706689696344, 0.00905399063368842,
+ 0.012321395080303, 0.0194734697889242), `Pr(>F)` = c(0.0547069269265198,
+ 0.0848002538616402, 0.104469234023772, 6.73163655770545e-05,
+ 0.00672273209545241, 0.756647338927411, 0.642369488905348, 4.02664339633774e-08,
+ 0.999244623719389, 0.771559070589063, 0.755484449904079, 0.32158661418337,
+ 0.990124565656718, 0.495611922963992, 0.749561639456282)), .Names = c("num Df",
+ "den Df", "MSE", "F", "ges", "Pr(>F)"), heading = c("Anova Table (Type 3 tests)\n",
+ "Response: value"), row.names = c("treatment", "gender", "treatment:gender",
+ "phase", "treatment:phase", "gender:phase", "treatment:gender:phase",
+ "hour", "treatment:hour", "gender:hour", "treatment:gender:hour",
+ "phase:hour", "treatment:phase:hour", "gender:phase:hour", "treatment:gender:phase:hour"
+ ), class = c("data.frame"))
+
+ expect_equal(out1[["anova_table"]], anova_tab, check.attributes = FALSE)
+
+})
+
+test_that("Data from O'Brien & Kaiser adjusted for familywise error rate (p. 328, Table 8, column 'average'", {
+ data(obk.long, package = "afex")
+ out1 <- aov_car(value ~ treatment * gender + Error(id/(phase*hour)), data = obk.long, observed = "gender", return = "afex_aov", anova_table = list(correction = "none", p.adjust.method = "bonferroni"))
+
+ expect_that(unname(unlist(out1[["anova_table"]]["treatment", c("num Df", "den Df", "F")])), equals(c(2, 10, 3.94), tolerance = 0.001))
+ expect_that(unname(unlist(out1[["anova_table"]]["gender", c("num Df", "den Df", "F")])), equals(c(1, 10, 3.66), tolerance = 0.001))
+ expect_that(round(unname(unlist(out1[["anova_table"]]["treatment:gender", c("num Df", "den Df", "F")])), 2), equals(c(2, 10, 2.86), tolerance = 0.001))
+
+ ## check against own results:
+ anova_tab <- structure(list(`num Df` = c(2, 1, 2, 2, 4, 2, 4, 4, 8, 4, 8,
+ 8, 16, 8, 16), `den Df` = c(10, 10, 10, 20, 20, 20, 20, 40, 40,
+ 40, 40, 80, 80, 80, 80), MSE = c(22.8055555555555, 22.8055555555555,
+ 22.8055555555555, 4.01388888888889, 4.01388888888889, 4.01388888888889,
+ 4.01388888888889, 1.5625, 1.5625, 1.5625, 1.5625, 1.20208333333333,
+ 1.20208333333333, 1.20208333333333, 1.20208333333333), F = c(3.940494501098,
+ 3.65912050065102, 2.85547267441343, 16.1329196993199, 4.85098375975551,
+ 0.282782484190432, 0.636602429722426, 16.6856704980843, 0.0933333333333336,
+ 0.450268199233716, 0.620437956204379, 1.17990398215104, 0.345292160558641,
+ 0.931293452060798, 0.735935938468544), ges = c(0.198248507309966,
+ 0.114806410630587, 0.179183259116394, 0.151232705544895, 0.0967823866181358,
+ 0.00312317714869712, 0.0140618480455475, 0.12547183572154, 0.00160250371109459,
+ 0.0038716854273722, 0.010669821220833, 0.0153706689696344, 0.00905399063368842,
+ 0.012321395080303, 0.0194734697889242), `Pr(>F)` = c(0.0547069269265198,
+ 0.0848002538616402, 0.104469234023772, 6.73163655770545e-05,
+ 0.00672273209545241, 0.756647338927411, 0.642369488905348, 4.02664339633774e-08,
+ 0.999244623719389, 0.771559070589063, 0.755484449904079, 0.32158661418337,
+ 0.990124565656718, 0.495611922963992, 0.749561639456282)), .Names = c("num Df",
+ "den Df", "MSE", "F", "ges", "Pr(>F)"), heading = c("Anova Table (Type 3 tests)\n",
+ "Response: value"), row.names = c("treatment", "gender", "treatment:gender",
+ "phase", "treatment:phase", "gender:phase", "treatment:gender:phase",
+ "hour", "treatment:hour", "gender:hour", "treatment:gender:hour",
+ "phase:hour", "treatment:phase:hour", "gender:phase:hour", "treatment:gender:phase:hour"
+ ), class = c("data.frame"))
+ anova_tab$`Pr(>F)` <- p.adjust(anova_tab$`Pr(>F)`, method = "bonferroni")
+
+ expect_equal(out1[["anova_table"]], anova_tab, check.attributes = FALSE)
+
+})
diff --git a/tests/testthat/test-aov_car-basic.car-bugs.R b/tests/testthat/test-aov_car-bugs.R
similarity index 94%
rename from tests/testthat/test-aov_car-basic.car-bugs.R
rename to tests/testthat/test-aov_car-bugs.R
index 3f2bf24..81f8752 100644
--- a/tests/testthat/test-aov_car-basic.car-bugs.R
+++ b/tests/testthat/test-aov_car-bugs.R
@@ -1,183 +1,194 @@
-
-context("ANOVAs: known bugs")
-
-test_that("another label bug (May 2014)", {
- data("sk2011.1")
- levels(sk2011.1$inference) <- c("A+:D-", "A+:D+", "A-:D+", "A- : D-")
- expect_is(suppressWarnings(aov_ez("id", "response", sk2011.1, between = "instruction", within = c("type", "inference"), return = "Anova")), "Anova.mlm")
-})
-
-test_that("orig label bug", {
- data(obk.long)
- obk2 <- obk.long
- levels(obk2$phase) <- c("fup test", "post-hans", "pre tenetious")
- expect_is(suppressWarnings(aov_car(value ~ treatment * gender + age + Error(id/phase*hour), data = obk2, factorize=FALSE, return = "Anova")), "Anova.mlm")
-})
-
-test_that("ANCOVA check bug (reported by Gang Chen), January 2013", {
- dat <- read.table(header=TRUE, text = "ID Group Gender ROI Value Propdd00 GAS0 MAD0 CPD0
-2016 AE M 05_06 1.581 0.543 1.908 0.439999999999998 -0.5335
-2016 AE M 07_08 1.521 0.543 1.908 0.439999999999998 -0.5335
-2016 AE M 09_10 1.623 0.543 1.908 0.439999999999998 -0.5335
-2016 AE M 03_04 1.569 0.543 1.908 0.439999999999998 -0.5335
-2016 AE M 11_12 1.719 0.543 1.908 0.439999999999998 -0.5335
-2016 AE M 01_02 1.509 0.543 1.908 0.439999999999998 -0.5335
-2031 HC F 09_10 1.739 -0.014 0.0480000000000018 -2.347 1.9665
-2031 HC F 01_02 1.763 -0.014 0.0480000000000018 -2.347 1.9665
-2031 HC F 03_04 1.8 -0.014 0.0480000000000018 -2.347 1.9665
-2031 HC F 11_12 1.793 -0.014 0.0480000000000018 -2.347 1.9665
-2031 HC F 05_06 1.765 -0.014 0.0480000000000018 -2.347 1.9665
-2031 HC F 07_08 1.654 -0.014 0.0480000000000018 -2.347 1.9665
-2063 AE F 11_12 1.742 -0.027 2.348 -8.88 -0.0335000000000001
-2063 AE F 01_02 1.634 -0.027 2.348 -8.88 -0.0335000000000001
-2063 AE F 03_04 1.638 -0.027 2.348 -8.88 -0.0335000000000001
-2063 AE F 07_08 1.604 -0.027 2.348 -8.88 -0.0335000000000001
-2063 AE F 09_10 1.654 -0.027 2.348 -8.88 -0.0335000000000001
-2063 AE F 05_06 1.625 -0.027 2.348 -8.88 -0.0335000000000001
-2042 HC M 05_06 1.649 -0.014 2.058 -3.497 -0.8635
-2042 HC M 07_08 1.565 -0.014 2.058 -3.497 -0.8635
-2042 HC M 09_10 1.765 -0.014 2.058 -3.497 -0.8635
-2042 HC M 03_04 1.677 -0.014 2.058 -3.497 -0.8635
-2042 HC M 11_12 1.706 -0.014 2.058 -3.497 -0.8635
-2042 HC M 01_02 1.618 -0.014 2.058 -3.497 -0.8635
-2071 AE M 05_06 1.712 -0.317 -0.802 6.74 1.9665
-2071 AE M 07_08 1.64 -0.317 -0.802 6.74 1.9665
-2071 AE M 09_10 1.791 -0.317 -0.802 6.74 1.9665
-2071 AE M 03_04 1.725 -0.317 -0.802 6.74 1.9665
-2071 AE M 11_12 1.782 -0.317 -0.802 6.74 1.9665
-2071 AE M 01_02 1.712 -0.317 -0.802 6.74 1.9665
-2134 HC M 05_06 1.672 -0.014 0.347999999999999 -5.807 -2.5335
-2134 HC M 07_08 1.657 -0.014 0.347999999999999 -5.807 -2.5335
-2134 HC M 09_10 1.791 -0.014 0.347999999999999 -5.807 -2.5335
-2134 HC M 03_04 1.633 -0.014 0.347999999999999 -5.807 -2.5335
-2134 HC M 11_12 1.859 -0.014 0.347999999999999 -5.807 -2.5335
-2134 HC M 01_02 1.653 -0.014 0.347999999999999 -5.807 -2.5335
-2009 AE F 09_10 1.672 -0.027 1.058 3.36 11.1365
-2009 AE F 03_04 1.723 -0.027 1.058 3.36 11.1365
-2009 AE F 05_06 1.676 -0.027 1.058 3.36 11.1365
-2009 AE F 07_08 1.622 -0.027 1.058 3.36 11.1365
-2009 AE F 01_02 1.633 -0.027 1.058 3.36 11.1365
-2009 AE F 11_12 1.853 -0.027 1.058 3.36 11.1365
-2132 HC M 05_06 1.758 -0.014 -1.082 -2.857 -0.0335000000000001
-2132 HC M 07_08 1.623 -0.014 -1.082 -2.857 -0.0335000000000001
-2132 HC M 09_10 1.843 -0.014 -1.082 -2.857 -0.0335000000000001
-2132 HC M 03_04 1.773 -0.014 -1.082 -2.857 -0.0335000000000001
-2132 HC M 11_12 1.806 -0.014 -1.082 -2.857 -0.0335000000000001
-2132 HC M 01_02 1.708 -0.014 -1.082 -2.857 -0.0335000000000001
-2127 HC F 11_12 1.824 -0.014 0.628 6.223 -0.5335
-2127 HC F 09_10 1.871 -0.014 0.628 6.223 -0.5335
-2127 HC F 01_02 1.687 -0.014 0.628 6.223 -0.5335
-2127 HC F 03_04 1.699 -0.014 0.628 6.223 -0.5335
-2127 HC F 07_08 1.646 -0.014 0.628 6.223 -0.5335
-2127 HC F 05_06 1.738 -0.014 0.628 6.223 -0.5335
-2081 AE M 09_10 1.807 -0.027 -2.082 2.43 -1.5335
-2081 AE M 11_12 1.917 -0.027 -2.082 2.43 -1.5335
-2081 AE M 03_04 1.767 -0.027 -2.082 2.43 -1.5335
-2081 AE M 05_06 1.776 -0.027 -2.082 2.43 -1.5335
-2081 AE M 07_08 1.733 -0.027 -2.082 2.43 -1.5335
-2081 AE M 01_02 1.775 -0.027 -2.082 2.43 -1.5335
-2086 AE F 11_12 1.768 -0.457 -1.082 -1.76 6.9665
-2086 AE F 09_10 1.769 -0.457 -1.082 -1.76 6.9665
-2086 AE F 01_02 1.752 -0.457 -1.082 -1.76 6.9665
-2086 AE F 03_04 1.769 -0.457 -1.082 -1.76 6.9665
-2086 AE F 05_06 1.751 -0.457 -1.082 -1.76 6.9665
-2086 AE F 07_08 1.728 -0.457 -1.082 -1.76 6.9665
-2033 HC M 05_06 1.804 0.126 2.768 7.083 -2.2035
-2033 HC M 07_08 1.784 0.126 2.768 7.083 -2.2035
-2033 HC M 09_10 1.948 0.126 2.768 7.083 -2.2035
-2033 HC M 03_04 1.821 0.126 2.768 7.083 -2.2035
-2033 HC M 11_12 2.143 0.126 2.768 7.083 -2.2035
-2033 HC M 01_02 1.824 0.126 2.768 7.083 -2.2035
-2007 AE M 07_08 1.554 -0.027 0.488 -6.05 -0.5335
-2007 AE M 05_06 1.643 -0.027 0.488 -6.05 -0.5335
-2007 AE M 09_10 1.674 -0.027 0.488 -6.05 -0.5335
-2007 AE M 03_04 1.593 -0.027 0.488 -6.05 -0.5335
-2007 AE M 11_12 1.726 -0.027 0.488 -6.05 -0.5335
-2007 AE M 01_02 1.517 -0.027 0.488 -6.05 -0.5335
-6062 HC M 05_06 1.911 -0.014 -3.802 4.093 -3.5335
-6062 HC M 07_08 1.887 -0.014 -3.802 4.093 -3.5335
-6062 HC M 09_10 1.951 -0.014 -3.802 4.093 -3.5335
-6062 HC M 03_04 1.798 -0.014 -3.802 4.093 -3.5335
-6062 HC M 11_12 1.953 -0.014 -3.802 4.093 -3.5335
-6062 HC M 01_02 1.772 -0.014 -3.802 4.093 -3.5335
-2072 AE M 05_06 1.667 0.253 1.908 0.289999999999999 -1.0335
-2072 AE M 07_08 1.587 0.253 1.908 0.289999999999999 -1.0335
-2072 AE M 09_10 1.739 0.253 1.908 0.289999999999999 -1.0335
-2072 AE M 03_04 1.638 0.253 1.908 0.289999999999999 -1.0335
-2072 AE M 11_12 1.784 0.253 1.908 0.289999999999999 -1.0335
-2072 AE M 01_02 1.662 0.253 1.908 0.289999999999999 -1.0335
-2008 HC F 05_06 1.623 -0.014 -1.372 -2.317 2.1365
-2008 HC F 07_08 1.6 -0.014 -1.372 -2.317 2.1365
-2008 HC F 09_10 1.688 -0.014 -1.372 -2.317 2.1365
-2008 HC F 03_04 1.624 -0.014 -1.372 -2.317 2.1365
-2008 HC F 11_12 1.772 -0.014 -1.372 -2.317 2.1365
-2008 HC F 01_02 1.656 -0.014 -1.372 -2.317 2.1365
-2070 AE F 05_06 1.657 0.113 -1.372 -0.140000000000001 -5.5335
-2070 AE F 07_08 1.579 0.113 -1.372 -0.140000000000001 -5.5335
-2070 AE F 09_10 1.75 0.113 -1.372 -0.140000000000001 -5.5335
-2070 AE F 03_04 1.808 0.113 -1.372 -0.140000000000001 -5.5335
-2070 AE F 11_12 1.777 0.113 -1.372 -0.140000000000001 -5.5335
-2070 AE F 01_02 1.702 0.113 -1.372 -0.140000000000001 -5.5335
-2064 AE F 11_12 1.781 -0.027 -5.512 3.57 -3.5335
-2064 AE F 09_10 1.724 -0.027 -5.512 3.57 -3.5335
-2064 AE F 01_02 1.631 -0.027 -5.512 3.57 -3.5335
-2064 AE F 03_04 1.607 -0.027 -5.512 3.57 -3.5335
-2064 AE F 05_06 1.577 -0.027 -5.512 3.57 -3.5335
-2064 AE F 07_08 1.546 -0.027 -5.512 3.57 -3.5335
-2039 HC M 09_10 1.879 -0.014 2.628 -1.867 -5.5335
-2039 HC M 11_12 1.918 -0.014 2.628 -1.867 -5.5335
-2039 HC M 03_04 1.794 -0.014 2.628 -1.867 -5.5335
-2039 HC M 05_06 1.787 -0.014 2.628 -1.867 -5.5335
-2039 HC M 07_08 1.687 -0.014 2.628 -1.867 -5.5335
-2039 HC M 01_02 1.774 -0.014 2.628 -1.867 -5.5335
-2117 HC F 09_10 1.712 -0.014 0.917999999999999 1.293 3.7965
-2117 HC F 11_12 1.75 -0.014 0.917999999999999 1.293 3.7965
-2117 HC F 03_04 1.717 -0.014 0.917999999999999 1.293 3.7965
-2117 HC F 07_08 1.587 -0.014 0.917999999999999 1.293 3.7965
-2117 HC F 05_06 1.667 -0.014 0.917999999999999 1.293 3.7965
-2117 HC F 01_02 1.663 -0.014 0.917999999999999 1.293 3.7965
-")
- dat$ID <- as.factor(dat$ID)
- fm <- suppressWarnings(aov_car(Value ~ Propdd00 + Group + Gender + GAS0 + MAD0 + CPD0 + Error(ID/ROI), data=dat, factorize=FALSE, return = "Anova"))
- fm0 <- suppressWarnings(aov_car(Value ~ MAD0 + CPD0 + Error(ID/ROI), data=dat, factorize=FALSE, return='afex_aov'))
- expect_is(fm, "Anova.mlm")
- expect_is(fm0, "afex_aov")
-})
-
-
-test_that("ANOVA: ids in multiple between.subjects conditions", {
- species<- c("a","b","c","c","b","c","b","b","a","b","c","c","a","a","b","b","a","a","b","c")
- habitat<- c("x","x","x","y","y","y","x","x","y","z","y","y","z","z","x","x","y","y","z","z")
- mvt.rate<-c(6,5,7,8,9,4,3,5,6,9,3,6,6,7,8,9,5,6,7,8)
- ind<-as.factor(c(1,2,3,4,1,2,3,4,1,2,3,4,1,2,3,4,1,2,3,4))
- data1<-data.frame(species, habitat, mvt.rate, ind)
- # should give an error
- expect_error(aov_ez("ind", "mvt.rate", data1, within = "habitat", between = "species"), "Following ids are in more than one between subjects condition:")
-})
-
-test_that("empty factors are not causing aov.cat to choke", {
- data(sleepstudy) #Example data in lme4
- sleepstudy$Days<-factor(sleepstudy$Days)
- #Works with all factors
- expect_is(aov_ez("Subject","Reaction",sleepstudy, within="Days", return = "Anova"), "Anova.mlm")
- #If you remove a factor it fails...
- expect_is(aov_ez("Subject","Reaction",sleepstudy[sleepstudy$Days!=9,], within="Days", return = "Anova"), "Anova.mlm")
-})
-
-test_that("factors have more than one level", {
- data(obk.long)
- expect_error(aov_car(value ~ treatment+ Error(id/phase), data = obk.long[ obk.long$treatment == "control",]), "one level only.")
- expect_error(aov_car(value ~ treatment+ Error(id/phase), data = obk.long[ obk.long$phase == "pre",]), "one level only.")
-})
-
-
-test_that("variable names longer", {
- data(obk.long)
- obk.long$gender2 <- obk.long$treatment
- orig <- aov_car(value ~ treatment * gender + age + Error(id/phase*hour), data = obk.long, factorize=FALSE, observed = "gender")
- v1 <- aov_car(value ~ gender2 * gender + age + Error(id/phase*hour), data = obk.long, factorize=FALSE, observed = "gender")
- v2 <- aov_car(value ~ gender2 * gender + age + Error(id/phase*hour), data = obk.long, factorize=FALSE, observed = "gender2")
- expect_identical(nice(orig)[,-1], nice(v1)[,-1])
- expect_identical(nice(orig)[,-c(1)], nice(v2)[,-c(1)])
-})
-
+
+context("ANOVAs: known bugs")
+
+test_that("regex works correctly in aov_car when also having within factors outside the Error term", {
+ data(obk.long)
+ expect_is(aov_car(value ~ treatment * gender*phase*hour + Error(id/phase*hour), data = obk.long), "afex_aov")
+})
+
+test_that("another label bug (May 2014)", {
+ data("sk2011.1")
+ levels(sk2011.1$inference) <- c("A+:D-", "A+:D+", "A-:D+", "A- : D-")
+ expect_is(suppressWarnings(aov_ez("id", "response", sk2011.1, between = "instruction", within = c("type", "inference"), return = "Anova")), "Anova.mlm")
+})
+
+test_that("orig label bug", {
+ data(obk.long)
+ obk2 <- obk.long
+ levels(obk2$phase) <- c("fup test", "post-hans", "pre tenetious")
+ expect_is(suppressWarnings(aov_car(value ~ treatment * gender + age + Error(id/phase*hour), data = obk2, factorize=FALSE, return = "Anova")), "Anova.mlm")
+})
+
+test_that("ANCOVA check bug (reported by Gang Chen), January 2013", {
+ dat <- read.table(header=TRUE, text = "ID Group Gender ROI Value Propdd00 GAS0 MAD0 CPD0
+2016 AE M 05_06 1.581 0.543 1.908 0.439999999999998 -0.5335
+2016 AE M 07_08 1.521 0.543 1.908 0.439999999999998 -0.5335
+2016 AE M 09_10 1.623 0.543 1.908 0.439999999999998 -0.5335
+2016 AE M 03_04 1.569 0.543 1.908 0.439999999999998 -0.5335
+2016 AE M 11_12 1.719 0.543 1.908 0.439999999999998 -0.5335
+2016 AE M 01_02 1.509 0.543 1.908 0.439999999999998 -0.5335
+2031 HC F 09_10 1.739 -0.014 0.0480000000000018 -2.347 1.9665
+2031 HC F 01_02 1.763 -0.014 0.0480000000000018 -2.347 1.9665
+2031 HC F 03_04 1.8 -0.014 0.0480000000000018 -2.347 1.9665
+2031 HC F 11_12 1.793 -0.014 0.0480000000000018 -2.347 1.9665
+2031 HC F 05_06 1.765 -0.014 0.0480000000000018 -2.347 1.9665
+2031 HC F 07_08 1.654 -0.014 0.0480000000000018 -2.347 1.9665
+2063 AE F 11_12 1.742 -0.027 2.348 -8.88 -0.0335000000000001
+2063 AE F 01_02 1.634 -0.027 2.348 -8.88 -0.0335000000000001
+2063 AE F 03_04 1.638 -0.027 2.348 -8.88 -0.0335000000000001
+2063 AE F 07_08 1.604 -0.027 2.348 -8.88 -0.0335000000000001
+2063 AE F 09_10 1.654 -0.027 2.348 -8.88 -0.0335000000000001
+2063 AE F 05_06 1.625 -0.027 2.348 -8.88 -0.0335000000000001
+2042 HC M 05_06 1.649 -0.014 2.058 -3.497 -0.8635
+2042 HC M 07_08 1.565 -0.014 2.058 -3.497 -0.8635
+2042 HC M 09_10 1.765 -0.014 2.058 -3.497 -0.8635
+2042 HC M 03_04 1.677 -0.014 2.058 -3.497 -0.8635
+2042 HC M 11_12 1.706 -0.014 2.058 -3.497 -0.8635
+2042 HC M 01_02 1.618 -0.014 2.058 -3.497 -0.8635
+2071 AE M 05_06 1.712 -0.317 -0.802 6.74 1.9665
+2071 AE M 07_08 1.64 -0.317 -0.802 6.74 1.9665
+2071 AE M 09_10 1.791 -0.317 -0.802 6.74 1.9665
+2071 AE M 03_04 1.725 -0.317 -0.802 6.74 1.9665
+2071 AE M 11_12 1.782 -0.317 -0.802 6.74 1.9665
+2071 AE M 01_02 1.712 -0.317 -0.802 6.74 1.9665
+2134 HC M 05_06 1.672 -0.014 0.347999999999999 -5.807 -2.5335
+2134 HC M 07_08 1.657 -0.014 0.347999999999999 -5.807 -2.5335
+2134 HC M 09_10 1.791 -0.014 0.347999999999999 -5.807 -2.5335
+2134 HC M 03_04 1.633 -0.014 0.347999999999999 -5.807 -2.5335
+2134 HC M 11_12 1.859 -0.014 0.347999999999999 -5.807 -2.5335
+2134 HC M 01_02 1.653 -0.014 0.347999999999999 -5.807 -2.5335
+2009 AE F 09_10 1.672 -0.027 1.058 3.36 11.1365
+2009 AE F 03_04 1.723 -0.027 1.058 3.36 11.1365
+2009 AE F 05_06 1.676 -0.027 1.058 3.36 11.1365
+2009 AE F 07_08 1.622 -0.027 1.058 3.36 11.1365
+2009 AE F 01_02 1.633 -0.027 1.058 3.36 11.1365
+2009 AE F 11_12 1.853 -0.027 1.058 3.36 11.1365
+2132 HC M 05_06 1.758 -0.014 -1.082 -2.857 -0.0335000000000001
+2132 HC M 07_08 1.623 -0.014 -1.082 -2.857 -0.0335000000000001
+2132 HC M 09_10 1.843 -0.014 -1.082 -2.857 -0.0335000000000001
+2132 HC M 03_04 1.773 -0.014 -1.082 -2.857 -0.0335000000000001
+2132 HC M 11_12 1.806 -0.014 -1.082 -2.857 -0.0335000000000001
+2132 HC M 01_02 1.708 -0.014 -1.082 -2.857 -0.0335000000000001
+2127 HC F 11_12 1.824 -0.014 0.628 6.223 -0.5335
+2127 HC F 09_10 1.871 -0.014 0.628 6.223 -0.5335
+2127 HC F 01_02 1.687 -0.014 0.628 6.223 -0.5335
+2127 HC F 03_04 1.699 -0.014 0.628 6.223 -0.5335
+2127 HC F 07_08 1.646 -0.014 0.628 6.223 -0.5335
+2127 HC F 05_06 1.738 -0.014 0.628 6.223 -0.5335
+2081 AE M 09_10 1.807 -0.027 -2.082 2.43 -1.5335
+2081 AE M 11_12 1.917 -0.027 -2.082 2.43 -1.5335
+2081 AE M 03_04 1.767 -0.027 -2.082 2.43 -1.5335
+2081 AE M 05_06 1.776 -0.027 -2.082 2.43 -1.5335
+2081 AE M 07_08 1.733 -0.027 -2.082 2.43 -1.5335
+2081 AE M 01_02 1.775 -0.027 -2.082 2.43 -1.5335
+2086 AE F 11_12 1.768 -0.457 -1.082 -1.76 6.9665
+2086 AE F 09_10 1.769 -0.457 -1.082 -1.76 6.9665
+2086 AE F 01_02 1.752 -0.457 -1.082 -1.76 6.9665
+2086 AE F 03_04 1.769 -0.457 -1.082 -1.76 6.9665
+2086 AE F 05_06 1.751 -0.457 -1.082 -1.76 6.9665
+2086 AE F 07_08 1.728 -0.457 -1.082 -1.76 6.9665
+2033 HC M 05_06 1.804 0.126 2.768 7.083 -2.2035
+2033 HC M 07_08 1.784 0.126 2.768 7.083 -2.2035
+2033 HC M 09_10 1.948 0.126 2.768 7.083 -2.2035
+2033 HC M 03_04 1.821 0.126 2.768 7.083 -2.2035
+2033 HC M 11_12 2.143 0.126 2.768 7.083 -2.2035
+2033 HC M 01_02 1.824 0.126 2.768 7.083 -2.2035
+2007 AE M 07_08 1.554 -0.027 0.488 -6.05 -0.5335
+2007 AE M 05_06 1.643 -0.027 0.488 -6.05 -0.5335
+2007 AE M 09_10 1.674 -0.027 0.488 -6.05 -0.5335
+2007 AE M 03_04 1.593 -0.027 0.488 -6.05 -0.5335
+2007 AE M 11_12 1.726 -0.027 0.488 -6.05 -0.5335
+2007 AE M 01_02 1.517 -0.027 0.488 -6.05 -0.5335
+6062 HC M 05_06 1.911 -0.014 -3.802 4.093 -3.5335
+6062 HC M 07_08 1.887 -0.014 -3.802 4.093 -3.5335
+6062 HC M 09_10 1.951 -0.014 -3.802 4.093 -3.5335
+6062 HC M 03_04 1.798 -0.014 -3.802 4.093 -3.5335
+6062 HC M 11_12 1.953 -0.014 -3.802 4.093 -3.5335
+6062 HC M 01_02 1.772 -0.014 -3.802 4.093 -3.5335
+2072 AE M 05_06 1.667 0.253 1.908 0.289999999999999 -1.0335
+2072 AE M 07_08 1.587 0.253 1.908 0.289999999999999 -1.0335
+2072 AE M 09_10 1.739 0.253 1.908 0.289999999999999 -1.0335
+2072 AE M 03_04 1.638 0.253 1.908 0.289999999999999 -1.0335
+2072 AE M 11_12 1.784 0.253 1.908 0.289999999999999 -1.0335
+2072 AE M 01_02 1.662 0.253 1.908 0.289999999999999 -1.0335
+2008 HC F 05_06 1.623 -0.014 -1.372 -2.317 2.1365
+2008 HC F 07_08 1.6 -0.014 -1.372 -2.317 2.1365
+2008 HC F 09_10 1.688 -0.014 -1.372 -2.317 2.1365
+2008 HC F 03_04 1.624 -0.014 -1.372 -2.317 2.1365
+2008 HC F 11_12 1.772 -0.014 -1.372 -2.317 2.1365
+2008 HC F 01_02 1.656 -0.014 -1.372 -2.317 2.1365
+2070 AE F 05_06 1.657 0.113 -1.372 -0.140000000000001 -5.5335
+2070 AE F 07_08 1.579 0.113 -1.372 -0.140000000000001 -5.5335
+2070 AE F 09_10 1.75 0.113 -1.372 -0.140000000000001 -5.5335
+2070 AE F 03_04 1.808 0.113 -1.372 -0.140000000000001 -5.5335
+2070 AE F 11_12 1.777 0.113 -1.372 -0.140000000000001 -5.5335
+2070 AE F 01_02 1.702 0.113 -1.372 -0.140000000000001 -5.5335
+2064 AE F 11_12 1.781 -0.027 -5.512 3.57 -3.5335
+2064 AE F 09_10 1.724 -0.027 -5.512 3.57 -3.5335
+2064 AE F 01_02 1.631 -0.027 -5.512 3.57 -3.5335
+2064 AE F 03_04 1.607 -0.027 -5.512 3.57 -3.5335
+2064 AE F 05_06 1.577 -0.027 -5.512 3.57 -3.5335
+2064 AE F 07_08 1.546 -0.027 -5.512 3.57 -3.5335
+2039 HC M 09_10 1.879 -0.014 2.628 -1.867 -5.5335
+2039 HC M 11_12 1.918 -0.014 2.628 -1.867 -5.5335
+2039 HC M 03_04 1.794 -0.014 2.628 -1.867 -5.5335
+2039 HC M 05_06 1.787 -0.014 2.628 -1.867 -5.5335
+2039 HC M 07_08 1.687 -0.014 2.628 -1.867 -5.5335
+2039 HC M 01_02 1.774 -0.014 2.628 -1.867 -5.5335
+2117 HC F 09_10 1.712 -0.014 0.917999999999999 1.293 3.7965
+2117 HC F 11_12 1.75 -0.014 0.917999999999999 1.293 3.7965
+2117 HC F 03_04 1.717 -0.014 0.917999999999999 1.293 3.7965
+2117 HC F 07_08 1.587 -0.014 0.917999999999999 1.293 3.7965
+2117 HC F 05_06 1.667 -0.014 0.917999999999999 1.293 3.7965
+2117 HC F 01_02 1.663 -0.014 0.917999999999999 1.293 3.7965
+")
+ dat$ID <- as.factor(dat$ID)
+ fm <- suppressWarnings(aov_car(Value ~ Propdd00 + Group + Gender + GAS0 + MAD0 + CPD0 + Error(ID/ROI), data=dat, factorize=FALSE, return = "Anova"))
+ fm0 <- suppressWarnings(aov_car(Value ~ MAD0 + CPD0 + Error(ID/ROI), data=dat, factorize=FALSE, return='afex_aov'))
+ expect_is(fm, "Anova.mlm")
+ expect_is(fm0, "afex_aov")
+})
+
+
+test_that("ANOVA: ids in multiple between.subjects conditions", {
+ species<- c("a","b","c","c","b","c","b","b","a","b","c","c","a","a","b","b","a","a","b","c")
+ habitat<- c("x","x","x","y","y","y","x","x","y","z","y","y","z","z","x","x","y","y","z","z")
+ mvt.rate<-c(6,5,7,8,9,4,3,5,6,9,3,6,6,7,8,9,5,6,7,8)
+ ind<-as.factor(c(1,2,3,4,1,2,3,4,1,2,3,4,1,2,3,4,1,2,3,4))
+ data1<-data.frame(species, habitat, mvt.rate, ind)
+ # should give an error
+ expect_error(aov_ez("ind", "mvt.rate", data1, within = "habitat", between = "species"), "Following ids are in more than one between subjects condition:")
+})
+
+test_that("empty factors are not causing aov.cat to choke", {
+ data(sleepstudy) #Example data in lme4
+ sleepstudy$Days<-factor(sleepstudy$Days)
+ #Works with all factors
+ expect_is(aov_ez("Subject","Reaction",sleepstudy, within="Days", return = "Anova"), "Anova.mlm")
+ #If you remove a factor it fails...
+ expect_is(aov_ez("Subject","Reaction",sleepstudy[sleepstudy$Days!=9,], within="Days", return = "Anova"), "Anova.mlm")
+})
+
+test_that("factors have more than one level", {
+ data(obk.long)
+ expect_error(aov_car(value ~ treatment+ Error(id/phase), data = obk.long[ obk.long$treatment == "control",]), "one level only.")
+ expect_error(aov_car(value ~ treatment+ Error(id/phase), data = obk.long[ obk.long$phase == "pre",]), "one level only.")
+})
+
+
+test_that("variable names longer", {
+ data(obk.long)
+ obk.long$gender2 <- obk.long$treatment
+ orig <- aov_car(value ~ treatment * gender + age + Error(id/phase*hour), data = obk.long, factorize=FALSE, observed = "gender")
+ v1 <- aov_car(value ~ gender2 * gender + age + Error(id/phase*hour), data = obk.long, factorize=FALSE, observed = "gender")
+ v2 <- aov_car(value ~ gender2 * gender + age + Error(id/phase*hour), data = obk.long, factorize=FALSE, observed = "gender2")
+ expect_identical(nice(orig)[,-1], nice(v1)[,-1])
+ expect_identical(nice(orig)[,-c(1)], nice(v2)[,-c(1)])
+})
+
+test_that("works with dplyr data.frames (see https://github.com/singmann/afex/issues/6):", {
+ require(dplyr)
+ data(md_12.1)
+ md2 <- tbl_df(md_12.1)
+ expect_is(aov_ez("id", "rt", md2, within = c("angle", "noise"), anova_table=list(correction = "none", es = "none")), "afex_aov")
+})
diff --git a/tests/testthat/test-aov_car-basic.car-structural.R b/tests/testthat/test-aov_car-structural.R
similarity index 98%
rename from tests/testthat/test-aov_car-basic.car-structural.R
rename to tests/testthat/test-aov_car-structural.R
index 8971b5d..f03d5cb 100644
--- a/tests/testthat/test-aov_car-basic.car-structural.R
+++ b/tests/testthat/test-aov_car-structural.R
@@ -1,42 +1,42 @@
-
-context("ANOVAs: structural tests")
-
-test_that("dv is numeric", {
- data(obk.long)
- expect_that(aov_car(treatment ~ gender + Error(id/phase*hour), data = obk.long, observed = "gender"), throws_error("dv needs to be numeric."))
-})
-
-test_that("non Type 3 sums give warning", {
- data(obk.long)
- expect_that(aov_4(value ~ treatment * gender + (phase*hour|id), data = obk.long, observed = "gender", check.contrasts = FALSE), gives_warning("contrasts"))
-})
-
-test_that("return='aov' works", {
- data(obk.long)
- data(md_12.1)
-
- # purely within
- expect_that(aov_ez("id", "rt", md_12.1, within = c("angle", "noise"), return = "aov"), is_a(c( "aovlist", "listof" )))
- expect_that(aov_car(value ~ Error(id/phase*hour), data = obk.long, return = "aov"), is_a(c( "aovlist", "listof" )))
- #purely between
- expect_that(suppressWarnings(aov_car(value ~ treatment * gender + Error(id), data = obk.long, return = "aov")), is_a(c( "aov")))
- expect_that(suppressWarnings(aov_car(value~treatment * gender + Error(id/phase*hour), data = obk.long, return = "aov")), is_a(c( "aovlist", "listof" )))
-
- # terms within Error() are within parentheses:
- test <- summary(aov_car(value ~ Error(id/phase*hour), data = obk.long, return = "aov"))
- positive <- summary(aov(value ~ phase*hour+Error(id/(phase*hour)), data = obk.long))
- negative <- summary(aov(value ~ phase*hour+Error(id/phase*hour), data = obk.long))
- expect_equal(test, positive)
- expect_false(isTRUE(all.equal(test, negative, check.attributes = FALSE)))
-
- orig1 <- aov_car(value ~ Error(id/phase*hour), data = obk.long)
- obk.long$id <- as.numeric(obk.long$id)
- obk.long$phase <- as.numeric(obk.long$phase)
- obk.long$hour <- as.numeric(obk.long$hour)
- positive2 <- summary(aov_car(value ~ Error(id/phase*hour), data = obk.long, return = "aov"))
- expect_equal(test, positive2)
- positive3 <- aov_car(value ~ Error(id/phase*hour), data = obk.long)
- expect_equal(summary(orig1), summary(positive3))
- expect_equal(summary(orig1$Anova, multivariate = FALSE), summary(positive3$Anova, multivariate = FALSE))
- expect_equal(summary(orig1$aov), summary(positive3$aov))
-})
+
+context("ANOVAs: structural tests")
+
+test_that("dv is numeric", {
+ data(obk.long)
+ expect_that(aov_car(treatment ~ gender + Error(id/phase*hour), data = obk.long, observed = "gender"), throws_error("dv needs to be numeric."))
+})
+
+test_that("non Type 3 sums give warning", {
+ data(obk.long)
+ expect_that(aov_4(value ~ treatment * gender + (phase*hour|id), data = obk.long, observed = "gender", check.contrasts = FALSE), gives_warning("contrasts"))
+})
+
+test_that("return='aov' works", {
+ data(obk.long)
+ data(md_12.1)
+
+ # purely within
+ expect_that(aov_ez("id", "rt", md_12.1, within = c("angle", "noise"), return = "aov"), is_a(c( "aovlist", "listof" )))
+ expect_that(aov_car(value ~ Error(id/phase*hour), data = obk.long, return = "aov"), is_a(c( "aovlist", "listof" )))
+ #purely between
+ expect_that(suppressWarnings(aov_car(value ~ treatment * gender + Error(id), data = obk.long, return = "aov")), is_a(c( "aov")))
+ expect_that(suppressWarnings(aov_car(value~treatment * gender + Error(id/phase*hour), data = obk.long, return = "aov")), is_a(c( "aovlist", "listof" )))
+
+ # terms within Error() are within parentheses:
+ test <- summary(aov_car(value ~ Error(id/phase*hour), data = obk.long, return = "aov"))
+ positive <- summary(aov(value ~ phase*hour+Error(id/(phase*hour)), data = obk.long))
+ negative <- summary(aov(value ~ phase*hour+Error(id/phase*hour), data = obk.long))
+ expect_equal(test, positive)
+ expect_false(isTRUE(all.equal(test, negative, check.attributes = FALSE)))
+
+ orig1 <- aov_car(value ~ Error(id/phase*hour), data = obk.long)
+ obk.long$id <- as.numeric(obk.long$id)
+ obk.long$phase <- as.numeric(obk.long$phase)
+ obk.long$hour <- as.numeric(obk.long$hour)
+ positive2 <- summary(aov_car(value ~ Error(id/phase*hour), data = obk.long, return = "aov"))
+ expect_equal(test, positive2)
+ positive3 <- aov_car(value ~ Error(id/phase*hour), data = obk.long)
+ expect_equal(summary(orig1), summary(positive3))
+ expect_equal(summary(orig1$Anova, multivariate = FALSE), summary(positive3$Anova, multivariate = FALSE))
+ expect_equal(summary(orig1$aov), summary(positive3$aov))
+})
diff --git a/tests/testthat/test-mixed-bugs.R b/tests/testthat/test-mixed-bugs.R
new file mode 100644
index 0000000..7f3cb58
--- /dev/null
+++ b/tests/testthat/test-mixed-bugs.R
@@ -0,0 +1,11 @@
+
+
+context("mixed: known bugs")
+
+test_that("mixed works with long formulas", {
+ data(obk.long)
+ obk2 <- obk.long
+ colnames(obk2) <- sapply(colnames(obk2), function(x) paste0(x, x, x, x, x, x))
+ expect_is(mixed(valuevaluevaluevaluevaluevalue ~ treatmenttreatmenttreatmenttreatmenttreatmenttreatment * phasephasephasephasephasephase * hourhourhourhourhourhour + (1|idididididid), obk2, method = "LRT", progress = FALSE), "mixed")
+})
+
diff --git a/tests/testthat/test-mixed-mw.R b/tests/testthat/test-mixed-mw.R
index 2cca5d1..466dcc3 100644
--- a/tests/testthat/test-mixed-mw.R
+++ b/tests/testthat/test-mixed-mw.R
@@ -1,46 +1,46 @@
-
-context("Mixed LMMs: replicating Maxwell & Delaney (2004)")
-
-test_that("mixed: Maxell & Delaney (2004), Table 16.3, p. 837", {
- ### replicate results from Table 16.3 (Maxwell & Delaney, 2004, p. 837)
- data(md_16.1)
- # original results need treatment contrasts:
- mixed1_orig <- mixed(severity ~ sex + (1|id), md_16.1, check.contrasts=FALSE, progress=FALSE)
- expect_that(fixef(mixed1_orig$full.model), is_equivalent_to(c(60, -14)))
- expect_that(round(anova(mixed1_orig)[1,"F"],2), equals(9.97))
- expect_that(round(anova(mixed1_orig)[1,"Pr(>F)"],2), equals(0.03))
-})
-
-test_that("mixed: Maxell & Delaney (2004), Table 16.6, p. 845", {
- data(md_16.4)
- md_16.4b <- within(md_16.4, cond <- C(cond, contr.treatment, base = 2))
- mixed2_orig <- mixed(induct ~ cond + (1|room:cond), md_16.4b, check.contrasts=FALSE, progress=FALSE)
- expect_that(round(fixef(mixed2_orig$full.model), 4), is_equivalent_to(c(35.6261, -8.1485)))
- expect_that(round(sqrt(diag(vcov(mixed2_orig$full.model))), 3), equals(c(3.229, 4.548)))
- expect_that(round(mixed2_orig[[1]]$F, 1), equals(3.2))
-})
-
-test_that("mixed: Maxell & Delaney (2004), Table 16.7, p. 851 (uses simple F!)", {
- data(md_16.4)
- md_16.4b <- within(md_16.4, cond <- C(cond, contr.treatment, base = 2))
- ### replicate results from Table 16.7 (Maxwell & Delaney, 2004, p. 851)
- # F-values (almost) hold, p-values (especially for skill) are off
- # however, parameters are perfectly recovered when using the original contrasts:
- mixed3_orig <- mixed(induct ~ cond + skill + (1|room:cond), md_16.4b, check.contrasts=FALSE, progress=FALSE)
- expect_that(round(fixef(mixed3_orig$full.model), 2), is_equivalent_to(c(20.25, -7.57, 2.31)))
- expect_that(round(sqrt(diag(vcov(mixed3_orig$full.model))), 2), equals(c(5.82, 2.72, 0.81)))
- expect_that(round(mixed3_orig[[1]]$F), equals(c(8, 8)))
- #mixed3_F_simple <- mixed(induct ~ cond + skill + (1|room:cond), md_16.4b, check.contrasts=FALSE, progress=FALSE, method = "F")
- #expect_that(round(fixef(mixed3_F_simple$full.model), 2), is_equivalent_to(c(20.25, -7.57, 2.31)))
- #expect_that(round(sqrt(diag(vcov(mixed3_F_simple$full.model))), 2), equals(c(5.82, 2.72, 0.81)))
- #expect_that(round(mixed3_F_simple[[1]]$F, 1), equals(c(7.8, 8.2)))
-})
-
-test_that("mixed: Maxell & Delaney (2004), Table 16.10, p. 862 (does not replicate the table!)", {
- data(md_16.4)
- md_16.4b <- within(md_16.4, cond <- C(cond, contr.treatment, base = 2))
- #note: the values in this test should not replicate the table...
- md_16.4b$cog <- scale(md_16.4b$cog, scale=FALSE)
- mixed4 <- mixed(induct ~ cond*cog + (cog|room:cond), md_16.4b, progress=FALSE, check.contrasts=FALSE)
- expect_that(round(fixef(mixed4$full.model), 2), is_equivalent_to(c(36.1, -9.07, 0.64, 0.03)))
-})
+
+context("Mixed LMMs: replicating Maxwell & Delaney (2004)")
+
+test_that("mixed: Maxell & Delaney (2004), Table 16.3, p. 837", {
+ ### replicate results from Table 16.3 (Maxwell & Delaney, 2004, p. 837)
+ data(md_16.1)
+ # original results need treatment contrasts:
+ mixed1_orig <- mixed(severity ~ sex + (1|id), md_16.1, check.contrasts=FALSE, progress=FALSE)
+ expect_that(fixef(mixed1_orig$full.model), is_equivalent_to(c(60, -14)))
+ expect_that(round(anova(mixed1_orig)[1,"F"],2), equals(9.97))
+ expect_that(round(anova(mixed1_orig)[1,"Pr(>F)"],2), equals(0.03))
+})
+
+test_that("mixed: Maxell & Delaney (2004), Table 16.6, p. 845", {
+ data(md_16.4)
+ md_16.4b <- within(md_16.4, cond <- C(cond, contr.treatment, base = 2))
+ mixed2_orig <- mixed(induct ~ cond + (1|room:cond), md_16.4b, check.contrasts=FALSE, progress=FALSE)
+ expect_that(round(fixef(mixed2_orig$full.model), 4), is_equivalent_to(c(35.6261, -8.1485)))
+ expect_that(round(sqrt(diag(vcov(mixed2_orig$full.model))), 3), equals(c(3.229, 4.548)))
+ expect_that(round(mixed2_orig[[1]]$F, 1), equals(3.2))
+})
+
+test_that("mixed: Maxell & Delaney (2004), Table 16.7, p. 851 (uses simple F!)", {
+ data(md_16.4)
+ md_16.4b <- within(md_16.4, cond <- C(cond, contr.treatment, base = 2))
+ ### replicate results from Table 16.7 (Maxwell & Delaney, 2004, p. 851)
+ # F-values (almost) hold, p-values (especially for skill) are off
+ # however, parameters are perfectly recovered when using the original contrasts:
+ mixed3_orig <- mixed(induct ~ cond + skill + (1|room:cond), md_16.4b, check.contrasts=FALSE, progress=FALSE)
+ expect_that(round(fixef(mixed3_orig$full.model), 2), is_equivalent_to(c(20.25, -7.57, 2.31)))
+ expect_that(round(sqrt(diag(vcov(mixed3_orig$full.model))), 2), equals(c(5.82, 2.72, 0.81)))
+ expect_that(round(mixed3_orig[[1]]$F), equals(c(8, 8)))
+ #mixed3_F_simple <- mixed(induct ~ cond + skill + (1|room:cond), md_16.4b, check.contrasts=FALSE, progress=FALSE, method = "F")
+ #expect_that(round(fixef(mixed3_F_simple$full.model), 2), is_equivalent_to(c(20.25, -7.57, 2.31)))
+ #expect_that(round(sqrt(diag(vcov(mixed3_F_simple$full.model))), 2), equals(c(5.82, 2.72, 0.81)))
+ #expect_that(round(mixed3_F_simple[[1]]$F, 1), equals(c(7.8, 8.2)))
+})
+
+test_that("mixed: Maxell & Delaney (2004), Table 16.10, p. 862 (does not replicate the table!)", {
+ data(md_16.4)
+ md_16.4b <- within(md_16.4, cond <- C(cond, contr.treatment, base = 2))
+ #note: the values in this test should not replicate the table...
+ md_16.4b$cog <- scale(md_16.4b$cog, scale=FALSE)
+ mixed4 <- mixed(induct ~ cond*cog + (cog|room:cond), md_16.4b, progress=FALSE, check.contrasts=FALSE)
+ expect_that(round(fixef(mixed4$full.model), 2), is_equivalent_to(c(36.1, -9.07, 0.64, 0.03)))
+})
diff --git a/tests/testthat/test-mixed-structure.R b/tests/testthat/test-mixed-structure.R
index f7b796d..232f03c 100644
--- a/tests/testthat/test-mixed-structure.R
+++ b/tests/testthat/test-mixed-structure.R
@@ -1,162 +1,162 @@
-
-context("Mixed: structural tests")
-
-# note: all calls with type 2 are wrapped in suppressWarnings()!
-
-test_that("mixed: Maxell & Delaney (2004), Table 16.4, p. 842: Type 2", {
- data(md_16.4)
- md_16.4b <- md_16.4
- md_16.4b$cog <- scale(md_16.4b$cog, scale=FALSE)
- contrasts(md_16.4b$cond) <- "contr.sum"
- suppressWarnings(mixed4_2 <- mixed(induct ~ cond*cog + (cog|room:cond), md_16.4b, type = 2, progress=FALSE))
- lmer4_full <- lmer(induct ~ cond*cog + (cog|room:cond), md_16.4b)
- lmer4_small <- lmer(induct ~ cond+cog + (cog|room:cond), md_16.4b)
- expect_that(fixef(mixed4_2$full.model[[2]]), equals(fixef(lmer4_full)))
- expect_that(fixef(mixed4_2$full.model[[1]]), is_equivalent_to(fixef(lmer4_small)))
-})
-
-test_that("mixed: Maxell & Delaney (2004), Table 16.4, p. 842: Type 3", {
- data(md_16.4)
- md_16.4b <- md_16.4
- md_16.4b$cog <- scale(md_16.4b$cog, scale=FALSE)
- contrasts(md_16.4b$cond) <- "contr.sum"
- suppressWarnings(mixed4_2 <- mixed(induct ~ cond*cog + (cog|room:cond), md_16.4b, type = 3, progress=FALSE))
- lmer4_full <- lmer(induct ~ cond*cog + (cog|room:cond), md_16.4b)
- lmer4_small <- lmer(induct ~ cond+cog + (cog|room:cond), md_16.4b)
- expect_that(fixef(mixed4_2$full.model), equals(fixef(lmer4_full)))
- expect_that(mixed4_2$full.model, is_equivalent_to(lmer4_full))
- expect_that(fixef(mixed4_2$restricted.models$`cond:cog`), is_equivalent_to(fixef(lmer4_small)))
-})
-
-test_that("mixed, obk.long: type 2 and LRTs", {
- data(obk.long, package = "afex")
- contrasts(obk.long$treatment) <- "contr.sum"
- contrasts(obk.long$phase) <- "contr.sum"
- suppressWarnings(t2 <- mixed(value ~ treatment*phase +(1|id), data = obk.long, method = "LRT", type = 2, progress=FALSE))
- a2.f <- lmer(value ~ treatment*phase +(1|id), data = obk.long, REML=FALSE)
- a2.h <- lmer(value ~ treatment+phase +(1|id), data = obk.long, REML=FALSE)
- a2.t <- lmer(value ~ treatment +(1|id), data = obk.long, REML=FALSE)
- a2.p <- lmer(value ~ phase +(1|id), data = obk.long, REML=FALSE)
- extract_anova <- function(anova) unlist(anova)[c("Df1", "Chisq2", "Chi Df2", "Pr(>Chisq)2" )]
-
- expect_that(
- unlist(t2$anova_table[3,])
- , is_equivalent_to(
- extract_anova(anova(a2.h, a2.f))
- ))
- expect_that(
- unlist(t2$anova_table[2,])
- , is_equivalent_to(
- extract_anova(anova(a2.t, a2.h))
- ))
- expect_that(
- unlist(t2$anova_table[1,])
- , is_equivalent_to(
- extract_anova(anova(a2.p, a2.h))
- ))
-})
-
-test_that("mixed, mlmRev: type 3 and 2 LRTs for GLMMs", {
- require("mlmRev")
- suppressWarnings(gm1 <- mixed(use ~ age*urban + (1 | district), family = binomial, data = Contraception, method = "LRT", progress=FALSE))
- suppressWarnings(gm2 <- mixed(use ~ age*urban + (1 | district), family = binomial, data = Contraception, method = "LRT", type = 2, progress=FALSE))
- expect_that(gm1, is_a("mixed"))
- expect_that(gm1, is_a("mixed"))
-})
-
-test_that("mixed, obk.long: LMM with method = PB", {
- expect_that(mixed(value ~ treatment+phase*hour +(1|id), data = obk.long, method = "PB", args.test = list(nsim = 10), progress=FALSE), is_a("mixed"))
-})
-
-test_that("mixed, obk.long: multicore loads lme4 and produces the same results", {
- skip_on_cran()
- data(obk.long, package = "afex")
- require(parallel)
- cl <- makeCluster(rep("localhost", 2)) # make cluster
- # 1. Obtain fits with multicore:
- m_mc1 <- mixed(value ~ treatment +(phase|id), data = obk.long, method = "LRT", cl = cl, control = lmerControl(optCtrl=list(maxfun = 100000)), progress=FALSE)
- cl_search <- clusterEvalQ(cl, search())
- stopCluster(cl)
- m_mc2 <- mixed(value ~ treatment +(phase|id), data = obk.long, method = "LRT", control = lmerControl(optCtrl=list(maxfun = 100000)), progress=FALSE)
- expect_that(all(vapply(cl_search, function(x) any(grepl("^package:lme4$", x)), NA)), is_true())
- expect_that(m_mc1, equals(m_mc2, check.attributes = FALSE))
-})
-
-test_that("print(mixed) works: only 1 or 2 fixed effects with all methods", {
- data(obk.long, package = "afex")
- expect_that(print(mixed(value ~ treatment+(1|id), data = obk.long)), is_a("data.frame"))
- expect_that(print(mixed(value ~ treatment+phase+(1|id), data = obk.long)), is_a("data.frame"))
- expect_that(print(mixed(value ~ treatment+(1|id), data = obk.long, method = "LRT")), is_a("data.frame"))
- expect_that(print(mixed(value ~ treatment+phase+(1|id), data = obk.long, method = "LRT")), is_a("data.frame"))
- require("mlmRev") # for the data, see ?Contraception
- expect_that(print(mixed(use ~ urban + (1 | district), method = "PB", family = binomial, data = Contraception, args.test=list(nsim=2))), is_a("data.frame"))
- expect_that(print(mixed(use ~ urban + livch + (1 | district), method = "PB", family = binomial, data = Contraception, args.test=list(nsim=2))), is_a("data.frame"))
-})
-
-# test_that("mixed, Maxell & Delaney (2004), Table 16.4, p. 842: bobyqa not fitting well", {
-# data(md_16.4)
-# # F-values and p-values are relatively off:
-# expect_that(mixed(induct ~ cond*cog + (cog|room:cond), md_16.4, control=lmerControl(optimizer="bobyqa")), gives_warning("better fit"))
-# expect_that(mixed(induct ~ cond*cog + (cog|room:cond), md_16.4, type=2, control=lmerControl(optimizer="bobyqa")), gives_warning("better fit"))
-# })
-
-test_that("mixed: set.data.arg", {
- data(obk.long, package = "afex")
- suppressWarnings(m1 <- mixed(value ~ treatment*phase +(1|id), obk.long, method = "LRT", progress=FALSE))
- suppressWarnings(m2 <- mixed(value ~ treatment*phase +(1|id), obk.long, method = "LRT", progress=FALSE, set.data.arg = FALSE))
- expect_that(m1$full.model at call[["data"]], is_identical_to(as.name("obk.long")))
- expect_that(m2$full.model at call[["data"]], is_identical_to(as.name("data")))
-})
-
-test_that("mixed: anova with multiple mixed objexts", {
- data("sk2011.2")
- data("ks2013.3")
- sk2_aff <- droplevels(sk2011.2[sk2011.2$what == "affirmation",])
- sk_m1 <- mixed(response ~ instruction+(1|id), sk2_aff, method = "LRT", progress = FALSE)
- sk_m2 <- mixed(response ~ instruction+(1|id)+(1|content), sk2_aff, method = "LRT", progress = FALSE)
- sk_m3 <- lmer(response ~ instruction+(1|id)+(validity|content), sk2_aff, REML = FALSE)
- sk_m4 <- lmer(response ~ instruction+(1|id)+(validity|content), sk2_aff, REML = TRUE)
- t <- anova(sk_m1, sk_m2, sk_m3)
- expect_is(t, c("anova", "data.frame"))
- expect_is(anova(sk_m1, object = sk_m2, sk_m3), c("anova", "data.frame"))
- expect_is(anova(sk_m1, object = sk_m2, sk_m3, ks2013.3), c("anova", "data.frame"))
- expect_warning(anova(sk_m1, object = sk_m2, sk_m3, sk_m4), "some models fit with REML = TRUE, some not")
-})
-
-context("Mixed: Expand random effects")
-
-
-test_that("mixed: expand_re argument, return = 'merMod'", {
- data("ks2013.3")
- m2 <- mixed(response ~ validity + (believability||id), ks2013.3, expand_re = TRUE, method = "LRT", progress=FALSE)
- m3 <- mixed(response ~ validity + (believability|id), ks2013.3, method = "LRT", progress=FALSE)
- expect_identical(length(unlist(summary(m2)$varcor)), nrow(summary(m3)$varcor$id))
- expect_true(all.equal(unlist(summary(m2)$varcor), diag(summary(m3)$varcor$id), tolerance = 0.03, check.attributes = FALSE))
- l2 <- mixed(response ~ validity + (believability||id), ks2013.3, expand_re = TRUE, return = "merMod")
- expect_is(l2, "merMod")
- expect_equivalent(m2$full.model, l2)
- l3 <- lmer_alt(response ~ validity + (believability||id), ks2013.3)
- l4 <- lmer_alt(response ~ validity + (believability||id), ks2013.3, control = lmerControl(optimizer = "Nelder_Mead"))
- expect_equivalent(l2, l3)
- expect_equal(l3, l4, check.attributes = FALSE)
- l5 <- lmer_alt(response ~ validity + (believability||id), ks2013.3, control = lmerControl(optimizer = "Nelder_Mead"), check.contrasts = TRUE)
- expect_equal(l2, l5, check.attributes = FALSE )
- expect_identical(names(coef(l2)$id), names(coef(l5)$id)) # parameter names need to be identical (same contrasts)
- expect_false(all(names(coef(l2)$id) == names(coef(l3)$id))) # parameter names need to be different (different contrasts)
- l7 <- lmer_alt(response ~ validity + (1|id) + (0+validity*condition||content), ks2013.3, control = lmerControl(optCtrl = list(maxfun=1e6)))
- expect_is(l7, "merMod")
- expect_error(lmer_alt(response ~ validity + (0|id) + (0+validity*condition||content), ks2013.3), "Invalid random effects term")
- expect_is(lmer_alt(response ~ validity + (validity||id) + (validity|content), ks2013.3), "merMod")
-})
-
-test_that("mixed: expand_re argument (longer)", {
- testthat::skip_on_cran()
- data("ks2013.3")
- m4 <- mixed(response ~ validity + (believability*validity||id) + (validity*condition|content), ks2013.3, expand_re = TRUE, method = "LRT", control = lmerControl(optCtrl = list(maxfun=1e6)), progress=FALSE)
- m5 <- mixed(response ~ validity + (believability*validity|id) + (validity*condition||content), ks2013.3, method = "LRT", control = lmerControl(optCtrl = list(maxfun=1e6)), expand_re = TRUE, progress=FALSE)
- expect_identical(length(unlist(summary(m4)$varcor[-7])), nrow(summary(m5)$varcor$id))
- expect_identical(length(unlist(summary(m5)$varcor[-1])), nrow(summary(m4)$varcor$content))
- expect_equal(attr(summary(m5)$varcor, "sc"), attr(summary(m4)$varcor, "sc"), tolerance = 0.02)
-})
-
-
+
+context("Mixed: structural tests")
+
+# note: all calls with type 2 are wrapped in suppressWarnings()!
+
+test_that("mixed: Maxell & Delaney (2004), Table 16.4, p. 842: Type 2", {
+ data(md_16.4)
+ md_16.4b <- md_16.4
+ md_16.4b$cog <- scale(md_16.4b$cog, scale=FALSE)
+ contrasts(md_16.4b$cond) <- "contr.sum"
+ suppressWarnings(mixed4_2 <- mixed(induct ~ cond*cog + (cog|room:cond), md_16.4b, type = 2, progress=FALSE))
+ lmer4_full <- lmer(induct ~ cond*cog + (cog|room:cond), md_16.4b)
+ lmer4_small <- lmer(induct ~ cond+cog + (cog|room:cond), md_16.4b)
+ expect_that(fixef(mixed4_2$full.model[[2]]), equals(fixef(lmer4_full)))
+ expect_that(fixef(mixed4_2$full.model[[1]]), is_equivalent_to(fixef(lmer4_small)))
+})
+
+test_that("mixed: Maxell & Delaney (2004), Table 16.4, p. 842: Type 3", {
+ data(md_16.4)
+ md_16.4b <- md_16.4
+ md_16.4b$cog <- scale(md_16.4b$cog, scale=FALSE)
+ contrasts(md_16.4b$cond) <- "contr.sum"
+ suppressWarnings(mixed4_2 <- mixed(induct ~ cond*cog + (cog|room:cond), md_16.4b, type = 3, progress=FALSE))
+ lmer4_full <- lmer(induct ~ cond*cog + (cog|room:cond), md_16.4b)
+ lmer4_small <- lmer(induct ~ cond+cog + (cog|room:cond), md_16.4b)
+ expect_that(fixef(mixed4_2$full.model), equals(fixef(lmer4_full)))
+ expect_that(mixed4_2$full.model, is_equivalent_to(lmer4_full))
+ expect_that(fixef(mixed4_2$restricted.models$`cond:cog`), is_equivalent_to(fixef(lmer4_small)))
+})
+
+test_that("mixed, obk.long: type 2 and LRTs", {
+ data(obk.long, package = "afex")
+ contrasts(obk.long$treatment) <- "contr.sum"
+ contrasts(obk.long$phase) <- "contr.sum"
+ suppressWarnings(t2 <- mixed(value ~ treatment*phase +(1|id), data = obk.long, method = "LRT", type = 2, progress=FALSE))
+ a2.f <- lmer(value ~ treatment*phase +(1|id), data = obk.long, REML=FALSE)
+ a2.h <- lmer(value ~ treatment+phase +(1|id), data = obk.long, REML=FALSE)
+ a2.t <- lmer(value ~ treatment +(1|id), data = obk.long, REML=FALSE)
+ a2.p <- lmer(value ~ phase +(1|id), data = obk.long, REML=FALSE)
+ extract_anova <- function(anova) unlist(anova)[c("Df1", "Chisq2", "Chi Df2", "Pr(>Chisq)2" )]
+
+ expect_that(
+ unlist(t2$anova_table[3,])
+ , is_equivalent_to(
+ extract_anova(anova(a2.h, a2.f))
+ ))
+ expect_that(
+ unlist(t2$anova_table[2,])
+ , is_equivalent_to(
+ extract_anova(anova(a2.t, a2.h))
+ ))
+ expect_that(
+ unlist(t2$anova_table[1,])
+ , is_equivalent_to(
+ extract_anova(anova(a2.p, a2.h))
+ ))
+})
+
+test_that("mixed, mlmRev: type 3 and 2 LRTs for GLMMs", {
+ require("mlmRev")
+ suppressWarnings(gm1 <- mixed(use ~ age*urban + (1 | district), family = binomial, data = Contraception, method = "LRT", progress=FALSE))
+ suppressWarnings(gm2 <- mixed(use ~ age*urban + (1 | district), family = binomial, data = Contraception, method = "LRT", type = 2, progress=FALSE))
+ expect_that(gm1, is_a("mixed"))
+ expect_that(gm1, is_a("mixed"))
+})
+
+test_that("mixed, obk.long: LMM with method = PB", {
+ expect_that(mixed(value ~ treatment+phase*hour +(1|id), data = obk.long, method = "PB", args.test = list(nsim = 10), progress=FALSE), is_a("mixed"))
+})
+
+test_that("mixed, obk.long: multicore loads lme4 and produces the same results", {
+ skip_on_cran()
+ data(obk.long, package = "afex")
+ require(parallel)
+ cl <- makeCluster(rep("localhost", 2)) # make cluster
+ # 1. Obtain fits with multicore:
+ m_mc1 <- mixed(value ~ treatment +(phase|id), data = obk.long, method = "LRT", cl = cl, control = lmerControl(optCtrl=list(maxfun = 100000)), progress=FALSE)
+ cl_search <- clusterEvalQ(cl, search())
+ stopCluster(cl)
+ m_mc2 <- mixed(value ~ treatment +(phase|id), data = obk.long, method = "LRT", control = lmerControl(optCtrl=list(maxfun = 100000)), progress=FALSE)
+ expect_that(all(vapply(cl_search, function(x) any(grepl("^package:lme4$", x)), NA)), is_true())
+ expect_that(m_mc1, equals(m_mc2, check.attributes = FALSE))
+})
+
+test_that("print(mixed) works: only 1 or 2 fixed effects with all methods", {
+ data(obk.long, package = "afex")
+ expect_that(print(mixed(value ~ treatment+(1|id), data = obk.long)), is_a("data.frame"))
+ expect_that(print(mixed(value ~ treatment+phase+(1|id), data = obk.long)), is_a("data.frame"))
+ expect_that(print(mixed(value ~ treatment+(1|id), data = obk.long, method = "LRT")), is_a("data.frame"))
+ expect_that(print(mixed(value ~ treatment+phase+(1|id), data = obk.long, method = "LRT")), is_a("data.frame"))
+ require("mlmRev") # for the data, see ?Contraception
+ expect_that(print(mixed(use ~ urban + (1 | district), method = "PB", family = binomial, data = Contraception, args.test=list(nsim=2))), is_a("data.frame"))
+ expect_that(print(mixed(use ~ urban + livch + (1 | district), method = "PB", family = binomial, data = Contraception, args.test=list(nsim=2))), is_a("data.frame"))
+})
+
+# test_that("mixed, Maxell & Delaney (2004), Table 16.4, p. 842: bobyqa not fitting well", {
+# data(md_16.4)
+# # F-values and p-values are relatively off:
+# expect_that(mixed(induct ~ cond*cog + (cog|room:cond), md_16.4, control=lmerControl(optimizer="bobyqa")), gives_warning("better fit"))
+# expect_that(mixed(induct ~ cond*cog + (cog|room:cond), md_16.4, type=2, control=lmerControl(optimizer="bobyqa")), gives_warning("better fit"))
+# })
+
+test_that("mixed: set.data.arg", {
+ data(obk.long, package = "afex")
+ suppressWarnings(m1 <- mixed(value ~ treatment*phase +(1|id), obk.long, method = "LRT", progress=FALSE))
+ suppressWarnings(m2 <- mixed(value ~ treatment*phase +(1|id), obk.long, method = "LRT", progress=FALSE, set.data.arg = FALSE))
+ expect_that(m1$full.model at call[["data"]], is_identical_to(as.name("obk.long")))
+ expect_that(m2$full.model at call[["data"]], is_identical_to(as.name("data")))
+})
+
+test_that("mixed: anova with multiple mixed objexts", {
+ data("sk2011.2")
+ data("ks2013.3")
+ sk2_aff <- droplevels(sk2011.2[sk2011.2$what == "affirmation",])
+ sk_m1 <- mixed(response ~ instruction+(1|id), sk2_aff, method = "LRT", progress = FALSE)
+ sk_m2 <- mixed(response ~ instruction+(1|id)+(1|content), sk2_aff, method = "LRT", progress = FALSE)
+ sk_m3 <- lmer(response ~ instruction+(1|id)+(validity|content), sk2_aff, REML = FALSE)
+ sk_m4 <- lmer(response ~ instruction+(1|id)+(validity|content), sk2_aff, REML = TRUE)
+ t <- anova(sk_m1, sk_m2, sk_m3)
+ expect_is(t, c("anova", "data.frame"))
+ expect_is(anova(sk_m1, object = sk_m2, sk_m3), c("anova", "data.frame"))
+ expect_is(anova(sk_m1, object = sk_m2, sk_m3, ks2013.3), c("anova", "data.frame"))
+ expect_warning(anova(sk_m1, object = sk_m2, sk_m3, sk_m4), "some models fit with REML = TRUE, some not")
+})
+
+context("Mixed: Expand random effects")
+
+
+test_that("mixed: expand_re argument, return = 'merMod'", {
+ data("ks2013.3")
+ m2 <- mixed(response ~ validity + (believability||id), ks2013.3, expand_re = TRUE, method = "LRT", progress=FALSE)
+ m3 <- mixed(response ~ validity + (believability|id), ks2013.3, method = "LRT", progress=FALSE)
+ expect_identical(length(unlist(summary(m2)$varcor)), nrow(summary(m3)$varcor$id))
+ expect_true(all.equal(unlist(summary(m2)$varcor), diag(summary(m3)$varcor$id), tolerance = 0.03, check.attributes = FALSE))
+ l2 <- mixed(response ~ validity + (believability||id), ks2013.3, expand_re = TRUE, return = "merMod")
+ expect_is(l2, "merMod")
+ expect_equivalent(m2$full.model, l2)
+ l3 <- lmer_alt(response ~ validity + (believability||id), ks2013.3)
+ l4 <- lmer_alt(response ~ validity + (believability||id), ks2013.3, control = lmerControl(optimizer = "Nelder_Mead"))
+ expect_equivalent(l2, l3)
+ expect_equal(l3, l4, check.attributes = FALSE)
+ l5 <- lmer_alt(response ~ validity + (believability||id), ks2013.3, control = lmerControl(optimizer = "Nelder_Mead"), check.contrasts = TRUE)
+ expect_equal(l2, l5, check.attributes = FALSE )
+ expect_identical(names(coef(l2)$id), names(coef(l5)$id)) # parameter names need to be identical (same contrasts)
+ expect_false(all(names(coef(l2)$id) == names(coef(l3)$id))) # parameter names need to be different (different contrasts)
+ l7 <- lmer_alt(response ~ validity + (1|id) + (0+validity*condition||content), ks2013.3, control = lmerControl(optCtrl = list(maxfun=1e6)))
+ expect_is(l7, "merMod")
+ expect_error(lmer_alt(response ~ validity + (0|id) + (0+validity*condition||content), ks2013.3), "Invalid random effects term")
+ expect_is(lmer_alt(response ~ validity + (validity||id) + (validity|content), ks2013.3), "merMod")
+})
+
+test_that("mixed: expand_re argument (longer)", {
+ testthat::skip_on_cran()
+ data("ks2013.3")
+ m4 <- mixed(response ~ validity + (believability*validity||id) + (validity*condition|content), ks2013.3, expand_re = TRUE, method = "LRT", control = lmerControl(optCtrl = list(maxfun=1e6)), progress=FALSE)
+ m5 <- mixed(response ~ validity + (believability*validity|id) + (validity*condition||content), ks2013.3, method = "LRT", control = lmerControl(optCtrl = list(maxfun=1e6)), expand_re = TRUE, progress=FALSE)
+ expect_identical(length(unlist(summary(m4)$varcor[-7])), nrow(summary(m5)$varcor$id))
+ expect_identical(length(unlist(summary(m5)$varcor[-1])), nrow(summary(m4)$varcor$content))
+ expect_equal(attr(summary(m5)$varcor, "sc"), attr(summary(m4)$varcor, "sc"), tolerance = 0.02)
+})
+
+
diff --git a/vignettes/anova_posthoc.Rmd b/vignettes/anova_posthoc.Rmd
index ae78229..97e17a6 100644
--- a/vignettes/anova_posthoc.Rmd
+++ b/vignettes/anova_posthoc.Rmd
@@ -77,7 +77,7 @@ knitr::kable(nice(a1))
Alternatively, the `anova` method for `afex_aov` objects returns a `data.frame` of class `anova` that can be passed to, for example, `xtable` for nice formatting:
```{r, results='asis'}
-print(xtable::xtable(a1$anova_table, digits = c(rep(2, 5), 3, 4)), type = "html")
+print(xtable::xtable(anova(a1), digits = c(rep(2, 5), 3, 4)), type = "html")
```
# Post-Hoc Contrasts and Plotting
--
Alioth's /usr/local/bin/git-commit-notice on /srv/git.debian.org/git/debian-science/packages/r-cran-afex.git
More information about the debian-science-commits
mailing list