├── .Rbuildignore
├── .gitignore
├── DESCRIPTION
├── LICENSE
├── NAMESPACE
├── NEWS.md
├── R
├── anova_apa.R
├── apa.R
├── chisq_apa.R
├── cohens_d.R
├── cor_apa.R
├── eta_squared.R
├── global_variables.R
├── t_apa.R
├── t_test.R
├── utils.R
├── utils_docx.R
└── utils_format.R
├── README.md
├── apa.Rproj
├── cran-comments.md
├── man
├── anova_apa.Rd
├── apa.Rd
├── chisq_apa.Rd
├── cohens_d.Rd
├── cohens_d_.Rd
├── cor_apa.Rd
├── petasq.Rd
├── petasq_.Rd
├── t_apa.Rd
└── t_test.Rd
├── tests
├── testthat.R
└── testthat
│ ├── test-anova-apa.R
│ ├── test-chisq-apa.R
│ ├── test-cohens-d.R
│ ├── test-cor-apa.R
│ ├── test-t-apa.R
│ ├── test-t-test.R
│ └── test-utils.R
└── vignettes
├── cor_apa_docx.png
└── introduction.Rmd
/.Rbuildignore:
--------------------------------------------------------------------------------
1 | ^paper$
2 | ^CRAN-RELEASE$
3 | ^.*\.Rproj$
4 | ^\.Rproj\.user$
5 | ^cran-comments\.md$
6 | ^LICENSE$
7 | ^README\.md$
8 | ^CRAN-SUBMISSION$
9 |
--------------------------------------------------------------------------------
/.gitignore:
--------------------------------------------------------------------------------
1 | .Rproj.user
2 | .Rhistory
3 | .RData
4 | .Ruserdata
5 | inst/doc
6 | CRAN-SUBMISSION
7 |
--------------------------------------------------------------------------------
/DESCRIPTION:
--------------------------------------------------------------------------------
1 | Package: apa
2 | Type: Package
3 | Title: Format Outputs of Statistical Tests According to APA Guidelines
4 | Version: 0.3.4.9000
5 | Authors@R: person("Daniel", "Gromer", email = "dgromer@mailbox.org", role = c("aut", "cre"))
6 | Description: Formatter functions in the 'apa' package take the return value of a
7 | statistical test function, e.g. a call to chisq.test() and return a string
8 | formatted according to the guidelines of the APA (American Psychological
9 | Association).
10 | URL: https://github.com/dgromer/apa
11 | BugReports: https://github.com/dgromer/apa/issues
12 | License: GPL (>= 3)
13 | Depends:
14 | R (>= 3.1.0)
15 | Imports:
16 | dplyr (>= 0.4),
17 | magrittr,
18 | MBESS,
19 | purrr,
20 | rmarkdown,
21 | stringr,
22 | tibble
23 | Suggests:
24 | afex (>= 0.14),
25 | ez,
26 | testthat,
27 | knitr
28 | Encoding: UTF-8
29 | LazyData: true
30 | RoxygenNote: 7.2.3
31 | VignetteBuilder: knitr
32 |
--------------------------------------------------------------------------------
/LICENSE:
--------------------------------------------------------------------------------
1 | GNU GENERAL PUBLIC LICENSE
2 | Version 3, 29 June 2007
3 |
4 | Copyright (C) 2007 Free Software Foundation, Inc.
5 | Everyone is permitted to copy and distribute verbatim copies
6 | of this license document, but changing it is not allowed.
7 |
8 | Preamble
9 |
10 | The GNU General Public License is a free, copyleft license for
11 | software and other kinds of works.
12 |
13 | The licenses for most software and other practical works are designed
14 | to take away your freedom to share and change the works. By contrast,
15 | the GNU General Public License is intended to guarantee your freedom to
16 | share and change all versions of a program--to make sure it remains free
17 | software for all its users. We, the Free Software Foundation, use the
18 | GNU General Public License for most of our software; it applies also to
19 | any other work released this way by its authors. You can apply it to
20 | your programs, too.
21 |
22 | When we speak of free software, we are referring to freedom, not
23 | price. Our General Public Licenses are designed to make sure that you
24 | have the freedom to distribute copies of free software (and charge for
25 | them if you wish), that you receive source code or can get it if you
26 | want it, that you can change the software or use pieces of it in new
27 | free programs, and that you know you can do these things.
28 |
29 | To protect your rights, we need to prevent others from denying you
30 | these rights or asking you to surrender the rights. Therefore, you have
31 | certain responsibilities if you distribute copies of the software, or if
32 | you modify it: responsibilities to respect the freedom of others.
33 |
34 | For example, if you distribute copies of such a program, whether
35 | gratis or for a fee, you must pass on to the recipients the same
36 | freedoms that you received. You must make sure that they, too, receive
37 | or can get the source code. And you must show them these terms so they
38 | know their rights.
39 |
40 | Developers that use the GNU GPL protect your rights with two steps:
41 | (1) assert copyright on the software, and (2) offer you this License
42 | giving you legal permission to copy, distribute and/or modify it.
43 |
44 | For the developers' and authors' protection, the GPL clearly explains
45 | that there is no warranty for this free software. For both users' and
46 | authors' sake, the GPL requires that modified versions be marked as
47 | changed, so that their problems will not be attributed erroneously to
48 | authors of previous versions.
49 |
50 | Some devices are designed to deny users access to install or run
51 | modified versions of the software inside them, although the manufacturer
52 | can do so. This is fundamentally incompatible with the aim of
53 | protecting users' freedom to change the software. The systematic
54 | pattern of such abuse occurs in the area of products for individuals to
55 | use, which is precisely where it is most unacceptable. Therefore, we
56 | have designed this version of the GPL to prohibit the practice for those
57 | products. If such problems arise substantially in other domains, we
58 | stand ready to extend this provision to those domains in future versions
59 | of the GPL, as needed to protect the freedom of users.
60 |
61 | Finally, every program is threatened constantly by software patents.
62 | States should not allow patents to restrict development and use of
63 | software on general-purpose computers, but in those that do, we wish to
64 | avoid the special danger that patents applied to a free program could
65 | make it effectively proprietary. To prevent this, the GPL assures that
66 | patents cannot be used to render the program non-free.
67 |
68 | The precise terms and conditions for copying, distribution and
69 | modification follow.
70 |
71 | TERMS AND CONDITIONS
72 |
73 | 0. Definitions.
74 |
75 | "This License" refers to version 3 of the GNU General Public License.
76 |
77 | "Copyright" also means copyright-like laws that apply to other kinds of
78 | works, such as semiconductor masks.
79 |
80 | "The Program" refers to any copyrightable work licensed under this
81 | License. Each licensee is addressed as "you". "Licensees" and
82 | "recipients" may be individuals or organizations.
83 |
84 | To "modify" a work means to copy from or adapt all or part of the work
85 | in a fashion requiring copyright permission, other than the making of an
86 | exact copy. The resulting work is called a "modified version" of the
87 | earlier work or a work "based on" the earlier work.
88 |
89 | A "covered work" means either the unmodified Program or a work based
90 | on the Program.
91 |
92 | To "propagate" a work means to do anything with it that, without
93 | permission, would make you directly or secondarily liable for
94 | infringement under applicable copyright law, except executing it on a
95 | computer or modifying a private copy. Propagation includes copying,
96 | distribution (with or without modification), making available to the
97 | public, and in some countries other activities as well.
98 |
99 | To "convey" a work means any kind of propagation that enables other
100 | parties to make or receive copies. Mere interaction with a user through
101 | a computer network, with no transfer of a copy, is not conveying.
102 |
103 | An interactive user interface displays "Appropriate Legal Notices"
104 | to the extent that it includes a convenient and prominently visible
105 | feature that (1) displays an appropriate copyright notice, and (2)
106 | tells the user that there is no warranty for the work (except to the
107 | extent that warranties are provided), that licensees may convey the
108 | work under this License, and how to view a copy of this License. If
109 | the interface presents a list of user commands or options, such as a
110 | menu, a prominent item in the list meets this criterion.
111 |
112 | 1. Source Code.
113 |
114 | The "source code" for a work means the preferred form of the work
115 | for making modifications to it. "Object code" means any non-source
116 | form of a work.
117 |
118 | A "Standard Interface" means an interface that either is an official
119 | standard defined by a recognized standards body, or, in the case of
120 | interfaces specified for a particular programming language, one that
121 | is widely used among developers working in that language.
122 |
123 | The "System Libraries" of an executable work include anything, other
124 | than the work as a whole, that (a) is included in the normal form of
125 | packaging a Major Component, but which is not part of that Major
126 | Component, and (b) serves only to enable use of the work with that
127 | Major Component, or to implement a Standard Interface for which an
128 | implementation is available to the public in source code form. A
129 | "Major Component", in this context, means a major essential component
130 | (kernel, window system, and so on) of the specific operating system
131 | (if any) on which the executable work runs, or a compiler used to
132 | produce the work, or an object code interpreter used to run it.
133 |
134 | The "Corresponding Source" for a work in object code form means all
135 | the source code needed to generate, install, and (for an executable
136 | work) run the object code and to modify the work, including scripts to
137 | control those activities. However, it does not include the work's
138 | System Libraries, or general-purpose tools or generally available free
139 | programs which are used unmodified in performing those activities but
140 | which are not part of the work. For example, Corresponding Source
141 | includes interface definition files associated with source files for
142 | the work, and the source code for shared libraries and dynamically
143 | linked subprograms that the work is specifically designed to require,
144 | such as by intimate data communication or control flow between those
145 | subprograms and other parts of the work.
146 |
147 | The Corresponding Source need not include anything that users
148 | can regenerate automatically from other parts of the Corresponding
149 | Source.
150 |
151 | The Corresponding Source for a work in source code form is that
152 | same work.
153 |
154 | 2. Basic Permissions.
155 |
156 | All rights granted under this License are granted for the term of
157 | copyright on the Program, and are irrevocable provided the stated
158 | conditions are met. This License explicitly affirms your unlimited
159 | permission to run the unmodified Program. The output from running a
160 | covered work is covered by this License only if the output, given its
161 | content, constitutes a covered work. This License acknowledges your
162 | rights of fair use or other equivalent, as provided by copyright law.
163 |
164 | You may make, run and propagate covered works that you do not
165 | convey, without conditions so long as your license otherwise remains
166 | in force. You may convey covered works to others for the sole purpose
167 | of having them make modifications exclusively for you, or provide you
168 | with facilities for running those works, provided that you comply with
169 | the terms of this License in conveying all material for which you do
170 | not control copyright. Those thus making or running the covered works
171 | for you must do so exclusively on your behalf, under your direction
172 | and control, on terms that prohibit them from making any copies of
173 | your copyrighted material outside their relationship with you.
174 |
175 | Conveying under any other circumstances is permitted solely under
176 | the conditions stated below. Sublicensing is not allowed; section 10
177 | makes it unnecessary.
178 |
179 | 3. Protecting Users' Legal Rights From Anti-Circumvention Law.
180 |
181 | No covered work shall be deemed part of an effective technological
182 | measure under any applicable law fulfilling obligations under article
183 | 11 of the WIPO copyright treaty adopted on 20 December 1996, or
184 | similar laws prohibiting or restricting circumvention of such
185 | measures.
186 |
187 | When you convey a covered work, you waive any legal power to forbid
188 | circumvention of technological measures to the extent such circumvention
189 | is effected by exercising rights under this License with respect to
190 | the covered work, and you disclaim any intention to limit operation or
191 | modification of the work as a means of enforcing, against the work's
192 | users, your or third parties' legal rights to forbid circumvention of
193 | technological measures.
194 |
195 | 4. Conveying Verbatim Copies.
196 |
197 | You may convey verbatim copies of the Program's source code as you
198 | receive it, in any medium, provided that you conspicuously and
199 | appropriately publish on each copy an appropriate copyright notice;
200 | keep intact all notices stating that this License and any
201 | non-permissive terms added in accord with section 7 apply to the code;
202 | keep intact all notices of the absence of any warranty; and give all
203 | recipients a copy of this License along with the Program.
204 |
205 | You may charge any price or no price for each copy that you convey,
206 | and you may offer support or warranty protection for a fee.
207 |
208 | 5. Conveying Modified Source Versions.
209 |
210 | You may convey a work based on the Program, or the modifications to
211 | produce it from the Program, in the form of source code under the
212 | terms of section 4, provided that you also meet all of these conditions:
213 |
214 | a) The work must carry prominent notices stating that you modified
215 | it, and giving a relevant date.
216 |
217 | b) The work must carry prominent notices stating that it is
218 | released under this License and any conditions added under section
219 | 7. This requirement modifies the requirement in section 4 to
220 | "keep intact all notices".
221 |
222 | c) You must license the entire work, as a whole, under this
223 | License to anyone who comes into possession of a copy. This
224 | License will therefore apply, along with any applicable section 7
225 | additional terms, to the whole of the work, and all its parts,
226 | regardless of how they are packaged. This License gives no
227 | permission to license the work in any other way, but it does not
228 | invalidate such permission if you have separately received it.
229 |
230 | d) If the work has interactive user interfaces, each must display
231 | Appropriate Legal Notices; however, if the Program has interactive
232 | interfaces that do not display Appropriate Legal Notices, your
233 | work need not make them do so.
234 |
235 | A compilation of a covered work with other separate and independent
236 | works, which are not by their nature extensions of the covered work,
237 | and which are not combined with it such as to form a larger program,
238 | in or on a volume of a storage or distribution medium, is called an
239 | "aggregate" if the compilation and its resulting copyright are not
240 | used to limit the access or legal rights of the compilation's users
241 | beyond what the individual works permit. Inclusion of a covered work
242 | in an aggregate does not cause this License to apply to the other
243 | parts of the aggregate.
244 |
245 | 6. Conveying Non-Source Forms.
246 |
247 | You may convey a covered work in object code form under the terms
248 | of sections 4 and 5, provided that you also convey the
249 | machine-readable Corresponding Source under the terms of this License,
250 | in one of these ways:
251 |
252 | a) Convey the object code in, or embodied in, a physical product
253 | (including a physical distribution medium), accompanied by the
254 | Corresponding Source fixed on a durable physical medium
255 | customarily used for software interchange.
256 |
257 | b) Convey the object code in, or embodied in, a physical product
258 | (including a physical distribution medium), accompanied by a
259 | written offer, valid for at least three years and valid for as
260 | long as you offer spare parts or customer support for that product
261 | model, to give anyone who possesses the object code either (1) a
262 | copy of the Corresponding Source for all the software in the
263 | product that is covered by this License, on a durable physical
264 | medium customarily used for software interchange, for a price no
265 | more than your reasonable cost of physically performing this
266 | conveying of source, or (2) access to copy the
267 | Corresponding Source from a network server at no charge.
268 |
269 | c) Convey individual copies of the object code with a copy of the
270 | written offer to provide the Corresponding Source. This
271 | alternative is allowed only occasionally and noncommercially, and
272 | only if you received the object code with such an offer, in accord
273 | with subsection 6b.
274 |
275 | d) Convey the object code by offering access from a designated
276 | place (gratis or for a charge), and offer equivalent access to the
277 | Corresponding Source in the same way through the same place at no
278 | further charge. You need not require recipients to copy the
279 | Corresponding Source along with the object code. If the place to
280 | copy the object code is a network server, the Corresponding Source
281 | may be on a different server (operated by you or a third party)
282 | that supports equivalent copying facilities, provided you maintain
283 | clear directions next to the object code saying where to find the
284 | Corresponding Source. Regardless of what server hosts the
285 | Corresponding Source, you remain obligated to ensure that it is
286 | available for as long as needed to satisfy these requirements.
287 |
288 | e) Convey the object code using peer-to-peer transmission, provided
289 | you inform other peers where the object code and Corresponding
290 | Source of the work are being offered to the general public at no
291 | charge under subsection 6d.
292 |
293 | A separable portion of the object code, whose source code is excluded
294 | from the Corresponding Source as a System Library, need not be
295 | included in conveying the object code work.
296 |
297 | A "User Product" is either (1) a "consumer product", which means any
298 | tangible personal property which is normally used for personal, family,
299 | or household purposes, or (2) anything designed or sold for incorporation
300 | into a dwelling. In determining whether a product is a consumer product,
301 | doubtful cases shall be resolved in favor of coverage. For a particular
302 | product received by a particular user, "normally used" refers to a
303 | typical or common use of that class of product, regardless of the status
304 | of the particular user or of the way in which the particular user
305 | actually uses, or expects or is expected to use, the product. A product
306 | is a consumer product regardless of whether the product has substantial
307 | commercial, industrial or non-consumer uses, unless such uses represent
308 | the only significant mode of use of the product.
309 |
310 | "Installation Information" for a User Product means any methods,
311 | procedures, authorization keys, or other information required to install
312 | and execute modified versions of a covered work in that User Product from
313 | a modified version of its Corresponding Source. The information must
314 | suffice to ensure that the continued functioning of the modified object
315 | code is in no case prevented or interfered with solely because
316 | modification has been made.
317 |
318 | If you convey an object code work under this section in, or with, or
319 | specifically for use in, a User Product, and the conveying occurs as
320 | part of a transaction in which the right of possession and use of the
321 | User Product is transferred to the recipient in perpetuity or for a
322 | fixed term (regardless of how the transaction is characterized), the
323 | Corresponding Source conveyed under this section must be accompanied
324 | by the Installation Information. But this requirement does not apply
325 | if neither you nor any third party retains the ability to install
326 | modified object code on the User Product (for example, the work has
327 | been installed in ROM).
328 |
329 | The requirement to provide Installation Information does not include a
330 | requirement to continue to provide support service, warranty, or updates
331 | for a work that has been modified or installed by the recipient, or for
332 | the User Product in which it has been modified or installed. Access to a
333 | network may be denied when the modification itself materially and
334 | adversely affects the operation of the network or violates the rules and
335 | protocols for communication across the network.
336 |
337 | Corresponding Source conveyed, and Installation Information provided,
338 | in accord with this section must be in a format that is publicly
339 | documented (and with an implementation available to the public in
340 | source code form), and must require no special password or key for
341 | unpacking, reading or copying.
342 |
343 | 7. Additional Terms.
344 |
345 | "Additional permissions" are terms that supplement the terms of this
346 | License by making exceptions from one or more of its conditions.
347 | Additional permissions that are applicable to the entire Program shall
348 | be treated as though they were included in this License, to the extent
349 | that they are valid under applicable law. If additional permissions
350 | apply only to part of the Program, that part may be used separately
351 | under those permissions, but the entire Program remains governed by
352 | this License without regard to the additional permissions.
353 |
354 | When you convey a copy of a covered work, you may at your option
355 | remove any additional permissions from that copy, or from any part of
356 | it. (Additional permissions may be written to require their own
357 | removal in certain cases when you modify the work.) You may place
358 | additional permissions on material, added by you to a covered work,
359 | for which you have or can give appropriate copyright permission.
360 |
361 | Notwithstanding any other provision of this License, for material you
362 | add to a covered work, you may (if authorized by the copyright holders of
363 | that material) supplement the terms of this License with terms:
364 |
365 | a) Disclaiming warranty or limiting liability differently from the
366 | terms of sections 15 and 16 of this License; or
367 |
368 | b) Requiring preservation of specified reasonable legal notices or
369 | author attributions in that material or in the Appropriate Legal
370 | Notices displayed by works containing it; or
371 |
372 | c) Prohibiting misrepresentation of the origin of that material, or
373 | requiring that modified versions of such material be marked in
374 | reasonable ways as different from the original version; or
375 |
376 | d) Limiting the use for publicity purposes of names of licensors or
377 | authors of the material; or
378 |
379 | e) Declining to grant rights under trademark law for use of some
380 | trade names, trademarks, or service marks; or
381 |
382 | f) Requiring indemnification of licensors and authors of that
383 | material by anyone who conveys the material (or modified versions of
384 | it) with contractual assumptions of liability to the recipient, for
385 | any liability that these contractual assumptions directly impose on
386 | those licensors and authors.
387 |
388 | All other non-permissive additional terms are considered "further
389 | restrictions" within the meaning of section 10. If the Program as you
390 | received it, or any part of it, contains a notice stating that it is
391 | governed by this License along with a term that is a further
392 | restriction, you may remove that term. If a license document contains
393 | a further restriction but permits relicensing or conveying under this
394 | License, you may add to a covered work material governed by the terms
395 | of that license document, provided that the further restriction does
396 | not survive such relicensing or conveying.
397 |
398 | If you add terms to a covered work in accord with this section, you
399 | must place, in the relevant source files, a statement of the
400 | additional terms that apply to those files, or a notice indicating
401 | where to find the applicable terms.
402 |
403 | Additional terms, permissive or non-permissive, may be stated in the
404 | form of a separately written license, or stated as exceptions;
405 | the above requirements apply either way.
406 |
407 | 8. Termination.
408 |
409 | You may not propagate or modify a covered work except as expressly
410 | provided under this License. Any attempt otherwise to propagate or
411 | modify it is void, and will automatically terminate your rights under
412 | this License (including any patent licenses granted under the third
413 | paragraph of section 11).
414 |
415 | However, if you cease all violation of this License, then your
416 | license from a particular copyright holder is reinstated (a)
417 | provisionally, unless and until the copyright holder explicitly and
418 | finally terminates your license, and (b) permanently, if the copyright
419 | holder fails to notify you of the violation by some reasonable means
420 | prior to 60 days after the cessation.
421 |
422 | Moreover, your license from a particular copyright holder is
423 | reinstated permanently if the copyright holder notifies you of the
424 | violation by some reasonable means, this is the first time you have
425 | received notice of violation of this License (for any work) from that
426 | copyright holder, and you cure the violation prior to 30 days after
427 | your receipt of the notice.
428 |
429 | Termination of your rights under this section does not terminate the
430 | licenses of parties who have received copies or rights from you under
431 | this License. If your rights have been terminated and not permanently
432 | reinstated, you do not qualify to receive new licenses for the same
433 | material under section 10.
434 |
435 | 9. Acceptance Not Required for Having Copies.
436 |
437 | You are not required to accept this License in order to receive or
438 | run a copy of the Program. Ancillary propagation of a covered work
439 | occurring solely as a consequence of using peer-to-peer transmission
440 | to receive a copy likewise does not require acceptance. However,
441 | nothing other than this License grants you permission to propagate or
442 | modify any covered work. These actions infringe copyright if you do
443 | not accept this License. Therefore, by modifying or propagating a
444 | covered work, you indicate your acceptance of this License to do so.
445 |
446 | 10. Automatic Licensing of Downstream Recipients.
447 |
448 | Each time you convey a covered work, the recipient automatically
449 | receives a license from the original licensors, to run, modify and
450 | propagate that work, subject to this License. You are not responsible
451 | for enforcing compliance by third parties with this License.
452 |
453 | An "entity transaction" is a transaction transferring control of an
454 | organization, or substantially all assets of one, or subdividing an
455 | organization, or merging organizations. If propagation of a covered
456 | work results from an entity transaction, each party to that
457 | transaction who receives a copy of the work also receives whatever
458 | licenses to the work the party's predecessor in interest had or could
459 | give under the previous paragraph, plus a right to possession of the
460 | Corresponding Source of the work from the predecessor in interest, if
461 | the predecessor has it or can get it with reasonable efforts.
462 |
463 | You may not impose any further restrictions on the exercise of the
464 | rights granted or affirmed under this License. For example, you may
465 | not impose a license fee, royalty, or other charge for exercise of
466 | rights granted under this License, and you may not initiate litigation
467 | (including a cross-claim or counterclaim in a lawsuit) alleging that
468 | any patent claim is infringed by making, using, selling, offering for
469 | sale, or importing the Program or any portion of it.
470 |
471 | 11. Patents.
472 |
473 | A "contributor" is a copyright holder who authorizes use under this
474 | License of the Program or a work on which the Program is based. The
475 | work thus licensed is called the contributor's "contributor version".
476 |
477 | A contributor's "essential patent claims" are all patent claims
478 | owned or controlled by the contributor, whether already acquired or
479 | hereafter acquired, that would be infringed by some manner, permitted
480 | by this License, of making, using, or selling its contributor version,
481 | but do not include claims that would be infringed only as a
482 | consequence of further modification of the contributor version. For
483 | purposes of this definition, "control" includes the right to grant
484 | patent sublicenses in a manner consistent with the requirements of
485 | this License.
486 |
487 | Each contributor grants you a non-exclusive, worldwide, royalty-free
488 | patent license under the contributor's essential patent claims, to
489 | make, use, sell, offer for sale, import and otherwise run, modify and
490 | propagate the contents of its contributor version.
491 |
492 | In the following three paragraphs, a "patent license" is any express
493 | agreement or commitment, however denominated, not to enforce a patent
494 | (such as an express permission to practice a patent or covenant not to
495 | sue for patent infringement). To "grant" such a patent license to a
496 | party means to make such an agreement or commitment not to enforce a
497 | patent against the party.
498 |
499 | If you convey a covered work, knowingly relying on a patent license,
500 | and the Corresponding Source of the work is not available for anyone
501 | to copy, free of charge and under the terms of this License, through a
502 | publicly available network server or other readily accessible means,
503 | then you must either (1) cause the Corresponding Source to be so
504 | available, or (2) arrange to deprive yourself of the benefit of the
505 | patent license for this particular work, or (3) arrange, in a manner
506 | consistent with the requirements of this License, to extend the patent
507 | license to downstream recipients. "Knowingly relying" means you have
508 | actual knowledge that, but for the patent license, your conveying the
509 | covered work in a country, or your recipient's use of the covered work
510 | in a country, would infringe one or more identifiable patents in that
511 | country that you have reason to believe are valid.
512 |
513 | If, pursuant to or in connection with a single transaction or
514 | arrangement, you convey, or propagate by procuring conveyance of, a
515 | covered work, and grant a patent license to some of the parties
516 | receiving the covered work authorizing them to use, propagate, modify
517 | or convey a specific copy of the covered work, then the patent license
518 | you grant is automatically extended to all recipients of the covered
519 | work and works based on it.
520 |
521 | A patent license is "discriminatory" if it does not include within
522 | the scope of its coverage, prohibits the exercise of, or is
523 | conditioned on the non-exercise of one or more of the rights that are
524 | specifically granted under this License. You may not convey a covered
525 | work if you are a party to an arrangement with a third party that is
526 | in the business of distributing software, under which you make payment
527 | to the third party based on the extent of your activity of conveying
528 | the work, and under which the third party grants, to any of the
529 | parties who would receive the covered work from you, a discriminatory
530 | patent license (a) in connection with copies of the covered work
531 | conveyed by you (or copies made from those copies), or (b) primarily
532 | for and in connection with specific products or compilations that
533 | contain the covered work, unless you entered into that arrangement,
534 | or that patent license was granted, prior to 28 March 2007.
535 |
536 | Nothing in this License shall be construed as excluding or limiting
537 | any implied license or other defenses to infringement that may
538 | otherwise be available to you under applicable patent law.
539 |
540 | 12. No Surrender of Others' Freedom.
541 |
542 | If conditions are imposed on you (whether by court order, agreement or
543 | otherwise) that contradict the conditions of this License, they do not
544 | excuse you from the conditions of this License. If you cannot convey a
545 | covered work so as to satisfy simultaneously your obligations under this
546 | License and any other pertinent obligations, then as a consequence you may
547 | not convey it at all. For example, if you agree to terms that obligate you
548 | to collect a royalty for further conveying from those to whom you convey
549 | the Program, the only way you could satisfy both those terms and this
550 | License would be to refrain entirely from conveying the Program.
551 |
552 | 13. Use with the GNU Affero General Public License.
553 |
554 | Notwithstanding any other provision of this License, you have
555 | permission to link or combine any covered work with a work licensed
556 | under version 3 of the GNU Affero General Public License into a single
557 | combined work, and to convey the resulting work. The terms of this
558 | License will continue to apply to the part which is the covered work,
559 | but the special requirements of the GNU Affero General Public License,
560 | section 13, concerning interaction through a network will apply to the
561 | combination as such.
562 |
563 | 14. Revised Versions of this License.
564 |
565 | The Free Software Foundation may publish revised and/or new versions of
566 | the GNU General Public License from time to time. Such new versions will
567 | be similar in spirit to the present version, but may differ in detail to
568 | address new problems or concerns.
569 |
570 | Each version is given a distinguishing version number. If the
571 | Program specifies that a certain numbered version of the GNU General
572 | Public License "or any later version" applies to it, you have the
573 | option of following the terms and conditions either of that numbered
574 | version or of any later version published by the Free Software
575 | Foundation. If the Program does not specify a version number of the
576 | GNU General Public License, you may choose any version ever published
577 | by the Free Software Foundation.
578 |
579 | If the Program specifies that a proxy can decide which future
580 | versions of the GNU General Public License can be used, that proxy's
581 | public statement of acceptance of a version permanently authorizes you
582 | to choose that version for the Program.
583 |
584 | Later license versions may give you additional or different
585 | permissions. However, no additional obligations are imposed on any
586 | author or copyright holder as a result of your choosing to follow a
587 | later version.
588 |
589 | 15. Disclaimer of Warranty.
590 |
591 | THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY
592 | APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT
593 | HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY
594 | OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO,
595 | THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
596 | PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE PROGRAM
597 | IS WITH YOU. SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF
598 | ALL NECESSARY SERVICING, REPAIR OR CORRECTION.
599 |
600 | 16. Limitation of Liability.
601 |
602 | IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING
603 | WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MODIFIES AND/OR CONVEYS
604 | THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY
605 | GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE
606 | USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF
607 | DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD
608 | PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS),
609 | EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF
610 | SUCH DAMAGES.
611 |
612 | 17. Interpretation of Sections 15 and 16.
613 |
614 | If the disclaimer of warranty and limitation of liability provided
615 | above cannot be given local legal effect according to their terms,
616 | reviewing courts shall apply local law that most closely approximates
617 | an absolute waiver of all civil liability in connection with the
618 | Program, unless a warranty or assumption of liability accompanies a
619 | copy of the Program in return for a fee.
620 |
621 | END OF TERMS AND CONDITIONS
622 |
623 | How to Apply These Terms to Your New Programs
624 |
625 | If you develop a new program, and you want it to be of the greatest
626 | possible use to the public, the best way to achieve this is to make it
627 | free software which everyone can redistribute and change under these terms.
628 |
629 | To do so, attach the following notices to the program. It is safest
630 | to attach them to the start of each source file to most effectively
631 | state the exclusion of warranty; and each file should have at least
632 | the "copyright" line and a pointer to where the full notice is found.
633 |
634 | {one line to give the program's name and a brief idea of what it does.}
635 | Copyright (C) {year} {name of author}
636 |
637 | This program is free software: you can redistribute it and/or modify
638 | it under the terms of the GNU General Public License as published by
639 | the Free Software Foundation, either version 3 of the License, or
640 | (at your option) any later version.
641 |
642 | This program is distributed in the hope that it will be useful,
643 | but WITHOUT ANY WARRANTY; without even the implied warranty of
644 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
645 | GNU General Public License for more details.
646 |
647 | You should have received a copy of the GNU General Public License
648 | along with this program. If not, see .
649 |
650 | Also add information on how to contact you by electronic and paper mail.
651 |
652 | If the program does terminal interaction, make it output a short
653 | notice like this when it starts in an interactive mode:
654 |
655 | {project} Copyright (C) {year} {fullname}
656 | This program comes with ABSOLUTELY NO WARRANTY; for details type `show w'.
657 | This is free software, and you are welcome to redistribute it
658 | under certain conditions; type `show c' for details.
659 |
660 | The hypothetical commands `show w' and `show c' should show the appropriate
661 | parts of the General Public License. Of course, your program's commands
662 | might be different; for a GUI interface, you would use an "about box".
663 |
664 | You should also get your employer (if you work as a programmer) or school,
665 | if any, to sign a "copyright disclaimer" for the program, if necessary.
666 | For more information on this, and how to apply and follow the GNU GPL, see
667 | .
668 |
669 | The GNU General Public License does not permit incorporating your program
670 | into proprietary programs. If your program is a subroutine library, you
671 | may consider it more useful to permit linking proprietary applications with
672 | the library. If this is what you want to do, use the GNU Lesser General
673 | Public License instead of this License. But first, please read
674 | .
675 |
--------------------------------------------------------------------------------
/NAMESPACE:
--------------------------------------------------------------------------------
1 | # Generated by roxygen2: do not edit by hand
2 |
3 | S3method(cohens_d,data.frame)
4 | S3method(cohens_d,default)
5 | S3method(cohens_d,formula)
6 | S3method(cohens_d,htest)
7 | S3method(t_test,default)
8 | S3method(t_test,formula)
9 | export(anova_apa)
10 | export(apa)
11 | export(chisq_apa)
12 | export(cohens_d)
13 | export(cohens_d_)
14 | export(cor_apa)
15 | export(petasq)
16 | export(petasq_)
17 | export(t_apa)
18 | export(t_test)
19 | importFrom(MBESS,conf.limits.nct)
20 | importFrom(dplyr,bind_rows)
21 | importFrom(dplyr,left_join)
22 | importFrom(dplyr,mutate_at)
23 | importFrom(dplyr,rowwise)
24 | importFrom(magrittr,"%<>%")
25 | importFrom(magrittr,"%>%")
26 | importFrom(purrr,as_vector)
27 | importFrom(purrr,flatten)
28 | importFrom(purrr,map)
29 | importFrom(purrr,map_chr)
30 | importFrom(purrr,map_dbl)
31 | importFrom(rmarkdown,render)
32 | importFrom(stats,complete.cases)
33 | importFrom(stats,na.omit)
34 | importFrom(stats,sd)
35 | importFrom(stats,setNames)
36 | importFrom(stats,t.test)
37 | importFrom(stats,terms)
38 | importFrom(stringr,str_extract)
39 | importFrom(stringr,str_replace)
40 | importFrom(stringr,str_split)
41 | importFrom(stringr,str_trim)
42 | importFrom(tibble,tibble)
43 |
--------------------------------------------------------------------------------
/NEWS.md:
--------------------------------------------------------------------------------
1 | # apa 0.3.4.9000
2 |
3 | ## Bug fixes
4 |
5 | * Fix error in `cohen_d` with Hedge's g correction not applying to one-sample
6 | t-tests. (@spressi, #15)
7 | * Add `one_sample` argument to `cohens_d_` to specify if Cohen's d is requested
8 | for if providing t and n.
9 | * Fix a missing escape for percent sign in the documentation of `t_apa`.
10 |
11 | # apa 0.3.4
12 |
13 | ## Bug fixes
14 |
15 | * Fix spacing error in `t_apa` output for `format = "latex_math"` with
16 | confidence interval for Cohen's d. (@yannikstegmann)
17 | * Fix problem with formula interface for `t_test.formula` and `cohens_d.formula`
18 | with r-devel.
19 |
20 | # apa 0.3.3
21 |
22 | ## New features
23 |
24 | * Add option to force sphericity correction on all within factors in ANOVA or
25 | turn of sphericity correction completely.
26 | * Add option to display confidence interval for pearson correlation.
27 | * Add option to display condidence interval for Cohen's d (experimental).
28 |
29 | ## Bug fixes
30 |
31 | * Add missing backslash for chi-square in LaTeX format.
32 | * Fix error in one sample `cohens_d` if input is from `t_test`.
33 | * Fix error that was introduced by tibble 3.0.0 (old code assumed automatic type
34 | conversion)
35 |
36 | # apa 0.3.2
37 |
38 | ## Bug fixes
39 |
40 | * Fix a test that returned a wrong result in r-devel (t-test now returns a list
41 | with more elements).
42 |
43 | # apa 0.3.1
44 |
45 | ## Bug fixes
46 |
47 | * Fix a bug in `t_test` when the independent variable has unused factor levels.
48 | * Fix a test that assumed no empty groups present (needed for dplyr 0.8
49 | compatibility)
50 |
51 | # apa 0.3.0
52 |
53 | ## New features
54 |
55 | * Add LaTeX math output format (#3)
56 |
57 | ## Bug fixes and minor improvements
58 |
59 | * Fix error in `anova_apa` when specifying the `effect` argument
60 | * Fix printing of p-values if p = 1.
61 | * Add missing `else` in `anova_apa`. (@stegmannks, #6)
62 | * Fix error in calculation of sample size from degrees of freedom in Cohen's d
63 | for dependent samples (@lcreteig, #7)
64 |
65 | # apa 0.2.0
66 |
67 | ## New features
68 |
69 | * Add support for `aov` in `anova_apa`.
70 |
71 | ## Bug fixes and minor improvements
72 |
73 | * Fix bug when using abbreviations "pes" or "ges" in `anova_apa`.
74 | * Provide same order of effects in `anova_apa` independent of input object
75 | * In `anova_apa` significance asterisks might have been incorrect when p-values
76 | were corrected for violation of sphericity.
77 |
--------------------------------------------------------------------------------
/R/anova_apa.R:
--------------------------------------------------------------------------------
1 | #' Report ANOVA in APA style
2 | #'
3 | #' @param x A call to \code{aov}, \code{ez::ezANOVA}, or \code{afex::afex_ez},
4 | #' \code{afex::afex_car} or \code{afex::afex_4}
5 | #' @param effect Character string indicating the name of the effect to display.
6 | #' If is \code{NULL}, all effects are reported (default).
7 | #' @param sph_corr Character string indicating the method used for correction if
8 | #' the assumption of sphericity is violated (only applies to repeated-measures
9 | #' and mixed design ANOVA). Can be one of \code{"greenhouse-geisser"}
10 | #' (default), \code{"huynh-feldt"} or \code{"none"} (you may also use the
11 | #' abbreviations \code{"gg"} or \code{"hf"}).
12 | #' @param force_sph_corr Logical indicating if sphericity correction should be
13 | #' applied to all within factors regardless of what the result of Mauchly's
14 | #' test of sphericity is (default is \code{FALSE}).
15 | #' @param es Character string indicating the effect size to display in the
16 | #' output, one of \code{"petasq"} (partial eta squared) or \code{"getasq"}
17 | #' (generalized eta squared) (you may also use the abbreviations \code{"pes"}
18 | #' or \code{"ges"}).
19 | #' @param format Character string specifying the output format. One of
20 | #' \code{"text"}, \code{"markdown"}, \code{"rmarkdown"}, \code{html},
21 | #' \code{"latex"}, \code{"latex_math"}, \code{"docx"} or \code{"plotmath"}.
22 | #' @param info Logical indicating whether to print a message on the used test
23 | #' (default is \code{FALSE})
24 | #' @param print Logical indicating whether to print the formatted output via
25 | #' \code{cat} (\code{TRUE}, default) or return as a data frame.
26 | #' @examples
27 | #' # Using the ez package
28 | #' library(ez)
29 | #' data(ANT)
30 | #'
31 | #' x <- ezANOVA(ANT[ANT$error==0,], dv = rt, wid = subnum,
32 | #' within = c(cue, flank), between = group, detailed = TRUE)
33 | #' anova_apa(x)
34 | #'
35 | #' # Using the afex package
36 | #' library(afex)
37 | #' data(md_12.1)
38 | #'
39 | #' y <- aov_ez(id = "id", dv = "rt", data = md_12.1,
40 | #' within = c("angle", "noise"))
41 | #' anova_apa(y)
42 | #'
43 | #' @export
44 | anova_apa <- function(x, effect = NULL,
45 | sph_corr = c("greenhouse-geisser", "gg", "huynh-feldt",
46 | "hf", "none"),
47 | force_sph_corr = FALSE,
48 | es = c("petasq", "pes", "getasq", "ges"),
49 | format = c("text", "markdown", "rmarkdown", "html",
50 | "latex", "latex_math", "docx", "plotmath"),
51 | info = FALSE, print = TRUE)
52 | {
53 | sph_corr <- match.arg(sph_corr)
54 | es <- match.arg(es)
55 | format <- match.arg(format)
56 |
57 | es <- switch(es, pes =, petasq = "petasq", ges =, getasq = "getasq")
58 |
59 | # Use a pseudo-S3 method dispatch, because `ezANOVA` returns a list without a
60 | # particular class
61 |
62 | if (inherits(x, c("aov", "lm")))
63 | {
64 | anova_apa_aov(x, effect, es, format, info, print)
65 | }
66 | else if (inherits(x, c("aovlist", "listof")))
67 | {
68 | anova_apa_aovlist(x, effect, sph_corr, es, format, info, print)
69 | }
70 | else if (inherits(x, "afex_aov"))
71 | {
72 | anova_apa_afex(x, effect, sph_corr, force_sph_corr, es, format, info, print)
73 | }
74 | else if (is.list(x) && names(x)[1] == "ANOVA")
75 | {
76 | anova_apa_ezanova(x, effect, sph_corr, force_sph_corr, es, format, info,
77 | print)
78 | }
79 | else
80 | {
81 | stop("'x' must be a call to `aov`, `ez::ezANOVA`, or `afex::aov_*`")
82 | }
83 | }
84 |
85 | #' @importFrom tibble tibble
86 | #' @importFrom purrr map_chr
87 | #' @importFrom stringr str_trim
88 | anova_apa_aov <- function(x, effect, es, format, info, print)
89 | {
90 | # Check for unsupported effect size for calls to `aov`
91 | if (es == "getasq")
92 | {
93 | warning(paste("A call to `aov` does not support generalized eta-squared,",
94 | "using partial eta-squared instead."), call. = FALSE)
95 |
96 | es <- "petasq"
97 | }
98 |
99 | info_msg <- ""
100 |
101 | # Calculate ANOVA table
102 | anova <- summary(x, intercept = TRUE)[[1]]
103 |
104 | # The row number where residuals are stored
105 | row_resid <- nrow(anova)
106 |
107 | # Extract information from anova object
108 | tbl <- tibble(
109 | effects = str_trim(row.names(anova)[-row_resid]),
110 | statistic = map_chr(anova$`F value`[-row_resid], fmt_stat),
111 | df_n = anova$Df[-row_resid], df_d = anova$Df[row_resid],
112 | p = map_chr(anova$`Pr(>F)`[-row_resid], fmt_pval),
113 | symb = map_chr(anova$`Pr(>F)`[-row_resid], p_to_symbol),
114 | es = map_chr(effects, ~ fmt_es(do.call(es, list(x, .x)),
115 | leading_zero = FALSE))
116 | )
117 |
118 | if (info && info_msg != "") message(info_msg)
119 |
120 | anova_apa_print(tbl, effect, es, format, print)
121 | }
122 |
123 | #' @importFrom dplyr bind_rows
124 | #' @importFrom purrr flatten map
125 | anova_apa_aovlist <- function(x, effect, sph_corr, es, format, info, print)
126 | {
127 | # Inform that calls to `aov` do not support sphericity correction
128 | if (sph_corr != "none")
129 | {
130 | warning(paste("A call to `aov` does not support sphericity correction,",
131 | "continuing without correction of possible violated",
132 | "sphericity"), call. = FALSE)
133 | }
134 |
135 | # Check for unsupported effect size for calls to `aov`
136 | if (es == "getasq")
137 | {
138 | warning(paste("A call to `aov` does not support generalized eta-squared,",
139 | "using partial eta-squared instead."), call. = FALSE)
140 |
141 | es <- "petasq"
142 | }
143 |
144 | info_msg <- ""
145 |
146 | # Calculate ANOVA tables for each stratum
147 | anova <- flatten(summary(x))
148 |
149 | # Extract information from list of ANOVA tables and store in single data frame
150 | tbl <- bind_rows(map(anova, extract_stats_aovlist))
151 |
152 | # Calculate effect sizes as extra step, because `extract_stats_aovlist` can't
153 | # call effect size function on aovlist object ('x') as this is not forwarded.
154 | tbl$es <- map_chr(tbl$effects, ~ fmt_es(do.call(es, list(x, .x)),
155 | leading_zero = FALSE))
156 |
157 | # Reorder rows in tbl
158 | tbl <- reorder_anova_tbl(tbl)
159 |
160 | if (info && info_msg != "") message(info_msg)
161 |
162 | anova_apa_print(tbl, effect, es, format, print)
163 | }
164 |
165 | #' @importFrom tibble tibble
166 | #' @importFrom stringr str_trim
167 | extract_stats_aovlist <- function(x)
168 | {
169 | # Return NULL if stratum contains residuals only
170 | if (nrow(x) == 1)
171 | {
172 | return(NULL)
173 | }
174 |
175 | # The row number where residuals are stored
176 | row_resid <- nrow(x)
177 |
178 | tibble(
179 | effects = str_trim(row.names(x)[-row_resid]),
180 | statistic = map_chr(x$`F value`[-row_resid], fmt_stat),
181 | df_n = x$Df[-row_resid], df_d = x$Df[row_resid],
182 | p = map_chr(x$`Pr(>F)`[-row_resid], fmt_pval),
183 | symb = map_chr(x$`Pr(>F)`[-row_resid], p_to_symbol)
184 | )
185 | }
186 |
187 | #' @importFrom dplyr rowwise mutate_at
188 | #' @importFrom tibble tibble
189 | #' @importFrom magrittr %>% %<>%
190 | #' @importFrom purrr map map_chr
191 | #' @importFrom stringr str_extract
192 | anova_apa_afex <- function(x, effect, sph_corr, force_sph_corr, es, format,
193 | info, print)
194 | {
195 | info_msg <- ""
196 |
197 | # Set 'correction' to FALSE because afex does greenhouse-geisser correction on
198 | # all within-effects by default
199 | anova <- anova(x, intercept = TRUE, correction = "none")
200 |
201 | # Extract information from anova object
202 | tbl <- tibble(
203 | effects = row.names(anova),
204 | statistic = map_chr(anova$F, fmt_stat),
205 | df_n = anova$`num Df`, df_d = anova$`den Df`,
206 | p = map_chr(anova$`Pr(>F)`, fmt_pval),
207 | symb = map_chr(anova$`Pr(>F)`, p_to_symbol),
208 | es = map_chr(effects, ~ fmt_es(do.call(es, list(x, .x)),
209 | leading_zero = FALSE))
210 | )
211 |
212 | # Check if within-effects are present and user wants sphericity correction
213 | if (length(attr(x, "within")) != 0 && sph_corr != "none")
214 | {
215 | # To access sphericity tests in afex, we need to call `summary`
216 | s <- summary(x)
217 |
218 | corr_method <- switch(sph_corr, `greenhouse-geisser` =, gg = "GG",
219 | `huynh-feldt` =, hf = "HF")
220 |
221 | # Extract Mauchly's test of sphericity
222 | sph_tests <- s$sphericity.tests
223 |
224 | # Check if user wants sphericity correction for all within factors
225 | if (force_sph_corr)
226 | {
227 | # Select all within factors
228 | mauchlys <- dimnames(sph_tests)[[1]]
229 | }
230 | else
231 | {
232 | # Check which effects do not meet the assumption of sphericity
233 | mauchlys <- dimnames(sph_tests)[[1]][which(sph_tests[, "p-value"] < .05)]
234 | }
235 |
236 | if (length(mauchlys) > 0)
237 | {
238 | # Apply correction to degrees of freedom
239 | tbl[tbl$effects %in% mauchlys, c("df_n", "df_d")] %<>%
240 | # Multiply df with correction factor (epsilon)
241 | `*`(s$pval.adjustments[mauchlys, paste(corr_method, "eps")])
242 |
243 | # Since corrected dfs have decimal places, we need to format these to two
244 | tbl <-
245 | tbl %>%
246 | rowwise() %>%
247 | # . %% 1 == 0 checks if number has decimal places
248 | # As of tibble 3.0.0 we need to manually convert all column entries to
249 | # character, as types are not converted automatically
250 | mutate_at(c("df_n", "df_d"), ~ ifelse(. %% 1 == 0, as.character(.),
251 | fmt_stat(., equal_sign = FALSE)))
252 |
253 | # Replace p-values in tbl with corrected ones
254 | tbl[tbl$effects %in% mauchlys, "p"] <-
255 | s$pval.adjustments[mauchlys, paste0("Pr(>F[", corr_method, "])")] %>%
256 | map_chr(fmt_pval)
257 |
258 | # Update significance asterisks
259 | tbl$symb <-
260 | tbl$p %>%
261 | # P-values have already been formatted, so need to workaround that
262 | map_chr(~ {
263 | if (.x == "< .001")
264 | {
265 | "***"
266 | }
267 | else
268 | {
269 | .x %>% str_extract("[0-9.]+") %>% as.numeric() %>% p_to_symbol()
270 | }
271 | })
272 |
273 | # Add performed corrections to info message
274 | info_msg %<>% paste0(
275 | "Sphericity corrections:\n",
276 | " The following effects were adjusted using the ",
277 | if (corr_method == "GG") "Greenhouse-Geisser" else "Huynh-Feldt",
278 | " correction:\n",
279 | paste0(" ", mauchlys, " (Mauchly's W ",
280 | map_chr(sph_tests[mauchlys, "Test statistic"], fmt_stat),
281 | ", p ", map_chr(sph_tests[mauchlys, "p-value"], fmt_pval), ")",
282 | collapse = "\n")
283 | )
284 | }
285 | else
286 | {
287 | info_msg %<>% paste0(
288 | "Sphericity corrections:\n",
289 | " No corrections applied, all p-values for Mauchly's test p > .05"
290 | )
291 | }
292 | }
293 |
294 | # Reorder rows in tbl
295 | tbl <- reorder_anova_tbl(tbl)
296 |
297 | if (info && info_msg != "") message(info_msg)
298 |
299 | anova_apa_print(tbl, effect, es, format, print)
300 | }
301 |
302 | #' @importFrom dplyr left_join rowwise mutate_at
303 | #' @importFrom magrittr %>% %<>%
304 | #' @importFrom stringr str_extract
305 | #' @importFrom tibble tibble
306 | anova_apa_ezanova <- function(x, effect, sph_corr, force_sph_corr, es, format,
307 | info, print)
308 | {
309 | info_msg <- ""
310 |
311 | anova <- x$ANOVA
312 |
313 | if (!all(c("SSn", "SSd") %in% names(anova)))
314 | {
315 | stop("Parameter 'detailed' needs to be set to TRUE in call to `ezANOVA`")
316 | }
317 |
318 | # Extract information from anova object
319 | tbl <- tibble(
320 | effects = anova$Effect,
321 | statistic = map_chr(anova$F, fmt_stat),
322 | df_n = anova$DFn, df_d = anova$DFd, p = map_chr(anova$p, fmt_pval),
323 | symb = map_chr(anova$p, p_to_symbol),
324 | es = map_chr(effects, ~ fmt_es(do.call(es, list(x, .x)),
325 | leading_zero = FALSE))
326 | )
327 |
328 | # Apply correction for violation of sphericity if required
329 | if ("Mauchly's Test for Sphericity" %in% names(x) && sph_corr != "none")
330 | {
331 | corr_method <- switch(sph_corr, `greenhouse-geisser` =, gg = "GG",
332 | `huynh-feldt` =, hf = "HF")
333 |
334 | # ezANOVA stores sphericity tests and correction values in two data frames,
335 | # which are combined here.
336 | mauchlys <- left_join(x$`Mauchly's Test for Sphericity`,
337 | x$`Sphericity Corrections`, by = "Effect")
338 |
339 | # Checking of significance of Mauchly's test only if user does not want to
340 | # force sphericity correction for all within factors
341 | if (!force_sph_corr)
342 | {
343 | # Check which effects do not meet the assumption of sphericity
344 | mauchlys %<>% `[`(.$p < .05, )
345 | }
346 |
347 | if (nrow(mauchlys) > 0)
348 | {
349 | # Apply correction to degrees of freedom
350 | tbl[match(mauchlys$Effect, tbl$effects), c("df_n", "df_d")] %<>%
351 | # Multiply df with correction factor (epsilon)
352 | `*`(mauchlys[[paste0(corr_method, "e")]])
353 |
354 | # Since corrected dfs have decimal places, we need to format these to two
355 | tbl <-
356 | tbl %>%
357 | rowwise() %>%
358 | # . %% 1 == 0 checks if number has decimal places
359 | # As of tibble 3.0.0 we need to manually convert all column entries to
360 | # character, as types are not converted automatically
361 | mutate_at(c("df_n", "df_d"), ~ ifelse(. %% 1 == 0, as.character(.),
362 | fmt_stat(., equal_sign = FALSE)))
363 |
364 | # Replace p-values in tbl with corrected ones
365 | tbl[match(mauchlys$Effect, tbl$effects), "p"] <-
366 | mauchlys[[paste0("p[", corr_method, "]")]] %>%
367 | map_chr(fmt_pval)
368 |
369 | # Update significance asterisks
370 | tbl$symb <-
371 | tbl$p %>%
372 | # P-values have already been formatted, so need to workaround that
373 | map_chr(~ {
374 | if (.x == "< .001")
375 | {
376 | "***"
377 | }
378 | else
379 | {
380 | .x %>% str_extract("[0-9.]+") %>% as.numeric() %>% p_to_symbol()
381 | }
382 | })
383 |
384 | # Add performed corrections to info message
385 | info_msg %<>% paste0(
386 | "Sphericity corrections:\n",
387 | " The following effects were adjusted using the ",
388 | if (corr_method == "GG") "Greenhouse-Geisser" else "Huynh-Feldt",
389 | " correction:\n",
390 | paste0(" ", mauchlys$Effect, " (Mauchly's W ",
391 | map_chr(mauchlys$W, fmt_stat), ", p ",
392 | map_chr(mauchlys$p, fmt_pval), ")", collapse = "\n")
393 | )
394 | }
395 | else
396 | {
397 | info_msg %<>% paste0(
398 | "Sphericity corrections:\n",
399 | " No corrections applied, all p-values for Mauchly's test p > .05"
400 | )
401 | }
402 | }
403 |
404 | if (info && info_msg != "") message(info_msg)
405 |
406 | anova_apa_print(tbl, effect, es, format, print)
407 | }
408 |
409 | #' @importFrom magrittr %>% %<>%
410 | #' @importFrom purrr map_chr
411 | #' @importFrom rmarkdown render
412 | #' @importFrom tibble tibble
413 | anova_apa_print <- function(tbl, effect, es_name, format, print)
414 | {
415 | # Output for default parameters
416 | if (format == "text" && print)
417 | {
418 | anova_apa_print_default(tbl, effect, es_name)
419 | }
420 | else if (format == "docx")
421 | {
422 | anova_apa_print_docx(tbl, effect, es_name)
423 | }
424 | else
425 | {
426 | # Put the formatted string together
427 | text <- paste0(fmt_symb("F", format), "(", tbl$df_n, ", ", tbl$df_d, ") ",
428 | tbl$statistic, ", ", fmt_symb("p", format), " ", tbl$p, ", ",
429 | fmt_symb(es_name, format), " ", tbl$es)
430 |
431 | if (format == "latex")
432 | {
433 | text <- map_chr(text, fmt_latex)
434 | }
435 | else if (format == "latex_math")
436 | {
437 | text <- map_chr(text, fmt_latex_math)
438 | }
439 | else if (format == "plotmath")
440 | {
441 | return(anova_apa_print_plotmath(tbl, text, effect))
442 | }
443 |
444 | # cat to console
445 | if (print)
446 | {
447 | if (is.null(effect))
448 | {
449 | # Align names of effects
450 | tbl$effects <- format(paste0(tbl$effects, ": "),
451 | width = max(map_chr(tbl$effects, nchar)))
452 |
453 | # Add line breaks
454 | text <- paste0(tbl$effects, text, "\n")
455 |
456 | for (i in seq_along(text))
457 | {
458 | cat(text[i])
459 | }
460 | }
461 | else
462 | {
463 | cat(text[which(tbl$effects == effect)])
464 | }
465 | }
466 | # Return as string(s)
467 | else
468 | {
469 | if (is.null(effect))
470 | {
471 | tibble(effect = tbl$effects, text = text)
472 | }
473 | else
474 | {
475 | text[which(tbl$effects == effect)]
476 | }
477 | }
478 | }
479 | }
480 |
481 | #' @importFrom tibble tibble
482 | anova_apa_print_default <- function(tbl, effect, es_name)
483 | {
484 | # Split test statistic and its sign, because the tabular output will be
485 | # aligned along the test statistic
486 | sign <- substr(tbl$statistic, 1, 1)
487 | statistic <- substr(tbl$statistic, 2, nchar(tbl$statistic))
488 |
489 | tbl <- tibble(
490 | Effect = tbl$effects,
491 | ` ` = paste0("F(", tbl$df_n, ", ", tbl$df_d, ") ", sign,
492 | format(statistic, width = max(nchar(statistic)),
493 | justify = "right"),
494 | ", p ", tbl$p, ", ", fmt_symb(es_name, "text"), " ", tbl$es,
495 | " ", format(tbl$symb, width = 3))
496 | )
497 |
498 | if (is.null(effect))
499 | {
500 | # Use print method from base R data.frame instead of tibble
501 | print.data.frame(tbl)
502 | }
503 | else
504 | {
505 | # Extract text for specified effect from tbl.
506 | `[.data.frame`(tbl, tbl$Effect == effect, " ") %>%
507 | # Remove alignment whitespaces
508 | gsub("[[:blank:]]+", " ", .) %>%
509 | cat()
510 | }
511 | }
512 |
513 | anova_apa_print_docx <- function(tbl, effect, es_name)
514 | {
515 | # Create temporary markdown file
516 | tmp <- tempfile("anova_apa", fileext = ".md")
517 | sink(tmp)
518 | # Put the formatted string together
519 | out <- paste0(tbl$effects, " *F*(", tbl$df_n, ", ", tbl$df_d, ") ",
520 | tbl$statistic, ", *p* ", tbl$p, ", ",
521 | fmt_symb(es_name, "rmarkdown"), " ", tbl$es, "\n\n")
522 |
523 | if (is.null(effect))
524 | {
525 | # Write output line by line to the markdown file
526 | for (i in seq_along(out)) cat(out[i])
527 | }
528 | else
529 | {
530 | # Select only the output string for 'effect'
531 | out[which(tbl$effects == effect)] %>%
532 | # Remove the name of the effect from the beginning of the string
533 | sub("^.*\\s\\*F\\*", "\\*F\\*", .) %>%
534 | # Write to markdown file
535 | cat()
536 | }
537 |
538 | sink()
539 | # Convert markdown to docx
540 | outfile <- render(tmp, output_format = "word_document", quiet = TRUE)
541 |
542 | sys_open(outfile)
543 | }
544 |
545 | anova_apa_print_plotmath <- function(tbl, text, effect)
546 | {
547 | # Check if 'effect' is specified for plotmath format, because we can't print
548 | # a data frame with expressions.
549 | if (is.null(effect))
550 | {
551 | stop("Argument 'effect' must be specified if 'format' is \"plotmath\"")
552 | }
553 |
554 | fmt_plotmath(
555 | text[which(tbl$effects == effect)],
556 | "(\\([0-9]+\\.?[0-9]*, [0-9]+\\.?[0-9]*\\) [<=] [0-9]+\\.[0-9]{2}, )",
557 | "( [<=>] \\.[0-9]{3}, )", "( [<=] -?[0-9]*\\.[0-9]{2}$)"
558 | )
559 | }
560 |
561 | #' @importFrom magrittr %>%
562 | #' @importFrom purrr map map_dbl
563 | reorder_anova_tbl <- function(x)
564 | {
565 | # Get names of all main effects
566 | factors <- grep("[(:]", x$effects, value = TRUE, invert = TRUE)
567 |
568 | # Function for creating names of interaction effects
569 | concat_fctrs <- function(...) paste(..., collapse = ":")
570 |
571 | new_order <-
572 | seq_along(factors) %>%
573 | # Create the new effects order (main effects, two-way interactions, ...)
574 | map(~ combn(factors, .x, FUN = concat_fctrs, simplify = FALSE)) %>%
575 | unlist() %>%
576 | # Add regex for intercept line (if intercept is present in 'x')
577 | {
578 | if (any(grepl("(Intercept)", x$effects)))
579 | c("\\(Intercept\\)", .)
580 | else
581 | .
582 | } %>%
583 | # Get row index for each effect in old ANOVA table
584 | map_dbl(~ grep(paste0("^", .x, "$"), x$effects))
585 |
586 |
587 | # Apply new order to 'x'
588 | x[new_order, ]
589 | }
590 |
--------------------------------------------------------------------------------
/R/apa.R:
--------------------------------------------------------------------------------
1 | #' APA Formatting for RMarkdown Reports
2 | #'
3 | #' A wrapper around the \code{*_apa} functions, providing a convenient way to
4 | #' use the formatters in inline code in RMarkdown documents.
5 | #'
6 | #' @param x An \R object. Must be a call to one of \code{afex::aov_4},
7 | #' \code{afex::aov_car}, \code{afex::aov_ez}, \code{chisq.test},
8 | #' \code{cor.test}, \code{ez::ezANOVA} or \code{t_test}.
9 | #' @param effect (only applicable if \code{x} is an ANOVA) Character string
10 | #' indicating the name of the effect to display. If is \code{NULL}, all
11 | #' effects are reported (default).
12 | #' @param format Character string specifying the output format. One of
13 | #' \code{"text"}, \code{"markdown"}, \code{"rmarkdown"}, \code{html},
14 | #' \code{"latex"} or \code{"docx"}.
15 | #' @param print Logical indicating whether to return the result as an \R object
16 | #' (\code{FALSE}) or print using \code{cat} (\code{TRUE}).
17 | #' @param ... Further arguments passed to other methods
18 | #' @seealso \link{anova_apa}, \link{chisq_apa},
19 | #' \link{cor_apa}, \link{t_apa}
20 | #'
21 | #' @export
22 | apa <- function(x, effect = NULL, format = "rmarkdown", print = FALSE, ...)
23 | {
24 | if (inherits(x, "htest"))
25 | {
26 | if (grepl("Chi-squared test", x$method))
27 | {
28 | chisq_apa(x, format = format, print = print, ...)
29 | }
30 | else if (grepl("correlation", x$method))
31 | {
32 | cor_apa(x, format = format, print = print, ...)
33 | }
34 | else if (grepl("t-test", x$method))
35 | {
36 | t_apa(x, format = format, print = print, ...)
37 | }
38 | else
39 | {
40 | stop("Unkown type passed to 'x'")
41 | }
42 | }
43 | else if (inherits(x, "afex_aov") || (is.list(x) && names(x)[1] == "ANOVA"))
44 | {
45 | anova_apa(x, effect, format = format, print = print, ...)
46 | }
47 | else
48 | {
49 | stop("Unkown type passed to 'x'")
50 | }
51 | }
52 |
--------------------------------------------------------------------------------
/R/chisq_apa.R:
--------------------------------------------------------------------------------
1 | #' Report Chi-squared test in APA style
2 | #'
3 | #' @param x A call to \code{chisq.test}
4 | #' @param print_n Logical indicating whether to show sample size in text
5 | #' @param format Character string specifying the output format. One of
6 | #' \code{"text"}, \code{"markdown"}, \code{"rmarkdown"}, \code{html},
7 | #' \code{"latex"}, \code{"latex_math"}, \code{"docx"} or \code{"plotmath"}.
8 | #' @param info Logical indicating whether to print a message on the used test
9 | #' (default is \code{FALSE})
10 | #' @param print Logical indicating whether to print the formatted output via
11 | #' \code{cat} (\code{TRUE}, default) or return as character string.
12 | #' @examples
13 | #' # Example data from ?chisq.test
14 | #' m <- rbind(c(762, 327, 468), c(484, 239, 477))
15 | #'
16 | #' chisq_apa(chisq.test(m))
17 | #'
18 | #' @export
19 | chisq_apa <- function(x, print_n = FALSE, format = c("text", "markdown",
20 | "rmarkdown", "html",
21 | "latex", "latex_math",
22 | "docx", "plotmath"),
23 | info = FALSE, print = TRUE)
24 | {
25 | format <- match.arg(format)
26 |
27 | # Make sure that 'x' was a call to `chisq.test`
28 | if (!inherits(x, "htest") && !grepl("Chi-squared test", x$method))
29 | {
30 | stop("'x' must be a call to `chisq.test`")
31 | }
32 |
33 | if (format == "docx")
34 | {
35 | return(apa_to_docx("chisq_apa", x))
36 | }
37 |
38 | # Extract and format test statistics
39 | statistic <- fmt_stat(x$statistic)
40 | df <- x$parameter
41 | n <- if (print_n) paste(", n =", sum(x$observed)) else ""
42 | p <- fmt_pval(x$p.value)
43 |
44 | if (info) message(x$method)
45 |
46 | # Put the formatted string together
47 | text <- paste0(fmt_symb("chisq", format), "(", df, n, ") ", statistic, ", ",
48 | fmt_symb("p", format), " ", p)
49 |
50 | # Further formatting for LaTeX and plotmath
51 | if (format == "latex")
52 | {
53 | text <- fmt_latex(text)
54 | }
55 | else if (format == "latex_math")
56 | {
57 | text <- fmt_latex_math(text)
58 | }
59 | else if (format == "plotmath")
60 | {
61 | # Convert text to an expression
62 | text <- fmt_plotmath(text, "(\\([0-9]+.*\\) [<=] [0-9]+\\.[0-9]{2}, )",
63 | "( [<=>] \\.[0-9]{3})")
64 |
65 | # Text is an expression, so we can't use `cat` to print it to the console
66 | print <- FALSE
67 | }
68 |
69 | if (print) cat(text) else text
70 | }
71 |
--------------------------------------------------------------------------------
/R/cohens_d.R:
--------------------------------------------------------------------------------
1 | #' Cohen's d
2 | #'
3 | #' Calculate Cohen's d from raw data or a call to \code{t_test}/\code{t.test}.
4 | #'
5 | #' To calculate Cohen's d from summary statistics (M, SD, ..) use
6 | #' \link{cohens_d_}.
7 | #'
8 | #' @importFrom stats sd
9 | #' @param x A (non-empty) numeric vector of data values.
10 | #' @param y An optional (non-empty) numeric vector of data values.
11 | #' @param paired A logical indicating whether Cohen's d should be calculated for
12 | #' a paired sample or two independent samples \emph{(default)}. Ignored when
13 | #' calculating Cohen's for one sample.
14 | #' @param corr Character specifying the correction applied to calculation of the
15 | #' effect size: \code{"none"} \emph{(default)} returns Cohen's d,
16 | #' \code{"hedges_g"} applies Hedges correction and \code{"glass_delta"}
17 | #' calculates Glass' \eqn{\Delta} (uses the standard deviation of the second
18 | #' group).
19 | #' @param na.rm Logical. Should missing values be removed?
20 | #' @param data A data frame containing either the variables in the formula
21 | #' \code{formula} or the variables specified by \code{dv} and \code{iv}.
22 | #' @param dv Character indicating the name of the column in \code{data} for the
23 | #' dependent variable
24 | #' @param iv Character indicating the name of the column in \code{data} for the
25 | #' independent variable
26 | #' @param formula A formula of the form \code{lhs ~ rhs} where \code{lhs} is a
27 | #' numeric variable giving the data values and \code{rhs}
28 | #' either \code{1} for one sample or paired data or a factor with two levels
29 | #' giving the corresponding groups. If \code{lhs} is of class \code{"Pair"}
30 | #' and \code{rhs} is \code{1}, Cohen's d for paired data will be calculated.
31 | #' @param ttest An object of class \code{htest} (a call to either \code{t_test}
32 | #' (preferred) or \code{t.test}).
33 | #' @param ... Further arguments passed to methods.
34 | #' @references Lakens, D. (2013). Calculating and reporting effect sizes to
35 | #' facilitate cumulative science: a practical primer for t-tests and ANOVAs.
36 | #' \emph{Frontiers in Psychology}, 4, 863. doi:10.3389/fpsyg.2013.00863
37 | #' @examples
38 | #' # Calculate from raw data
39 | #' cohens_d(c(10, 15, 11, 14, 17), c(22, 18, 23, 25, 20))
40 | #'
41 | #' # Methods when working with data frames
42 | #' cohens_d(sleep, dv = extra, iv = group, paired = TRUE)
43 | #' # or
44 | #' cohens_d(sleep, dv = "extra", iv = "group", paired = TRUE)
45 | #' # formula interface
46 | #' sleep2 <- reshape(sleep, direction = "wide", idvar = "ID", timevar = "group")
47 | #' cohens_d(Pair(extra.1, extra.2) ~ 1, sleep2, paired = TRUE)
48 | #'
49 | #' # Or pass a call to t_test or t.test
50 | #' cohens_d(t_test(Pair(extra.1, extra.2) ~ 1, sleep2))
51 | #' @export
52 | cohens_d <- function(...) UseMethod("cohens_d")
53 |
54 | #' @rdname cohens_d
55 | #' @export
56 | cohens_d.default <- function(x, y = NULL, paired = FALSE,
57 | corr = c("none", "hedges_g", "glass_delta"),
58 | na.rm = FALSE, ...)
59 | {
60 | corr <- match.arg(corr)
61 |
62 | # Two independent samples
63 | if (!paired && !is.null(y))
64 | {
65 | m1 <- mean(x, na.rm = na.rm)
66 | m2 <- mean(y, na.rm = na.rm)
67 |
68 | sd1 <- sd(x, na.rm)
69 | sd2 <- sd(y, na.rm)
70 |
71 | n1 <- if (!na.rm) length(x) else length(na.omit(x))
72 | n2 <- if (!na.rm) length(y) else length(na.omit(y))
73 |
74 | d <- cohens_d_(m1, m2, sd1, sd2, n1, n2, corr = corr)
75 | }
76 | else
77 | {
78 | # One sample
79 | if (is.null(y))
80 | {
81 | y <- 0
82 | }
83 | else
84 | {
85 | if (length(x) != length(y)) stop("'x' and 'y' must have the same length")
86 | }
87 |
88 | # Two dependent samples / one sample
89 | d <- mean(x - y, na.rm = na.rm) / sd(x - y, na.rm)
90 |
91 | if (corr == "hedges_g")
92 | {
93 | j <- function(a) gamma(a / 2) / (sqrt(a / 2) * gamma((a - 1) / 2))
94 |
95 | d <- d * j(length(x))
96 | }
97 | }
98 |
99 | d
100 | }
101 |
102 | #' @rdname cohens_d
103 | #' @export
104 | cohens_d.data.frame <- function(data, dv, iv, paired = FALSE,
105 | corr = c("none", "hedges_g", "glass_delta"),
106 | na.rm = FALSE, ...)
107 | {
108 | corr <- match.arg(corr)
109 |
110 | # Convert iv and dv to character if they are a name
111 | if (!is.character(substitute(iv))) iv <- as.character(substitute(iv))
112 | if (!is.character(substitute(dv))) dv <- as.character(substitute(dv))
113 |
114 | sp <- split(data[[dv]], data[[iv]])
115 |
116 | cohens_d(sp[[1]], sp[[2]], paired, corr, na.rm)
117 | }
118 |
119 | #' @rdname cohens_d
120 | #' @export
121 | cohens_d.formula <- function(formula, data,
122 | corr = c("none", "hedges_g", "glass_delta"),
123 | na.rm = FALSE, ...)
124 | {
125 | corr <- match.arg(corr)
126 |
127 | .data <- extract_data_formula(formula, data, ...)
128 |
129 | paired <- grepl("Pair\\(*., *.\\)", as.character(formula)[2])
130 |
131 | do.call("cohens_d", c(.data, paired = paired, corr = corr, na.rm = na.rm))
132 | }
133 |
134 | #' @rdname cohens_d
135 | #' @export
136 | cohens_d.htest <- function(ttest, corr = c("none", "hedges_g", "glass_delta"),
137 | ...)
138 | {
139 | corr <- match.arg(corr)
140 |
141 | if (!grepl("t-test", ttest$method))
142 | {
143 | stop('ttest must be a call to either `t_test` or `t.test`')
144 | }
145 |
146 | if (ttest$null.value != 0)
147 | {
148 | stop(paste(
149 | "`cohens_d` does currently not support t-tests with mu != 0. Please",
150 | "substract mu before passing the values to `t.test`/`t_test`")
151 | )
152 | }
153 |
154 | # A call to `t_test` was passed to argument 'ttest'
155 | if (!is.null(ttest[["data"]]))
156 | {
157 | # t-test for two dependent samples
158 | if (grepl("Paired", ttest$method))
159 | {
160 | cohens_d(ttest$data$x, ttest$data$y, paired = TRUE, corr = corr)
161 | }
162 | # t-test for one sample
163 | else if (grepl("One Sample", ttest$method))
164 | {
165 | cohens_d(ttest$data$x, paired = TRUE, corr = corr)
166 | }
167 | # t-test for two independent samples
168 | else
169 | {
170 | cohens_d(ttest$data$x, ttest$data$y, corr = corr)
171 | }
172 | }
173 | # A call to `t.test` was passed to argument 'ttest'
174 | else
175 | {
176 | # t-test for two dependent samples
177 | if (grepl("Paired", ttest$method))
178 | {
179 | cohens_d_(t = unname(ttest$statistic), n = unname(ttest$parameter + 1),
180 | paired = TRUE, corr = corr)
181 | }
182 | # t-test for one sample
183 | else if (grepl("One Sample", ttest$method))
184 | {
185 | cohens_d_(t = unname(ttest$statistic), n = unname(ttest$parameter + 1),
186 | one_sample = TRUE, corr = corr)
187 | }
188 | # t-test for two independent samples with Welch's correction
189 | else if (grepl("Welch", ttest$method))
190 | {
191 | stop(paste(
192 | "A Welch test from a call to `t.test` is not supported.",
193 | "Use either `t_test` or set argument 'var.equal' in `t.test` to TRUE"))
194 | }
195 | # t-test for two independent samples
196 | else
197 | {
198 | if (corr == "glass_delta")
199 | {
200 | stop(paste(
201 | "Glass Delta is not supported when passing a test from `t.test`.",
202 | "Use `t_test` instead."))
203 | }
204 |
205 | cohens_d_(t = unname(ttest$statistic), n = unname(ttest$parameter + 2),
206 | corr = corr)
207 | }
208 | }
209 | }
210 |
211 | #' Cohen's d
212 | #'
213 | #' Calculate Cohens'd from different statistics (see Details).
214 | #'
215 | #' @param m1 Numeric, mean of the first group
216 | #' @param m2 Numeric, mean of the second group
217 | #' @param sd1 Numeric, standard deviation of the first group
218 | #' @param sd2 Numeric, standard deviation of the second group
219 | #' @param n1 Numeric, size of the first group
220 | #' @param n2 Numeric, size of the second group
221 | #' @param t Numeric, t-test statistic
222 | #' @param n Numeric, total sample size
223 | #' @param paired Logical indicating whether to calculate Cohen's d for
224 | #' independent samples or one sample (\code{FALSE}, \emph{default}) or for
225 | #' dependent samples (\code{TRUE}).
226 | #' @param one_sample Logical indicating whether to calculate Cohen's d for
227 | #' one sample (\code{TRUE}) or independent samples (\code{FALSE},
228 | #' \emph{default}) (only relevant when providing \code{t} and \code{n}, see
229 | #' below).
230 | #' @param corr Character specifying the correction applied to calculation of the
231 | #' effect size: \code{"none"} \emph{(default)} returns Cohen's d,
232 | #' \code{"hedges_g"} applies Hedges correction and \code{"glass_delta"}
233 | #' calculates Glass' \eqn{\Delta} (uses the standard deviation of the second
234 | #' group).
235 | #' @details
236 | #' The following combinations of statistics are possible:
237 | #' \itemize{
238 | #' \item \code{m1}, \code{m2}, \code{sd1}, \code{sd2}, \code{n1} and
239 | #' \code{n2}
240 | #' \item \code{t}, \code{n1} and \code{n2}
241 | #' \item \code{t} and \code{n}
242 | #' }
243 | #' @references
244 | #' Lakens, D. (2013). Calculating and reporting effect sizes to facilitate
245 | #' cumulative science: a practical primer for t-tests and ANOVAs.
246 | #' \emph{Frontiers in Psychology}, 4, 863. doi:10.3389/fpsyg.2013.00863
247 | #' @export
248 | cohens_d_ <- function(m1 = NULL, m2 = NULL, sd1 = NULL, sd2 = NULL, n1 = NULL,
249 | n2 = NULL, t = NULL, n = NULL, paired = FALSE,
250 | one_sample = FALSE, corr = c("none", "hedges_g",
251 | "glass_delta"))
252 | {
253 | corr <- match.arg(corr)
254 |
255 | # Two independent samples with ms, sds and ns (no or hedges correction)
256 | if (!any(sapply(list(m1, m2, sd1, sd2, n1, n2), is.null)) &&
257 | corr != "glass_delta" && !paired)
258 | {
259 | d <- (m1 - m2) /
260 | sqrt(((n1 - 1) * sd1 ^ 2 + (n2 - 1) * sd2 ^ 2) / ((n1 + n2) - 2))
261 | }
262 | # Two independent samples with glass' correction
263 | else if (corr == "glass_delta" && !paired)
264 | {
265 | if (!any(sapply(list(m1, m2, sd2), is.null)))
266 | {
267 | d <- (m1 - m2) / sd2
268 | }
269 | else
270 | {
271 | stop("Arguments 'm1', 'm2' and 'sd2' are required for Glass Delta")
272 | }
273 | }
274 | # Two independent samples with t, n1 and n2
275 | else if (!any(sapply(list(n1, n2, t), is.null)))
276 | {
277 | d <- t * sqrt(1 / n1 + 1 / n2)
278 | }
279 | # Two independent samples with t and n
280 | else if (!any(sapply(list(t, n), is.null)) && !paired && !one_sample)
281 | {
282 | d <- 2 * t / sqrt(n)
283 | }
284 | # Two dependent samples with t and n
285 | else if (!any(sapply(list(t, n), is.null)) && (paired || one_sample))
286 | {
287 | d <- t / sqrt(n)
288 | }
289 |
290 | # Apply Hedges g correction, if requested
291 | if (corr == "hedges_g")
292 | {
293 | j <- function(a) gamma(a / 2) / (sqrt(a / 2) * gamma((a - 1) / 2))
294 |
295 | if (paired || one_sample)
296 | {
297 | d <- d * j(n)
298 | }
299 | else
300 | {
301 | d <- d * j(n1 + n2 - 2)
302 | }
303 | }
304 |
305 | d
306 | }
307 |
308 | #' @importFrom MBESS conf.limits.nct
309 | cohens_d_ci <- function(ttest)
310 | {
311 | if (grepl("Welch", ttest$method))
312 | {
313 | stop(paste(
314 | "A Welch test is currently not supported for confidence interval",
315 | "calculation. Set argument 'var.equal' in `t.test` to TRUE"))
316 | }
317 |
318 | conf_lims_t <- conf.limits.nct(ttest$statistic, ttest$parameter)
319 |
320 | # Two dependent samples or one sample
321 | if (grepl("Paired", ttest$method))
322 | {
323 | lower_d <- cohens_d_(t = conf_lims_t$Lower.Limit, n = ttest$parameter + 1,
324 | paired = TRUE)
325 | upper_d <- cohens_d_(t = conf_lims_t$Upper.Limit, n = ttest$parameter + 1,
326 | paired = TRUE)
327 | }
328 | else if (grepl("One Sample", ttest$method))
329 | {
330 | lower_d <- cohens_d_(t = conf_lims_t$Lower.Limit, n = ttest$parameter + 1,
331 | one_sample = TRUE)
332 | upper_d <- cohens_d_(t = conf_lims_t$Upper.Limit, n = ttest$parameter + 1,
333 | one_sample = TRUE)
334 | }
335 | # t-test for two independent samples
336 | else
337 | {
338 | lower_d <- cohens_d_(t = conf_lims_t$Lower.Limit, n = ttest$parameter + 2)
339 | upper_d <- cohens_d_(t = conf_lims_t$Upper.Limit, n = ttest$parameter + 2)
340 | }
341 |
342 | paste0("[", fmt_es(lower_d, equal_sign = FALSE), "; ",
343 | fmt_es(upper_d, equal_sign = FALSE), "]")
344 | }
345 |
--------------------------------------------------------------------------------
/R/cor_apa.R:
--------------------------------------------------------------------------------
1 | #' Report Correlation in APA style
2 | #'
3 | #' @param x A call to \code{cor.test}
4 | #' @param r_ci Logical indicating whether to display the confidence interval
5 | #' for the correlation coefficient (default is \code{FALSE}). Only available
6 | #' for Pearson's product moment correlation (with n >= 4).
7 | #' @param format Character string specifying the output format. One of
8 | #' \code{"text"}, \code{"markdown"}, \code{"rmarkdown"}, \code{html},
9 | #' \code{"latex"}, \code{"latex_math"}, \code{"docx"} or \code{"plotmath"}.
10 | #' @param info Logical indicating whether to print a message on the used test
11 | #' (default is \code{FALSE})
12 | #' @param print Logical indicating whether to print the formatted output via
13 | #' \code{cat} (\code{TRUE}, default) or return as character string.
14 | #' @examples
15 | #' # Example data from ?cor.test
16 | #' x <- c(44.4, 45.9, 41.9, 53.3, 44.7, 44.1, 50.7, 45.2, 60.1)
17 | #' y <- c( 2.6, 3.1, 2.5, 5.0, 3.6, 4.0, 5.2, 2.8, 3.8)
18 | #'
19 | #' cor_apa(cor.test(x, y))
20 | #'
21 | #' # Spearman's rho
22 | #' cor_apa(cor.test(x, y, method = "spearman"))
23 | #'
24 | #' # Kendall's tau
25 | #' cor_apa(cor.test(x, y, method = "kendall"))
26 | #'
27 | #' @export
28 | cor_apa <- function(x, r_ci = FALSE,
29 | format = c("text", "markdown", "rmarkdown", "html", "latex",
30 | "latex_math", "docx", "plotmath"),
31 | info = FALSE, print = TRUE)
32 | {
33 | format <- match.arg(format)
34 |
35 | # Make sure that 'x' was a call to `cor.test`
36 | if (!inherits(x, "htest") && !grepl("correlation", x$method))
37 | {
38 | stop("'x' must be a call to `cor.test`")
39 | }
40 |
41 | if (format == "docx")
42 | {
43 | return(apa_to_docx("cor_apa", x))
44 | }
45 |
46 | # Extract and format test statistics
47 | coef <- tolower(strsplit(x$method, " ")[[1]][1])
48 | estimate <- fmt_stat(x$estimate, leading_zero = FALSE)
49 | df <- x$parameter
50 | p <- fmt_pval(x$p.value)
51 |
52 | if (r_ci)
53 | {
54 | if (is.null(x$conf.int))
55 | {
56 | warning(paste("Confidence interval only available for Pearson's product",
57 | "moment correlation (with n >= 4)"))
58 |
59 | r_ci <- FALSE
60 | }
61 | else
62 | {
63 | ci <- fmt_stat(x$conf.int, leading_zero = FALSE, equal_sign = FALSE)
64 | }
65 | }
66 |
67 | if (info) message(x$method)
68 |
69 | # Put the formatted string together
70 | text <- paste0(
71 | fmt_symb(coef, format),
72 | if (coef == "pearson's") paste0("(", df, ") ") else " ", estimate,
73 | if (r_ci) paste0(" [", ci[1], "; ", ci[2], "]"), ", ",
74 | fmt_symb("p", format), " ", p)
75 |
76 | # Further formatting for LaTeX and plotmath
77 | if (format == "latex")
78 | {
79 | text <- fmt_latex(text)
80 | }
81 | else if (format == "latex_math")
82 | {
83 | text <- fmt_latex_math(text)
84 | }
85 | else if (format == "plotmath")
86 | {
87 | # Convert text to an expression
88 | text <- fmt_plotmath(text, "(\\([0-9]+\\))", "( [<=] -?\\.[0-9]{2}, )",
89 | "( [<=>] \\.[0-9]{3})")
90 |
91 | # Text is an expression, so we can't use `cat` to print it to the console
92 | print <- FALSE
93 | }
94 |
95 | if (print) cat(text) else text
96 | }
97 |
--------------------------------------------------------------------------------
/R/eta_squared.R:
--------------------------------------------------------------------------------
1 | #' Partial Eta Squared
2 | #'
3 | #' @param x A call to \code{aov}, \code{ez::ezANOVA} or \code{afex::aov_ez} or
4 | #' \code{afex::aov_car} or \code{afex::aov_4}
5 | #' @param effect Character string indicating the name of the effect for which
6 | #' the partial eta squared should be returned.
7 | #' @export
8 | petasq <- function(x, effect)
9 | {
10 | # Use a pseudo-S3 method dispatch here, because `ezANOVA` returns a list
11 | # without a particular class
12 |
13 | # aov
14 | if (inherits(x, "aov"))
15 | {
16 | petasq_aov(x, effect)
17 | }
18 | # aovlist
19 | else if (inherits(x, "aovlist"))
20 | {
21 | petasq_aovlist(x, effect)
22 | }
23 | # afex
24 | else if (inherits(x, "afex_aov"))
25 | {
26 | petasq_afex(x, effect)
27 | }
28 | # ez::ezANOVA
29 | else if (is.list(x) && names(x)[1] == "ANOVA")
30 | {
31 | petasq_ezanova(x, effect)
32 | }
33 | else
34 | {
35 | stop("Unknown object passed to argument 'x'")
36 | }
37 | }
38 |
39 | #' @importFrom magrittr %<>%
40 | #' @importFrom stringr str_trim
41 | petasq_aov <- function(x, effect)
42 | {
43 | x <- summary(x, intercept = TRUE)[[1]]
44 |
45 | row.names(x) %<>% str_trim()
46 |
47 | if (!effect %in% row.names(x))
48 | {
49 | stop("Specified effect not found")
50 | }
51 |
52 | petasq_(x[effect, "Sum Sq"], x["Residuals", "Sum Sq"])
53 | }
54 |
55 | #' @importFrom purrr flatten
56 | #' @importFrom stringr str_trim
57 | petasq_aovlist <- function(x, effect)
58 | {
59 | if (!effect %in% attr(x$`(Intercept)`$terms, "term.labels"))
60 | {
61 | stop("Specified effect not found")
62 | }
63 |
64 | # summary.aovlist is a list of lists containing data frames
65 | x <- flatten(summary(x))
66 |
67 | # Look through data frames for specified effect
68 | for (i in seq_along(x))
69 | {
70 | df <- x[[i]]
71 |
72 | row <- which(str_trim(row.names(df)) == effect)
73 |
74 | if (length(row) > 0)
75 | {
76 | petasq <- petasq_(df[row, "Sum Sq"], df["Residuals", "Sum Sq"])
77 | }
78 | }
79 |
80 | petasq
81 | }
82 |
83 | petasq_afex <- function(x, effect)
84 | {
85 | anova <- anova(x, es = "pes", intercept = TRUE)
86 |
87 | if (!effect %in% row.names(anova))
88 | {
89 | stop("Specified effect not found")
90 | }
91 |
92 | anova[effect, "pes"]
93 | }
94 |
95 | petasq_ezanova <- function(x, effect)
96 | {
97 | anova <- x$ANOVA
98 |
99 | if (!all(c("SSn", "SSd") %in% names(anova)))
100 | {
101 | stop("Parameter 'detailed' needs to be set to TRUE in call to `ezANOVA`")
102 | }
103 |
104 | if (!effect %in% anova$Effect)
105 | {
106 | stop("Specified effect not found")
107 | }
108 | else
109 | {
110 | row <- which(anova$Effect == effect)
111 | }
112 |
113 | petasq_(anova[row, "SSn"], anova[row, "SSd"])
114 | }
115 |
116 | #' Partial Eta Squared
117 | #'
118 | #' Calculate the partial eta squared effect size from sum of
119 | #' squares.
120 | #' \deqn{\eta_p^2 = \frac{SS_effect}{SS_effect + SS_error}}{partial eta squared
121 | #' = SS_effect / (SS_effect + SS_error)}
122 | #'
123 | #' @param ss_effect numeric, sum of squares of the effect
124 | #' @param ss_error numeric, sum of squares of the corresponding error
125 | #' @export
126 | petasq_ <- function(ss_effect, ss_error)
127 | {
128 | ss_effect / (ss_effect + ss_error)
129 | }
130 |
131 | getasq <- function(x, effect)
132 | {
133 | # Use a pseudo-S3 method dispatch here, because `ezANOVA` returns a list
134 | # without a particular class
135 |
136 | # afex
137 | if (inherits(x, "afex_aov"))
138 | {
139 | getasq_afex(x, effect)
140 | }
141 | # ez::ezANOVA
142 | else if (is.list(x) && names(x)[1] == "ANOVA")
143 | {
144 | getasq_ezanova(x, effect)
145 | }
146 | }
147 |
148 | getasq_afex <- function(x, effect)
149 | {
150 | # afex drops the 'observed' argument when calling `anova` on the afex_aov
151 | # object, so we need to get the getasq values from $anova_table. The only
152 | # thing we can't retrieve is the getasq for the intercept ...
153 | if (effect == "(Intercept)")
154 | {
155 | return(NA)
156 | }
157 |
158 | anova <- x$anova_table
159 |
160 | if (!"ges" %in% names(anova))
161 | {
162 | stop("Argument 'es' needs to be set to \"ges\" in call to `aov_*`")
163 | }
164 |
165 | if (!effect %in% row.names(anova))
166 | {
167 | stop("Specified effect not found")
168 | }
169 |
170 | anova[effect, "ges"]
171 | }
172 |
173 | getasq_ezanova <- function(x, effect)
174 | {
175 | anova <- x$ANOVA
176 |
177 | if (!all(c("SSn", "SSd") %in% names(anova)))
178 | {
179 | stop("Parameter 'detailed' needs to be set to TRUE in call to `ezANOVA`")
180 | }
181 |
182 | if (!effect %in% anova$Effect)
183 | {
184 | stop("Specified effect not found")
185 | }
186 |
187 | anova[which(anova$Effect == effect), "ges"]
188 | }
189 |
--------------------------------------------------------------------------------
/R/global_variables.R:
--------------------------------------------------------------------------------
1 | # Silence R CMD check which complains about "no visible binding for global
2 | # variable X"
3 | globalVariables(".")
4 | globalVariables("effects")
5 |
--------------------------------------------------------------------------------
/R/t_apa.R:
--------------------------------------------------------------------------------
1 | #' Report t-Test in APA style
2 | #'
3 | #' @param x A call to \code{t_test} or \code{t.test}
4 | #' @param es Character specifying the effect size to report. One of
5 | #' \code{"cohens_d"} (default), \code{"hedges_g"} or \code{"glass_delta"} if
6 | #' \code{x} is an independent samples t-test. Ignored if \code{x} is a paired
7 | #' samples or one sample t-test (cohen's d is reported for these test).
8 | #' @param es_ci Logical indicating whether to add the 95\% confidence interval
9 | #' for Cohen's d (experimental; default is \code{FALSE}).
10 | #' @param format Character string specifying the output format. One of
11 | #' \code{"text"}, \code{"markdown"}, \code{"rmarkdown"}, \code{html},
12 | #' \code{"latex"}, \code{"latex_math"}, \code{"docx"} or \code{"plotmath"}.
13 | #' @param info Logical indicating whether to print a message on the used test
14 | #' (default is \code{FALSE})
15 | #' @param print Logical indicating whether to print the formatted output via
16 | #' \code{cat} (\code{TRUE}, default) or return as character string.
17 | #' @examples
18 | #' # Two independent samples t-test
19 | #' t_apa(t_test(1:10, y = c(7:20)))
20 | #'
21 | #' # Two dependent samples t-test
22 | #' sleep2 <- reshape(sleep, direction = "wide", idvar = "ID", timevar = "group")
23 | #' t_apa(t_test(Pair(extra.1, extra.2) ~ 1, sleep2))
24 | #'
25 | #' @export
26 | t_apa <- function(x, es = c("cohens_d", "hedges_g", "glass_delta"),
27 | es_ci = FALSE, format = c("text", "markdown", "rmarkdown",
28 | "html", "latex", "latex_math",
29 | "docx", "plotmath"),
30 | info = FALSE, print = TRUE)
31 | {
32 | format <- match.arg(format)
33 | es <- match.arg(es)
34 |
35 | # Make sure that 'x' was a call to `t_test` or `t.test`
36 | if (!inherits(x, "htest") && !grepl("t-test", x$method))
37 | {
38 | stop("'x' must be a call to `t_test` or `t.test`")
39 | }
40 |
41 | if (format == "docx")
42 | {
43 | return(apa_to_docx("t_apa", x, es = es))
44 | }
45 |
46 | if (es_ci && grepl("Two", x$method) && (es != "cohens_d" ||
47 | grepl("Welch", x$method)))
48 | {
49 | warning(paste("Confidence intervals currently only supported for",
50 | "'cohens_d' and non-Welch test. Will omit confidence",
51 | "interval."))
52 |
53 | es_ci <- FALSE
54 | }
55 |
56 | # Check if Glass' Delta was requested for one sample or paired t-test.
57 | if (es == "glass_delta" && (grepl("One Sample|Paired", x$method)))
58 | {
59 | warning(paste0("'", es, "' not available for ", x$method, ",",
60 | " 'cohens_d' will be reported instead."))
61 | es <- "cohens_d"
62 | }
63 |
64 | # Extract and format test statistics
65 | statistic <- fmt_stat(x$statistic)
66 | df <- x$parameter
67 | p <- fmt_pval(x$p.value)
68 | d <- fmt_es(cohens_d(x, corr = if (es == "cohens_d") "none" else es))
69 | d_ci <- if (es_ci) paste0(" ", cohens_d_ci(x)) else ""
70 |
71 | # Format degrees of freedom if Welch correction was applied
72 | if (grepl("Welch", x$method))
73 | {
74 | df <- fmt_stat(df, equal_sign = FALSE)
75 | }
76 |
77 | if (info) message(x$method)
78 |
79 | # Put the formatted string together
80 | text <- paste0(fmt_symb("t", format), "(", df, ") ", statistic, ", ",
81 | fmt_symb("p", format), " ", p, ", ", fmt_symb(es, format), " ",
82 | d, d_ci)
83 |
84 | # Further formatting for LaTeX and plotmath
85 | if (format == "latex")
86 | {
87 | text <- fmt_latex(text)
88 | }
89 | else if (format == "latex_math")
90 | {
91 | text <- fmt_latex_math(text)
92 | }
93 | else if (format == "plotmath")
94 | {
95 | # Convert text to an expression
96 | text <- fmt_plotmath(
97 | text, "(\\([0-9]+\\.*[0-9]*\\) [<=] -?[0-9]+\\.[0-9]{2}, )",
98 | "( [<=>] \\.[0-9]{3}, )", "( [<=] -?[0-9]+\\.[0-9]{2}$)"
99 | )
100 |
101 | # Text is an expression, so we can't use `cat` to print it to the console
102 | print <- FALSE
103 | }
104 |
105 | if (print) cat(text) else text
106 | }
107 |
--------------------------------------------------------------------------------
/R/t_test.R:
--------------------------------------------------------------------------------
1 | #' Student's t-Test
2 | #'
3 | #' A wrapper for \code{t.test} which includes the original data in the returned
4 | #' object.
5 | #'
6 | #' @inheritParams stats::t.test
7 | #' @seealso \link{t.test}
8 | #'
9 | #' @export
10 | t_test <- function(x, ...) UseMethod("t_test")
11 |
12 | #' @rdname t_test
13 | #' @importFrom stats complete.cases na.omit setNames t.test
14 | #' @export
15 | t_test.default <- function(x, y = NULL,
16 | alternative = c("two.sided", "less", "greater"),
17 | mu = 0, paired = FALSE, var.equal = FALSE,
18 | conf.level = 0.95, ...)
19 | {
20 | t <- t.test(x = x, y = y, alternative = alternative, mu = mu, paired = paired,
21 | var.equal = var.equal, conf.level = conf.level, ...)
22 |
23 | # Ensure that the 'data.name' element in the returned list matches that of a
24 | # call to t.test (is "x and y" otherwise)
25 | if (is.null(y))
26 | {
27 | dname <- deparse(substitute(x))
28 | }
29 | else
30 | {
31 | dname <- paste(deparse(substitute(x)), "and", deparse(substitute(y)))
32 | }
33 |
34 | t$data.name <- dname
35 |
36 | # Add data to return list, remove NA
37 | if (is.null(y))
38 | {
39 | t[["data"]]$x <- na.omit(x)
40 | }
41 | else if (!paired)
42 | {
43 | t[["data"]]$x <- na.omit(x)
44 | t[["data"]]$y <- na.omit(y)
45 | }
46 | else
47 | {
48 | t[["data"]]$x <- x[complete.cases(x, y)]
49 | t[["data"]]$y <- y[complete.cases(x, y)]
50 | }
51 |
52 | t
53 | }
54 |
55 | #' @rdname t_test
56 | #' @importFrom stats t.test
57 | #' @export
58 | t_test.formula <- function(formula, data, subset, na.action, ...)
59 | {
60 | t <- t.test(formula = formula, data = data, ...)
61 |
62 | t[["data"]] <- extract_data_formula(formula, data, ...)
63 |
64 | t
65 | }
66 |
--------------------------------------------------------------------------------
/R/utils.R:
--------------------------------------------------------------------------------
1 | #' @importFrom stats terms
2 | # Extract data from a data frame using a formula
3 | extract_data_formula <- function(formula, data, ...)
4 | {
5 | x <- list()
6 |
7 | # Extract data using the code from stats/R/t.test.R
8 | oneSampleOrPaired <- FALSE
9 | if (length(attr(terms(formula[-2L]), "term.labels")) != 1L)
10 | if (formula[[3L]] == 1L)
11 | oneSampleOrPaired <- TRUE
12 | else
13 | stop("'formula' missing or incorrect")
14 | m <- match.call(expand.dots = FALSE)
15 | if (is.matrix(eval(m$data, parent.frame())))
16 | m$data <- as.data.frame(data)
17 | ## need stats:: for non-standard evaluation
18 | m[[1L]] <- quote(stats::model.frame)
19 | m$... <- NULL
20 | mf <- eval(m, parent.frame())
21 | names(mf) <- NULL
22 | response <- attr(attr(mf, "terms"), "response")
23 | if (! oneSampleOrPaired) {
24 | g <- factor(mf[[-response]])
25 | if (nlevels(g) != 2L)
26 | stop("grouping factor must have exactly 2 levels")
27 | DATA <- split(mf[[response]], g)
28 | # apa: set data for two sample t-test
29 | x$x <- DATA[[1L]][complete.cases(DATA[[1L]], DATA[[2L]])]
30 | x$y <- DATA[[2L]][complete.cases(DATA[[1L]], DATA[[2L]])]
31 | }
32 | else { # 1-sample and paired tests
33 | respVar <- mf[[response]]
34 | if (inherits(respVar, "Pair")) {
35 | # apa: set data for paired t-test
36 | x$x <- respVar[, 1L][complete.cases(respVar[, 1L],
37 | respVar[, 2L])]
38 | x$y <- respVar[, 2L][complete.cases(respVar[, 1L],
39 | respVar[, 2L])]
40 | }
41 | else {
42 | # apa: set data for one sample t-test
43 | x$x <- na.omit(respVar)
44 | }
45 | }
46 |
47 | x
48 | }
49 |
--------------------------------------------------------------------------------
/R/utils_docx.R:
--------------------------------------------------------------------------------
1 | # Create a docx file and open it
2 | apa_to_docx <- function(fun, x, ...)
3 | {
4 | tmp <- tempfile("to_apa", fileext = ".md")
5 | sink(tmp)
6 | do.call(fun, list(x, format = "rmarkdown", ...))
7 | sink()
8 | outfile <- render(tmp, output_format = "word_document", quiet = TRUE)
9 |
10 | sys_open(outfile)
11 | }
12 |
13 | # Open a file with standard application on different operating systems
14 | sys_open <- function(filename)
15 | {
16 | sys <- Sys.info()[['sysname']]
17 |
18 | if (sys == "Windows")
19 | {
20 | shell(paste0("\"", filename, "\""))
21 | }
22 | else if (sys == "Linux")
23 | {
24 | system(paste0("xdg-open \"", filename, "\""))
25 | }
26 | else if (sys == "Darwin")
27 | {
28 | system(paste0("open \"", filename, "\""))
29 | }
30 | }
31 |
--------------------------------------------------------------------------------
/R/utils_format.R:
--------------------------------------------------------------------------------
1 | # Format a statistic, e.g. t, F, mean, standard deviation
2 | fmt_stat <- function(statistic, leading_zero = TRUE, equal_sign = TRUE,
3 | negative_values = TRUE)
4 | {
5 | if (!negative_values && statistic < .01)
6 | {
7 | statistic <- "< 0.01"
8 | }
9 | else
10 | {
11 | statistic <- sprintf("%.2f", statistic)
12 |
13 | if (equal_sign)
14 | {
15 | statistic <- paste("=", statistic)
16 | }
17 | }
18 |
19 | if (!leading_zero)
20 | {
21 | statistic <- sub("0\\.", "\\.", statistic)
22 | }
23 |
24 | statistic
25 | }
26 |
27 | # Format a p-value
28 | fmt_pval <- function(p, equal_sign = TRUE)
29 | {
30 | if (p < .001)
31 | {
32 | "< .001"
33 | }
34 | else if (isTRUE(all.equal(p, 1)))
35 | {
36 | "> .999"
37 | }
38 | else if (equal_sign)
39 | {
40 | paste("=", substr(sprintf("%.3f", p), 2, 5))
41 | }
42 | else
43 | {
44 | substr(sprintf("%.3f", p), 2, 5)
45 | }
46 | }
47 |
48 | # Format an effect size
49 | fmt_es <- function(es, leading_zero = TRUE, equal_sign = TRUE)
50 | {
51 | if (is.na(es))
52 | {
53 | return(ifelse(leading_zero, "= NA", "= NA"))
54 | }
55 |
56 | if (abs(es) < .01)
57 | {
58 | es <- "< 0.01"
59 | }
60 | else if (equal_sign)
61 | {
62 | es <- paste("=", sprintf("%.2f", es))
63 | }
64 | else
65 | {
66 | es <- sprintf("%.2f", es)
67 | }
68 |
69 | if (!leading_zero)
70 | {
71 | if (es == "= 1.00")
72 | {
73 | es <- "> .99"
74 | }
75 | else
76 | {
77 | es <- sub("0.", ".", es)
78 | }
79 | }
80 |
81 | es
82 | }
83 |
84 | # Format symbols (e.g. chi-squared, d, F, partial eta-squared)
85 | fmt_symb <- function(x, format)
86 | {
87 | if (format == "text")
88 | {
89 | switch(x,
90 | "chisq" = "chi^2",
91 | "cohens_d" = "d",
92 | "F" = "F",
93 | "getasq" = "getasq",
94 | "glass_delta" = "Delta",
95 | "hedges_g" = "g",
96 | "kendall's" = "r_tau",
97 | "p" = "p",
98 | "pearson's" = "r",
99 | "petasq" = "petasq",
100 | "r" = "r",
101 | "spearman's" = "r_s",
102 | "t" = "t")
103 | }
104 | else if (format == "latex")
105 | {
106 | switch(x,
107 | "chisq" = "$\\chi^2$",
108 | "cohens_d" = "\\textit{d}",
109 | "F" = "\\textit{F}",
110 | "getasq" = "$\\eta^2_g$",
111 | "glass_delta" = "$\\Delta$",
112 | "hedges_g" = "\\textit{g}",
113 | "kendall's" = "$r_\\tau$",
114 | "p" = "\\textit{p}",
115 | "pearson's" = "\\textit{r}",
116 | "petasq" = "$\\eta^2_p$",
117 | "r" = "\\textit{r}",
118 | "spearman's" = "$r_s$",
119 | "t" = "\\textit{t}")
120 | }
121 | else if (format == "latex_math")
122 | {
123 | switch(x,
124 | "chisq" = "\\chi^2",
125 | "cohens_d" = "d",
126 | "F" = "F",
127 | "getasq" = "\\eta^2_g",
128 | "glass_delta" = "\\Delta",
129 | "hedges_g" = "g",
130 | "kendall's" = "r_\\tau",
131 | "p" = "p",
132 | "pearson's" = "r",
133 | "petasq" = "\\eta^2_p",
134 | "r" = "r",
135 | "spearman's" = "r_s",
136 | "t" = "t")
137 | }
138 | else if (format == "markdown")
139 | {
140 | switch(x,
141 | "chisq" = "*chi^2*",
142 | "cohens_d" = "*d*",
143 | "F" = "*F*",
144 | "getasq" = "*getasq*",
145 | "glass_delta" = "*Delta*",
146 | "hedges_g" = "*g*",
147 | "kendall's" = "*r_tau*",
148 | "p" = "*p*",
149 | "pearson's" = "*r*",
150 | "petasq" = "*petasq*",
151 | "r" = "*r*",
152 | "spearman's" = "*r_s*",
153 | "t" = "*t*")
154 | }
155 | else if (format == "rmarkdown")
156 | {
157 | switch(x,
158 | "chisq" = "$\\chi^2$",
159 | "cohens_d" = "*d*",
160 | "F" = "*F*",
161 | "getasq" = "$\\eta^2_g$",
162 | "glass_delta" = "$\\Delta$",
163 | "hedges_g" = "*g*",
164 | "kendall's" = "$r_\\tau$",
165 | "p" = "*p*",
166 | "pearson's" = "*r*",
167 | "petasq" = "$\\eta^2_p$",
168 | "r" = "*r*",
169 | "spearman's" = "$r_s$",
170 | "t" = "*t*")
171 | }
172 | else if (format == "html")
173 | {
174 | switch(x,
175 | "chisq" = "χ2",
176 | "cohens_d" = "d",
177 | "F" = "F",
178 | "getasq" = "η2g",
179 | "glass_delta" = "Δ",
180 | "hedges_g" = "g",
181 | "kendall's" = "rτ",
182 | "p" = "p",
183 | "pearson's" = "r",
184 | "petasq" = "η2p",
185 | "r" = "r",
186 | "spearman's" = "rs",
187 | "t" = "t")
188 | }
189 | else if (format == "plotmath")
190 | {
191 | switch(x,
192 | "chisq" = "chi^2",
193 | "cohens_d" = "italic('d')",
194 | "F" = "italic('F')",
195 | "getasq" = "eta[g]^2",
196 | "glass_delta" = "Delta",
197 | "hedges_g" = "italic('g')",
198 | "kendall's" = "italic(r)[tau]",
199 | "p" = "italic('p')",
200 | "pearson's" = "italic('r')",
201 | "petasq" = "eta[p]^2",
202 | "r" = "italic('r')",
203 | "spearman's" = "italic(r)[s]",
204 | "t" = "italic('t')")
205 | }
206 | }
207 |
208 | # Format a p-value as symbol (e.g. p = .008 as **)
209 | p_to_symbol <- function(p)
210 | {
211 | if (is.na(p))
212 | {
213 | ""
214 | }
215 | else if (p >= .1)
216 | {
217 | ""
218 | }
219 | else if (p < .1 && p >= .05)
220 | {
221 | "."
222 | }
223 | else if (p < .05 && p >= .01)
224 | {
225 | "*"
226 | }
227 | else if (p < .01 && p >= .001)
228 | {
229 | "**"
230 | }
231 | else if (p < .001)
232 | {
233 | "***"
234 | }
235 | }
236 |
237 | # Format character strings for better LaTeX printing (i.e. insert non-breaking
238 | # spaces at appropriate positions)
239 | #' @importFrom magrittr %>%
240 | fmt_latex <- function(text)
241 | {
242 | text %>%
243 | # Non-breaking spaces around equal sign, smaller than and greater than
244 | gsub(" ([<=>]) ", "~\\1~", .) %>%
245 | # Non-breaking space between degrees of freedom in F-value
246 | gsub("(\\([0-9]+.*,) ([0-9]+.*\\))", "\\1~\\2", .) %>%
247 | # Non-breaking spaces if n is displayed in chi^2 parantheses
248 | gsub("(, n)", ",~n", .)
249 | }
250 |
251 | # Format character strings for better LaTeX math mode printing
252 | #' @importFrom magrittr %>%
253 | #' @importFrom purrr as_vector map_chr
254 | #' @importFrom stringr str_split str_replace
255 | fmt_latex_math <- function(text)
256 | {
257 | text %>%
258 | # Split string at commas (but not if comma is in parenthesis, e.g. F(1, 50))
259 | str_split(", (?![^(]*\\))") %>%
260 | as_vector() %>%
261 | # Put each piece in a math environment
262 | map_chr(~ paste0("$", .x, "$")) %>%
263 | # Add commas again
264 | paste(collapse = ", ") %>%
265 | # Fix spacing if confidence interval is present (i.e., put confidence
266 | # interval in its own math environment)
267 | str_replace(" \\[", "$ $[")
268 | }
269 |
270 | # Convert APA text to an expression in R's plotmath syntax
271 | #' @importFrom stringr str_trim
272 | fmt_plotmath <- function(text, ...)
273 | {
274 | # Remove significance asterisks if there are any
275 | text <- str_trim(gsub("\\**", "", text))
276 |
277 | dots <- list(...)
278 |
279 | # Enclose plain text in single quotes and add comma between plotmath syntax
280 | # and plain text because we are going to put everything in a call to `paste`.
281 | for (i in seq_along(dots))
282 | {
283 | # If it is not the last element to be replaced, add comma before and after
284 | if (i < length(dots))
285 | {
286 | text <- sub(dots[[i]], ", '\\1', ", text)
287 | }
288 | else
289 | {
290 | text <- sub(dots[[i]], ", '\\1'", text)
291 | }
292 | }
293 |
294 | text <- paste0("paste(", text, ")")
295 |
296 | # Create the expression
297 | parse(text = text)
298 | }
299 |
--------------------------------------------------------------------------------
/README.md:
--------------------------------------------------------------------------------
1 | # apa
2 |
3 | apa's functions format output of statistical tests according to guidelines of the APA (American Psychological Association), ready to copy-and-paste into manuscripts.
4 |
5 | The idea of such formatters was introduced in the [schoRsch package](https://cran.r-project.org/package=schoRsch/). apa generalizes this idea by providing formatters for different output formats (text, Markdown, RMarkdown, HTML, LaTeX, LaTeX inline math, docx and R's plotmath syntax).
6 |
7 | Currently available formatters are:
8 |
9 | - `anova_apa()`2
10 | - `chisq_apa()`
11 | - `cor_apa()`
12 | - `t_apa()`
13 |
14 | Further miscellaneous functions:
15 |
16 | - `apa()`: A wrapper around the `*_apa()`-functions for use in inline code in RMarkdown documents.
17 | - `cohens_d()` / `cohens_d_()`: Calculate Cohen's d effect size (from raw data, t-test or statistical parameters). Also supports Hedge's g* and Glass's Δ.
18 | - `t_test`: A wrapper around `t.test()` that includes the original data in its return list (in order to calculate the effect size in `cohens_d()` and `t_apa()` directly from the data).
19 |
20 | 1 [pandoc](http://pandoc.org/) is required for docx output and needs to be installed manually when not using RStudio (which ships pandoc).
21 |
22 | 2 Supports input from `aov()`, `ezANOVA()` from the [ez package](https://cran.r-project.org/package=ez) and `aov_ez()` / `aov_car()` / `aov_4()` from the [afex package](https://cran.r-project.org/package=afex).
23 |
24 | ## Installation
25 |
26 | The development version can be installed using:
27 |
28 | ```r
29 | # install.packages("devtools")
30 | devtools::install_github("dgromer/apa")
31 | ```
32 |
33 | ## Related approaches
34 |
35 | - [schoRsch](https://cran.r-project.org/package=schoRsch/)
36 | - [papaja](https://github.com/crsh/papaja)
37 |
--------------------------------------------------------------------------------
/apa.Rproj:
--------------------------------------------------------------------------------
1 | Version: 1.0
2 |
3 | RestoreWorkspace: No
4 | SaveWorkspace: No
5 | AlwaysSaveHistory: Default
6 |
7 | EnableCodeIndexing: Yes
8 | UseSpacesForTab: Yes
9 | NumSpacesForTab: 2
10 | Encoding: UTF-8
11 |
12 | RnwWeave: Sweave
13 | LaTeX: pdfLaTeX
14 |
15 | AutoAppendNewline: Yes
16 | StripTrailingWhitespace: Yes
17 |
18 | BuildType: Package
19 | PackageUseDevtools: Yes
20 | PackageInstallArgs: --no-multiarch --with-keep.source
21 | PackageRoxygenize: rd,collate,namespace
22 |
--------------------------------------------------------------------------------
/cran-comments.md:
--------------------------------------------------------------------------------
1 | ## Information
2 | Re-submission of fixed package, which was archived on 2023-09-26 due to check
3 | issues. Update fixes problems in the package with the formula interface for
4 | paired t-tests in r-devel.
5 |
6 | ## Test environments
7 | * local Windows 10 Professional 64-bit install, R 4.3.1
8 | * devtools::check_win_devel()
9 |
10 | ## R CMD check results
11 | There were no ERRORs, WARNINGs or NOTEs.
12 |
--------------------------------------------------------------------------------
/man/anova_apa.Rd:
--------------------------------------------------------------------------------
1 | % Generated by roxygen2: do not edit by hand
2 | % Please edit documentation in R/anova_apa.R
3 | \name{anova_apa}
4 | \alias{anova_apa}
5 | \title{Report ANOVA in APA style}
6 | \usage{
7 | anova_apa(
8 | x,
9 | effect = NULL,
10 | sph_corr = c("greenhouse-geisser", "gg", "huynh-feldt", "hf", "none"),
11 | force_sph_corr = FALSE,
12 | es = c("petasq", "pes", "getasq", "ges"),
13 | format = c("text", "markdown", "rmarkdown", "html", "latex", "latex_math", "docx",
14 | "plotmath"),
15 | info = FALSE,
16 | print = TRUE
17 | )
18 | }
19 | \arguments{
20 | \item{x}{A call to \code{aov}, \code{ez::ezANOVA}, or \code{afex::afex_ez},
21 | \code{afex::afex_car} or \code{afex::afex_4}}
22 |
23 | \item{effect}{Character string indicating the name of the effect to display.
24 | If is \code{NULL}, all effects are reported (default).}
25 |
26 | \item{sph_corr}{Character string indicating the method used for correction if
27 | the assumption of sphericity is violated (only applies to repeated-measures
28 | and mixed design ANOVA). Can be one of \code{"greenhouse-geisser"}
29 | (default), \code{"huynh-feldt"} or \code{"none"} (you may also use the
30 | abbreviations \code{"gg"} or \code{"hf"}).}
31 |
32 | \item{force_sph_corr}{Logical indicating if sphericity correction should be
33 | applied to all within factors regardless of what the result of Mauchly's
34 | test of sphericity is (default is \code{FALSE}).}
35 |
36 | \item{es}{Character string indicating the effect size to display in the
37 | output, one of \code{"petasq"} (partial eta squared) or \code{"getasq"}
38 | (generalized eta squared) (you may also use the abbreviations \code{"pes"}
39 | or \code{"ges"}).}
40 |
41 | \item{format}{Character string specifying the output format. One of
42 | \code{"text"}, \code{"markdown"}, \code{"rmarkdown"}, \code{html},
43 | \code{"latex"}, \code{"latex_math"}, \code{"docx"} or \code{"plotmath"}.}
44 |
45 | \item{info}{Logical indicating whether to print a message on the used test
46 | (default is \code{FALSE})}
47 |
48 | \item{print}{Logical indicating whether to print the formatted output via
49 | \code{cat} (\code{TRUE}, default) or return as a data frame.}
50 | }
51 | \description{
52 | Report ANOVA in APA style
53 | }
54 | \examples{
55 | # Using the ez package
56 | library(ez)
57 | data(ANT)
58 |
59 | x <- ezANOVA(ANT[ANT$error==0,], dv = rt, wid = subnum,
60 | within = c(cue, flank), between = group, detailed = TRUE)
61 | anova_apa(x)
62 |
63 | # Using the afex package
64 | library(afex)
65 | data(md_12.1)
66 |
67 | y <- aov_ez(id = "id", dv = "rt", data = md_12.1,
68 | within = c("angle", "noise"))
69 | anova_apa(y)
70 |
71 | }
72 |
--------------------------------------------------------------------------------
/man/apa.Rd:
--------------------------------------------------------------------------------
1 | % Generated by roxygen2: do not edit by hand
2 | % Please edit documentation in R/apa.R
3 | \name{apa}
4 | \alias{apa}
5 | \title{APA Formatting for RMarkdown Reports}
6 | \usage{
7 | apa(x, effect = NULL, format = "rmarkdown", print = FALSE, ...)
8 | }
9 | \arguments{
10 | \item{x}{An \R object. Must be a call to one of \code{afex::aov_4},
11 | \code{afex::aov_car}, \code{afex::aov_ez}, \code{chisq.test},
12 | \code{cor.test}, \code{ez::ezANOVA} or \code{t_test}.}
13 |
14 | \item{effect}{(only applicable if \code{x} is an ANOVA) Character string
15 | indicating the name of the effect to display. If is \code{NULL}, all
16 | effects are reported (default).}
17 |
18 | \item{format}{Character string specifying the output format. One of
19 | \code{"text"}, \code{"markdown"}, \code{"rmarkdown"}, \code{html},
20 | \code{"latex"} or \code{"docx"}.}
21 |
22 | \item{print}{Logical indicating whether to return the result as an \R object
23 | (\code{FALSE}) or print using \code{cat} (\code{TRUE}).}
24 |
25 | \item{...}{Further arguments passed to other methods}
26 | }
27 | \description{
28 | A wrapper around the \code{*_apa} functions, providing a convenient way to
29 | use the formatters in inline code in RMarkdown documents.
30 | }
31 | \seealso{
32 | \link{anova_apa}, \link{chisq_apa},
33 | \link{cor_apa}, \link{t_apa}
34 | }
35 |
--------------------------------------------------------------------------------
/man/chisq_apa.Rd:
--------------------------------------------------------------------------------
1 | % Generated by roxygen2: do not edit by hand
2 | % Please edit documentation in R/chisq_apa.R
3 | \name{chisq_apa}
4 | \alias{chisq_apa}
5 | \title{Report Chi-squared test in APA style}
6 | \usage{
7 | chisq_apa(
8 | x,
9 | print_n = FALSE,
10 | format = c("text", "markdown", "rmarkdown", "html", "latex", "latex_math", "docx",
11 | "plotmath"),
12 | info = FALSE,
13 | print = TRUE
14 | )
15 | }
16 | \arguments{
17 | \item{x}{A call to \code{chisq.test}}
18 |
19 | \item{print_n}{Logical indicating whether to show sample size in text}
20 |
21 | \item{format}{Character string specifying the output format. One of
22 | \code{"text"}, \code{"markdown"}, \code{"rmarkdown"}, \code{html},
23 | \code{"latex"}, \code{"latex_math"}, \code{"docx"} or \code{"plotmath"}.}
24 |
25 | \item{info}{Logical indicating whether to print a message on the used test
26 | (default is \code{FALSE})}
27 |
28 | \item{print}{Logical indicating whether to print the formatted output via
29 | \code{cat} (\code{TRUE}, default) or return as character string.}
30 | }
31 | \description{
32 | Report Chi-squared test in APA style
33 | }
34 | \examples{
35 | # Example data from ?chisq.test
36 | m <- rbind(c(762, 327, 468), c(484, 239, 477))
37 |
38 | chisq_apa(chisq.test(m))
39 |
40 | }
41 |
--------------------------------------------------------------------------------
/man/cohens_d.Rd:
--------------------------------------------------------------------------------
1 | % Generated by roxygen2: do not edit by hand
2 | % Please edit documentation in R/cohens_d.R
3 | \name{cohens_d}
4 | \alias{cohens_d}
5 | \alias{cohens_d.default}
6 | \alias{cohens_d.data.frame}
7 | \alias{cohens_d.formula}
8 | \alias{cohens_d.htest}
9 | \title{Cohen's d}
10 | \usage{
11 | cohens_d(...)
12 |
13 | \method{cohens_d}{default}(
14 | x,
15 | y = NULL,
16 | paired = FALSE,
17 | corr = c("none", "hedges_g", "glass_delta"),
18 | na.rm = FALSE,
19 | ...
20 | )
21 |
22 | \method{cohens_d}{data.frame}(
23 | data,
24 | dv,
25 | iv,
26 | paired = FALSE,
27 | corr = c("none", "hedges_g", "glass_delta"),
28 | na.rm = FALSE,
29 | ...
30 | )
31 |
32 | \method{cohens_d}{formula}(
33 | formula,
34 | data,
35 | corr = c("none", "hedges_g", "glass_delta"),
36 | na.rm = FALSE,
37 | ...
38 | )
39 |
40 | \method{cohens_d}{htest}(ttest, corr = c("none", "hedges_g", "glass_delta"), ...)
41 | }
42 | \arguments{
43 | \item{...}{Further arguments passed to methods.}
44 |
45 | \item{x}{A (non-empty) numeric vector of data values.}
46 |
47 | \item{y}{An optional (non-empty) numeric vector of data values.}
48 |
49 | \item{paired}{A logical indicating whether Cohen's d should be calculated for
50 | a paired sample or two independent samples \emph{(default)}. Ignored when
51 | calculating Cohen's for one sample.}
52 |
53 | \item{corr}{Character specifying the correction applied to calculation of the
54 | effect size: \code{"none"} \emph{(default)} returns Cohen's d,
55 | \code{"hedges_g"} applies Hedges correction and \code{"glass_delta"}
56 | calculates Glass' \eqn{\Delta} (uses the standard deviation of the second
57 | group).}
58 |
59 | \item{na.rm}{Logical. Should missing values be removed?}
60 |
61 | \item{data}{A data frame containing either the variables in the formula
62 | \code{formula} or the variables specified by \code{dv} and \code{iv}.}
63 |
64 | \item{dv}{Character indicating the name of the column in \code{data} for the
65 | dependent variable}
66 |
67 | \item{iv}{Character indicating the name of the column in \code{data} for the
68 | independent variable}
69 |
70 | \item{formula}{A formula of the form \code{lhs ~ rhs} where \code{lhs} is a
71 | numeric variable giving the data values and \code{rhs}
72 | either \code{1} for one sample or paired data or a factor with two levels
73 | giving the corresponding groups. If \code{lhs} is of class \code{"Pair"}
74 | and \code{rhs} is \code{1}, Cohen's d for paired data will be calculated.}
75 |
76 | \item{ttest}{An object of class \code{htest} (a call to either \code{t_test}
77 | (preferred) or \code{t.test}).}
78 | }
79 | \description{
80 | Calculate Cohen's d from raw data or a call to \code{t_test}/\code{t.test}.
81 | }
82 | \details{
83 | To calculate Cohen's d from summary statistics (M, SD, ..) use
84 | \link{cohens_d_}.
85 | }
86 | \examples{
87 | # Calculate from raw data
88 | cohens_d(c(10, 15, 11, 14, 17), c(22, 18, 23, 25, 20))
89 |
90 | # Methods when working with data frames
91 | cohens_d(sleep, dv = extra, iv = group, paired = TRUE)
92 | # or
93 | cohens_d(sleep, dv = "extra", iv = "group", paired = TRUE)
94 | # formula interface
95 | sleep2 <- reshape(sleep, direction = "wide", idvar = "ID", timevar = "group")
96 | cohens_d(Pair(extra.1, extra.2) ~ 1, sleep2, paired = TRUE)
97 |
98 | # Or pass a call to t_test or t.test
99 | cohens_d(t_test(Pair(extra.1, extra.2) ~ 1, sleep2))
100 | }
101 | \references{
102 | Lakens, D. (2013). Calculating and reporting effect sizes to
103 | facilitate cumulative science: a practical primer for t-tests and ANOVAs.
104 | \emph{Frontiers in Psychology}, 4, 863. doi:10.3389/fpsyg.2013.00863
105 | }
106 |
--------------------------------------------------------------------------------
/man/cohens_d_.Rd:
--------------------------------------------------------------------------------
1 | % Generated by roxygen2: do not edit by hand
2 | % Please edit documentation in R/cohens_d.R
3 | \name{cohens_d_}
4 | \alias{cohens_d_}
5 | \title{Cohen's d}
6 | \usage{
7 | cohens_d_(
8 | m1 = NULL,
9 | m2 = NULL,
10 | sd1 = NULL,
11 | sd2 = NULL,
12 | n1 = NULL,
13 | n2 = NULL,
14 | t = NULL,
15 | n = NULL,
16 | paired = FALSE,
17 | one_sample = FALSE,
18 | corr = c("none", "hedges_g", "glass_delta")
19 | )
20 | }
21 | \arguments{
22 | \item{m1}{Numeric, mean of the first group}
23 |
24 | \item{m2}{Numeric, mean of the second group}
25 |
26 | \item{sd1}{Numeric, standard deviation of the first group}
27 |
28 | \item{sd2}{Numeric, standard deviation of the second group}
29 |
30 | \item{n1}{Numeric, size of the first group}
31 |
32 | \item{n2}{Numeric, size of the second group}
33 |
34 | \item{t}{Numeric, t-test statistic}
35 |
36 | \item{n}{Numeric, total sample size}
37 |
38 | \item{paired}{Logical indicating whether to calculate Cohen's d for
39 | independent samples or one sample (\code{FALSE}, \emph{default}) or for
40 | dependent samples (\code{TRUE}).}
41 |
42 | \item{one_sample}{Logical indicating whether to calculate Cohen's d for
43 | one sample (\code{TRUE}) or independent samples (\code{FALSE},
44 | \emph{default}) (only relevant when providing \code{t} and \code{n}, see
45 | below).}
46 |
47 | \item{corr}{Character specifying the correction applied to calculation of the
48 | effect size: \code{"none"} \emph{(default)} returns Cohen's d,
49 | \code{"hedges_g"} applies Hedges correction and \code{"glass_delta"}
50 | calculates Glass' \eqn{\Delta} (uses the standard deviation of the second
51 | group).}
52 | }
53 | \description{
54 | Calculate Cohens'd from different statistics (see Details).
55 | }
56 | \details{
57 | The following combinations of statistics are possible:
58 | \itemize{
59 | \item \code{m1}, \code{m2}, \code{sd1}, \code{sd2}, \code{n1} and
60 | \code{n2}
61 | \item \code{t}, \code{n1} and \code{n2}
62 | \item \code{t} and \code{n}
63 | }
64 | }
65 | \references{
66 | Lakens, D. (2013). Calculating and reporting effect sizes to facilitate
67 | cumulative science: a practical primer for t-tests and ANOVAs.
68 | \emph{Frontiers in Psychology}, 4, 863. doi:10.3389/fpsyg.2013.00863
69 | }
70 |
--------------------------------------------------------------------------------
/man/cor_apa.Rd:
--------------------------------------------------------------------------------
1 | % Generated by roxygen2: do not edit by hand
2 | % Please edit documentation in R/cor_apa.R
3 | \name{cor_apa}
4 | \alias{cor_apa}
5 | \title{Report Correlation in APA style}
6 | \usage{
7 | cor_apa(
8 | x,
9 | r_ci = FALSE,
10 | format = c("text", "markdown", "rmarkdown", "html", "latex", "latex_math", "docx",
11 | "plotmath"),
12 | info = FALSE,
13 | print = TRUE
14 | )
15 | }
16 | \arguments{
17 | \item{x}{A call to \code{cor.test}}
18 |
19 | \item{r_ci}{Logical indicating whether to display the confidence interval
20 | for the correlation coefficient (default is \code{FALSE}). Only available
21 | for Pearson's product moment correlation (with n >= 4).}
22 |
23 | \item{format}{Character string specifying the output format. One of
24 | \code{"text"}, \code{"markdown"}, \code{"rmarkdown"}, \code{html},
25 | \code{"latex"}, \code{"latex_math"}, \code{"docx"} or \code{"plotmath"}.}
26 |
27 | \item{info}{Logical indicating whether to print a message on the used test
28 | (default is \code{FALSE})}
29 |
30 | \item{print}{Logical indicating whether to print the formatted output via
31 | \code{cat} (\code{TRUE}, default) or return as character string.}
32 | }
33 | \description{
34 | Report Correlation in APA style
35 | }
36 | \examples{
37 | # Example data from ?cor.test
38 | x <- c(44.4, 45.9, 41.9, 53.3, 44.7, 44.1, 50.7, 45.2, 60.1)
39 | y <- c( 2.6, 3.1, 2.5, 5.0, 3.6, 4.0, 5.2, 2.8, 3.8)
40 |
41 | cor_apa(cor.test(x, y))
42 |
43 | # Spearman's rho
44 | cor_apa(cor.test(x, y, method = "spearman"))
45 |
46 | # Kendall's tau
47 | cor_apa(cor.test(x, y, method = "kendall"))
48 |
49 | }
50 |
--------------------------------------------------------------------------------
/man/petasq.Rd:
--------------------------------------------------------------------------------
1 | % Generated by roxygen2: do not edit by hand
2 | % Please edit documentation in R/eta_squared.R
3 | \name{petasq}
4 | \alias{petasq}
5 | \title{Partial Eta Squared}
6 | \usage{
7 | petasq(x, effect)
8 | }
9 | \arguments{
10 | \item{x}{A call to \code{aov}, \code{ez::ezANOVA} or \code{afex::aov_ez} or
11 | \code{afex::aov_car} or \code{afex::aov_4}}
12 |
13 | \item{effect}{Character string indicating the name of the effect for which
14 | the partial eta squared should be returned.}
15 | }
16 | \description{
17 | Partial Eta Squared
18 | }
19 |
--------------------------------------------------------------------------------
/man/petasq_.Rd:
--------------------------------------------------------------------------------
1 | % Generated by roxygen2: do not edit by hand
2 | % Please edit documentation in R/eta_squared.R
3 | \name{petasq_}
4 | \alias{petasq_}
5 | \title{Partial Eta Squared}
6 | \usage{
7 | petasq_(ss_effect, ss_error)
8 | }
9 | \arguments{
10 | \item{ss_effect}{numeric, sum of squares of the effect}
11 |
12 | \item{ss_error}{numeric, sum of squares of the corresponding error}
13 | }
14 | \description{
15 | Calculate the partial eta squared effect size from sum of
16 | squares.
17 | \deqn{\eta_p^2 = \frac{SS_effect}{SS_effect + SS_error}}{partial eta squared
18 | = SS_effect / (SS_effect + SS_error)}
19 | }
20 |
--------------------------------------------------------------------------------
/man/t_apa.Rd:
--------------------------------------------------------------------------------
1 | % Generated by roxygen2: do not edit by hand
2 | % Please edit documentation in R/t_apa.R
3 | \name{t_apa}
4 | \alias{t_apa}
5 | \title{Report t-Test in APA style}
6 | \usage{
7 | t_apa(
8 | x,
9 | es = c("cohens_d", "hedges_g", "glass_delta"),
10 | es_ci = FALSE,
11 | format = c("text", "markdown", "rmarkdown", "html", "latex", "latex_math", "docx",
12 | "plotmath"),
13 | info = FALSE,
14 | print = TRUE
15 | )
16 | }
17 | \arguments{
18 | \item{x}{A call to \code{t_test} or \code{t.test}}
19 |
20 | \item{es}{Character specifying the effect size to report. One of
21 | \code{"cohens_d"} (default), \code{"hedges_g"} or \code{"glass_delta"} if
22 | \code{x} is an independent samples t-test. Ignored if \code{x} is a paired
23 | samples or one sample t-test (cohen's d is reported for these test).}
24 |
25 | \item{es_ci}{Logical indicating whether to add the 95\% confidence interval
26 | for Cohen's d (experimental; default is \code{FALSE}).}
27 |
28 | \item{format}{Character string specifying the output format. One of
29 | \code{"text"}, \code{"markdown"}, \code{"rmarkdown"}, \code{html},
30 | \code{"latex"}, \code{"latex_math"}, \code{"docx"} or \code{"plotmath"}.}
31 |
32 | \item{info}{Logical indicating whether to print a message on the used test
33 | (default is \code{FALSE})}
34 |
35 | \item{print}{Logical indicating whether to print the formatted output via
36 | \code{cat} (\code{TRUE}, default) or return as character string.}
37 | }
38 | \description{
39 | Report t-Test in APA style
40 | }
41 | \examples{
42 | # Two independent samples t-test
43 | t_apa(t_test(1:10, y = c(7:20)))
44 |
45 | # Two dependent samples t-test
46 | sleep2 <- reshape(sleep, direction = "wide", idvar = "ID", timevar = "group")
47 | t_apa(t_test(Pair(extra.1, extra.2) ~ 1, sleep2))
48 |
49 | }
50 |
--------------------------------------------------------------------------------
/man/t_test.Rd:
--------------------------------------------------------------------------------
1 | % Generated by roxygen2: do not edit by hand
2 | % Please edit documentation in R/t_test.R
3 | \name{t_test}
4 | \alias{t_test}
5 | \alias{t_test.default}
6 | \alias{t_test.formula}
7 | \title{Student's t-Test}
8 | \usage{
9 | t_test(x, ...)
10 |
11 | \method{t_test}{default}(
12 | x,
13 | y = NULL,
14 | alternative = c("two.sided", "less", "greater"),
15 | mu = 0,
16 | paired = FALSE,
17 | var.equal = FALSE,
18 | conf.level = 0.95,
19 | ...
20 | )
21 |
22 | \method{t_test}{formula}(formula, data, subset, na.action, ...)
23 | }
24 | \arguments{
25 | \item{x}{a (non-empty) numeric vector of data values.}
26 |
27 | \item{...}{further arguments to be passed to or from methods.}
28 |
29 | \item{y}{an optional (non-empty) numeric vector of data values.}
30 |
31 | \item{alternative}{a character string specifying the alternative
32 | hypothesis, must be one of \code{"two.sided"} (default),
33 | \code{"greater"} or \code{"less"}. You can specify just the initial
34 | letter.}
35 |
36 | \item{mu}{a number indicating the true value of the mean (or
37 | difference in means if you are performing a two sample test).}
38 |
39 | \item{paired}{a logical indicating whether you want a paired
40 | t-test.}
41 |
42 | \item{var.equal}{a logical variable indicating whether to treat the
43 | two variances as being equal. If \code{TRUE} then the pooled
44 | variance is used to estimate the variance otherwise the Welch
45 | (or Satterthwaite) approximation to the degrees of freedom is used.}
46 |
47 | \item{conf.level}{confidence level of the interval.}
48 |
49 | \item{formula}{a formula of the form \code{lhs ~ rhs} where \code{lhs}
50 | is a numeric variable giving the data values and \code{rhs} either
51 | \code{1} for a one-sample or paired test or a factor
52 | with two levels giving the corresponding groups. If \code{lhs} is of
53 | class \code{"\link[stats]{Pair}"} and \code{rhs} is \code{1}, a paired test
54 | is done.}
55 |
56 | \item{data}{an optional matrix or data frame (or similar: see
57 | \code{\link[stats]{model.frame}}) containing the variables in the
58 | formula \code{formula}. By default the variables are taken from
59 | \code{environment(formula)}.}
60 |
61 | \item{subset}{an optional vector specifying a subset of observations
62 | to be used.}
63 |
64 | \item{na.action}{a function which indicates what should happen when
65 | the data contain \code{NA}s. Defaults to
66 | \code{getOption("na.action")}.}
67 | }
68 | \description{
69 | A wrapper for \code{t.test} which includes the original data in the returned
70 | object.
71 | }
72 | \seealso{
73 | \link{t.test}
74 | }
75 |
--------------------------------------------------------------------------------
/tests/testthat.R:
--------------------------------------------------------------------------------
1 | library(testthat)
2 | library(apa)
3 |
4 | test_check("apa")
5 |
--------------------------------------------------------------------------------
/tests/testthat/test-anova-apa.R:
--------------------------------------------------------------------------------
1 | context("anova_apa")
2 |
3 | library(dplyr, warn.conflicts = FALSE)
4 | library(magrittr, warn.conflicts = FALSE)
5 |
6 | test_that("Formal structure for anova_apa output", {
7 |
8 | library(ez)
9 | data(ANT)
10 |
11 | data <-
12 | ANT %>%
13 | filter(error == 0) %>%
14 | group_by(subnum, group, cue, flank) %>%
15 | summarise(rt = mean(rt)) %>%
16 | filter(!is.nan(rt)) %>% # delete empty groups (fix for change in dplyr 0.8)
17 | as.data.frame # ezANOVA does not support tbl_df
18 |
19 | anova <- anova_apa(
20 | ezANOVA(data, dv = rt, wid = subnum, within = c(cue, flank),
21 | between = group, detailed = TRUE),
22 | print = FALSE
23 | )
24 |
25 | # Intercept, three main effects, three two-way interactions, one three way
26 | # interactions
27 | expect_equal(nrow(anova), 1 + 3 + 3 + 1)
28 | expect_match(`[.data.frame`(anova, anova$effect == "group", "text"),
29 | paste0("F\\([[:digit:]]+, [[:digit:]]+\\) = [[:digit:]]+\\.",
30 | "[[:digit:]]{2}, p [=<] \\.[[:digit:]]{3}, petasq ",
31 | "[=<] \\.[[:digit:]]{2}"))
32 |
33 | })
34 |
35 | test_that("Output for anova_apa: oneway between ANOVA", {
36 |
37 | # Example data from Field, A., Miles, J. & Field, Z. (2012). Discovering
38 | # statistics using R. London: Sage Publications. Page 434.
39 | data <- data.frame(id = factor(1:15),
40 | dose = rep(c("placebo", "low dose", "high dose"),
41 | each = 5),
42 | libido = c(3, 2, 1, 1, 4, 5, 2, 4, 2, 3, 7, 4, 5, 3, 6))
43 |
44 | # Build ANOVA with afex
45 | anova_afex <- anova_apa(
46 | afex::aov_ez(id = "id", dv = "libido", data = data, between = "dose"),
47 | print = FALSE
48 | )
49 |
50 | expect_identical(`[.data.frame`(anova_afex, anova_afex$effect == "dose",
51 | "text"),
52 | "F(2, 12) = 5.12, p = .025, petasq = .46")
53 |
54 | # Build ANOVA with ez
55 | anova_ez <- anova_apa(
56 | ez::ezANOVA(data, dv = libido, wid = id, between = dose, detailed = TRUE),
57 | print = FALSE
58 | )
59 |
60 | expect_identical(`[.data.frame`(anova_ez, anova_ez$effect == "dose", "text"),
61 | "F(2, 12) = 5.12, p = .025, petasq = .46")
62 |
63 | })
64 |
65 | test_that("Output for anova_apa: factorial between ANOVA", {
66 |
67 | # Example data from Field, A., Miles, J. & Field, Z. (2012). Discovering
68 | # statistics using R. London: Sage Publications. Page 513f.
69 |
70 | data <- data.frame(
71 | id = factor(1:48),
72 | gender = rep(c("female", "male"), each = 24),
73 | alcohol = rep(c("none", "2 pints", "4 pints"), each = 8, times = 2),
74 | attractiveness = c(65, 70, 60, 60, 60, 55, 60, 55, 70, 65, 60, 70, 65, 60,
75 | 60, 50, 55, 65, 70, 55, 55, 60, 50, 50, 50, 55, 80, 65,
76 | 70, 75, 75, 65, 45, 60, 85, 65, 70, 70, 80, 60, 30, 30,
77 | 30, 55, 35, 20, 45, 40)
78 | )
79 |
80 | # Build ANOVA with afex
81 | anova_afex <- anova_apa(
82 | afex::aov_ez(id = "id", dv = "attractiveness", data = data,
83 | between = c("gender", "alcohol")),
84 | print = FALSE
85 | )
86 |
87 | expect_identical(`[.data.frame`(anova_afex, anova_afex$effect == "gender",
88 | "text"),
89 | "F(1, 42) = 2.03, p = .161, petasq = .05")
90 |
91 | expect_identical(`[.data.frame`(anova_afex, anova_afex$effect == "alcohol",
92 | "text"),
93 | "F(2, 42) = 20.07, p < .001, petasq = .49")
94 |
95 | expect_identical(`[.data.frame`(anova_afex,
96 | anova_afex$effect == "gender:alcohol",
97 | "text"),
98 | "F(2, 42) = 11.91, p < .001, petasq = .36")
99 |
100 | # Build ANOVA with ez
101 | anova_ez <- anova_apa(
102 | ez::ezANOVA(data, dv = attractiveness, wid = id,
103 | between = c(gender, alcohol), detailed = TRUE, type = 3),
104 | print = FALSE
105 | )
106 |
107 | expect_identical(`[.data.frame`(anova_ez, anova_ez$effect == "gender",
108 | "text"),
109 | "F(1, 42) = 2.03, p = .161, petasq = .05")
110 |
111 | expect_identical(`[.data.frame`(anova_ez, anova_ez$effect == "alcohol",
112 | "text"),
113 | "F(2, 42) = 20.07, p < .001, petasq = .49")
114 |
115 | expect_identical(`[.data.frame`(anova_ez, anova_ez$effect == "gender:alcohol",
116 | "text"),
117 | "F(2, 42) = 11.91, p < .001, petasq = .36")
118 |
119 | })
120 |
121 | test_that("Output for anova_apa: repeated-measures ANOVA", {
122 |
123 | # Example data from Field, A., Miles, J. & Field, Z. (2012). Discovering
124 | # statistics using R. London: Sage Publications. Page 513f.
125 |
126 | data <- data.frame(
127 | id = factor(rep(1:8, each = 4)),
128 | animal = rep(c("stick insect", "kangaroo testicle", "fish eye",
129 | "witchetty grub"), times = 8),
130 | retch = c(8, 7, 1, 6, 9, 5, 2, 5, 6, 2, 3, 8, 5, 3, 1, 9, 8, 4, 5, 8, 7, 5,
131 | 6, 7, 10, 2, 7, 2, 12, 6, 8, 1)
132 | )
133 |
134 | # Build ANOVA with afex
135 | anova_afex <- anova_apa(
136 | afex::aov_ez(id = "id", dv = "retch", data = data, within = "animal"),
137 | print = FALSE
138 | )
139 |
140 | expect_identical(`[.data.frame`(anova_afex, anova_afex$effect == "animal",
141 | "text"),
142 | "F(1.60, 11.19) = 3.79, p = .063, petasq = .35")
143 |
144 | # Build ANOVA with ez
145 | anova_ez <- anova_apa(
146 | ez::ezANOVA(data, dv = retch, wid = id, within = animal, detailed = TRUE),
147 | print = FALSE
148 | )
149 |
150 | expect_identical(`[.data.frame`(anova_ez, anova_ez$effect == "animal",
151 | "text"),
152 | "F(1.60, 11.19) = 3.79, p = .063, petasq = .35")
153 |
154 | })
155 |
156 | test_that("Output for anova_apa: factorial repeated-measures ANOVA", {
157 |
158 | # Example data from Field, A., Miles, J. & Field, Z. (2012). Discovering
159 | # statistics using R. London: Sage Publications. Page 583.
160 |
161 | data <- data.frame(
162 | id = factor(rep(1:20, each = 9)),
163 | gender = rep(c("male", "female"), each = 10 * 9),
164 | imagery = rep(c("positive", "negative", "neutral"), times = 60),
165 | drink = rep(c("beer", "wine", "water"), each = 3, times = 20),
166 | attitude = c(1, 6, 5, 38, -5, 4, 10, -14, -2, 43, 30, 8, 20, -12, 4, 9, -10,
167 | -13, 15, 15, 12, 20, -15, 6, 6, -16, 1, 40, 30, 19, 28, -4, 0,
168 | 20, -10, 2, 8, 12, 8, 11, -2, 6, 27, 5, -5, 17, 17, 15, 17, -6,
169 | 6, 9, -6, -13, 30, 21, 21, 15, -2, 16, 19, -20, 3, 34, 23, 28,
170 | 27, -7, 7, 12, -12, 2, 34, 20, 26, 24, -10, 12, 12, -9, 4, 26,
171 | 27, 27, 23, -15, 14, 21, -6, 0, 1, -19, -10, 28, -13, 13, 33,
172 | -2, 9, 7, -18, 6, 26, -16, 19, 23, -17, 5, 22, -8, 4, 34, -23,
173 | 14, 21, -19, 0, 30, -6, 3, 32, -22, 21, 17, -11, 4, 40, -6, 0,
174 | 24, -9, 19, 15, -10, 2, 15, -9, 4, 29, -18, 7, 13, -17, 8, 20,
175 | -17, 9, 30, -17, 12, 16, -4, 10, 9, -12, -5, 24, -15, 18, 17,
176 | -4, 8, 14, -11, 7, 34, -14, 20, 19, -1, 12, 15, -6, 13, 23,
177 | -15, 15, 29, -1, 10)
178 | )
179 |
180 | # Build ANOVA with afex
181 | anova_afex <- anova_apa(
182 | afex::aov_ez(id = "id", dv = "attitude", data = data,
183 | within = c("drink", "imagery")),
184 | print = FALSE
185 | )
186 |
187 | expect_identical(`[.data.frame`(anova_afex, anova_afex$effect == "drink",
188 | "text"),
189 | "F(1.15, 21.93) = 5.11, p = .030, petasq = .21")
190 |
191 | expect_identical(`[.data.frame`(anova_afex, anova_afex$effect == "imagery",
192 | "text"),
193 | "F(1.49, 28.40) = 122.56, p < .001, petasq = .87")
194 |
195 | expect_identical(`[.data.frame`(anova_afex,
196 | anova_afex$effect == "drink:imagery",
197 | "text"),
198 | "F(4, 76) = 17.15, p < .001, petasq = .47")
199 |
200 | # Build ANOVA with ez
201 | anova_ez <- anova_apa(
202 | ez::ezANOVA(data, dv = attitude, wid = id, within = c(drink, imagery),
203 | type = 3, detailed = TRUE),
204 | print = FALSE
205 | )
206 |
207 | expect_identical(`[.data.frame`(anova_ez, anova_ez$effect == "drink", "text"),
208 | "F(1.15, 21.93) = 5.11, p = .030, petasq = .21")
209 |
210 | expect_identical(`[.data.frame`(anova_ez, anova_ez$effect == "imagery",
211 | "text"),
212 | "F(1.49, 28.40) = 122.56, p < .001, petasq = .87")
213 |
214 | expect_identical(`[.data.frame`(anova_ez, anova_ez$effect == "drink:imagery",
215 | "text"),
216 | "F(4, 76) = 17.15, p < .001, petasq = .47")
217 |
218 | })
219 |
220 | test_that("Output for anova_apa: mixed ANOVA", {
221 |
222 | # Example data from Field, A., Miles, J. & Field, Z. (2012). Discovering
223 | # statistics using R. London: Sage Publications. Page 607.
224 |
225 | data <- data.frame(
226 | id = factor(rep(1:20, each = 9)),
227 | gender = rep(c("male", "female"), each = 10 * 9),
228 | looks = rep(c("attractive", "average", "ugly"), times = 60),
229 | personality = rep(c("high carisma", "some charisma", "dullard"), each = 3,
230 | times = 20),
231 | rating = c(86, 84, 67, 88, 69, 50, 97, 48, 47, 91, 83, 53, 83, 74, 48, 86,
232 | 50, 46, 89, 88, 48, 99, 70, 48, 90, 45, 48, 89, 69, 58, 86, 77,
233 | 40, 87, 47, 53, 80, 81, 57, 88, 71, 50, 82, 50, 45, 80, 84, 51,
234 | 96, 63, 42, 92, 48, 43, 89, 85, 61, 87, 79, 44, 86, 50, 45, 100,
235 | 94, 56, 86, 71, 54, 84, 54, 47, 90, 74, 54, 92, 71, 58, 78, 38,
236 | 45, 89, 86, 63, 80, 73, 49, 91, 48, 39, 89, 91, 93, 88, 65, 54,
237 | 55, 48, 52, 84, 90, 85, 95, 70, 60, 50, 44, 45, 99, 100, 89, 80,
238 | 79, 53, 51, 48, 44, 86, 89, 83, 86, 74, 58, 52, 48, 47, 89, 87,
239 | 80, 83, 74, 43, 58, 50, 48, 80, 81, 79, 86, 59, 47, 51, 47, 40,
240 | 82, 92, 85, 81, 66, 47, 50, 45, 47, 97, 69, 87, 95, 72, 51, 45,
241 | 48, 46, 95, 92, 90, 98, 64, 53, 54, 53, 45, 95, 93, 96, 79, 66,
242 | 46, 52, 39, 47)
243 | )
244 |
245 | # Build ANOVA with afex
246 | anova_afex <- anova_apa(
247 | afex::aov_ez(id = "id", dv = "rating", data = data,
248 | between = "gender",
249 | within = c("looks", "personality")),
250 | print = FALSE
251 | )
252 |
253 | expect_identical(`[.data.frame`(anova_afex, anova_afex$effect == "gender",
254 | "text"),
255 | "F(1, 18) = 0.00, p = .946, petasq < .01")
256 |
257 | expect_identical(`[.data.frame`(anova_afex, anova_afex$effect == "looks",
258 | "text"),
259 | "F(2, 36) = 423.73, p < .001, petasq = .96")
260 |
261 | expect_identical(`[.data.frame`(anova_afex,
262 | anova_afex$effect == "personality", "text"),
263 | "F(2, 36) = 328.25, p < .001, petasq = .95")
264 |
265 | expect_identical(`[.data.frame`(anova_afex,
266 | anova_afex$effect == "gender:looks", "text"),
267 | "F(2, 36) = 80.43, p < .001, petasq = .82")
268 |
269 | expect_identical(`[.data.frame`(anova_afex,
270 | anova_afex$effect == "gender:personality",
271 | "text"),
272 | "F(2, 36) = 62.45, p < .001, petasq = .78")
273 |
274 | expect_identical(`[.data.frame`(anova_afex,
275 | anova_afex$effect == "looks:personality",
276 | "text"),
277 | "F(4, 72) = 36.63, p < .001, petasq = .67")
278 |
279 | # Build ANOVA with ez
280 | anova_ez <- anova_apa(
281 | ez::ezANOVA(data, dv = rating, wid = id, between = gender,
282 | within = c(looks, personality), type = 3, detailed = TRUE),
283 | print = FALSE
284 | )
285 |
286 | expect_identical(`[.data.frame`(anova_ez, anova_ez$effect == "gender",
287 | "text"),
288 | "F(1, 18) = 0.00, p = .946, petasq < .01")
289 |
290 | expect_identical(`[.data.frame`(anova_ez, anova_ez$effect == "looks", "text"),
291 | "F(2, 36) = 423.73, p < .001, petasq = .96")
292 |
293 | expect_identical(`[.data.frame`(anova_ez,
294 | anova_ez$effect == "personality", "text"),
295 | "F(2, 36) = 328.25, p < .001, petasq = .95")
296 |
297 | expect_identical(`[.data.frame`(anova_ez,
298 | anova_ez$effect == "gender:looks", "text"),
299 | "F(2, 36) = 80.43, p < .001, petasq = .82")
300 |
301 | expect_identical(`[.data.frame`(anova_ez,
302 | anova_ez$effect == "gender:personality",
303 | "text"),
304 | "F(2, 36) = 62.45, p < .001, petasq = .78")
305 |
306 | expect_identical(`[.data.frame`(anova_ez,
307 | anova_ez$effect == "looks:personality",
308 | "text"),
309 | "F(4, 72) = 36.63, p < .001, petasq = .67")
310 | })
311 |
312 | # Output formats ---------------------------------------------------------------
313 |
314 | # Example data from Field, A., Miles, J. & Field, Z. (2012). Discovering
315 | # statistics using R. London: Sage Publications. Page 434.
316 | data <- data.frame(id = factor(1:15),
317 | dose = rep(c("placebo", "low dose", "high dose"),
318 | each = 5),
319 | libido = c(3, 2, 1, 1, 4, 5, 2, 4, 2, 3, 7, 4, 5, 3, 6))
320 |
321 | anova_afex <- suppressMessages(
322 | afex::aov_ez(id = "id", dv = "libido", data = data, between = "dose")
323 | )
324 | anova_ez <- ez::ezANOVA(data, dv = libido, wid = id, between = dose,
325 | detailed = TRUE)
326 |
327 | test_that("anova_apa: markdown", {
328 |
329 | expect_identical(anova_apa(anova_afex, effect = "dose", print = FALSE,
330 | format = "markdown"),
331 | "*F*(2, 12) = 5.12, *p* = .025, *petasq* = .46")
332 |
333 | expect_identical(anova_apa(anova_afex, effect = "dose", print = FALSE,
334 | format = "markdown"),
335 | "*F*(2, 12) = 5.12, *p* = .025, *petasq* = .46")
336 |
337 | })
338 |
339 | test_that("anova_apa: rmarkdown", {
340 |
341 | expect_identical(anova_apa(anova_afex, effect = "dose", print = FALSE,
342 | format = "rmarkdown"),
343 | "*F*(2, 12) = 5.12, *p* = .025, $\\eta^2_p$ = .46")
344 |
345 | expect_identical(anova_apa(anova_ez, effect = "dose", print = FALSE,
346 | format = "rmarkdown"),
347 | "*F*(2, 12) = 5.12, *p* = .025, $\\eta^2_p$ = .46")
348 |
349 | })
350 |
351 | test_that("anova_apa: html", {
352 |
353 | expect_identical(anova_apa(anova_afex, effect = "dose", print = FALSE,
354 | format = "html"),
355 | paste0("F(2, 12) = 5.12, p = .025, ",
356 | "η2p = .46"))
357 |
358 | expect_identical(anova_apa(anova_afex, effect = "dose", print = FALSE,
359 | format = "html"),
360 | paste0("F(2, 12) = 5.12, p = .025, ",
361 | "η2p = .46"))
362 |
363 | })
364 |
365 | test_that("anova_apa: latex", {
366 |
367 | expect_identical(anova_apa(anova_afex, effect = "dose", print = FALSE,
368 | format = "latex"),
369 | paste0("\\textit{F}(2,~12)~=~5.12, \\textit{p}~=~.025, ",
370 | "$\\eta^2_p$~=~.46"))
371 |
372 | expect_identical(anova_apa(anova_ez, effect = "dose", print = FALSE,
373 | format = "latex"),
374 | paste0("\\textit{F}(2,~12)~=~5.12, \\textit{p}~=~.025, ",
375 | "$\\eta^2_p$~=~.46"))
376 |
377 | })
378 |
379 | test_that("anova_apa: plotmath", {
380 |
381 | expect_identical(as.character(anova_apa(anova_afex, effect = "dose",
382 | print = FALSE, format = "plotmath")),
383 | paste0("paste(italic(\"F\"), \"(2, 12) = 5.12, \", ",
384 | "italic(\"p\"), \" = .025, \", ",
385 | "eta[p]^2, \" = .46\")"))
386 |
387 | expect_identical(as.character(anova_apa(anova_ez, effect = "dose",
388 | print = FALSE, format = "plotmath")),
389 | paste0("paste(italic(\"F\"), \"(2, 12) = 5.12, \", ",
390 | "italic(\"p\"), \" = .025, \", ",
391 | "eta[p]^2, \" = .46\")"))
392 |
393 | })
394 |
--------------------------------------------------------------------------------
/tests/testthat/test-chisq-apa.R:
--------------------------------------------------------------------------------
1 | context("chisq_apa")
2 |
3 | # Example data from Agresti, A. (2007) An Introduction to Categorical Data
4 | # Analysis, 2nd ed., New York: John Wiley & Sons. Page 38.
5 |
6 | m <- matrix(c(762, 327, 468, 484, 239, 477), nrow = 2)
7 | dimnames(m) <- list(gender = c("F", "M"),
8 | party = c("Democrat","Independent", "Republican"))
9 |
10 | test_that("Output for chisq_apa", {
11 | expect_identical(chisq_apa(chisq.test(m), print = FALSE),
12 | "chi^2(2) = 242.30, p < .001")
13 | expect_identical(chisq_apa(chisq.test(m), print_n = TRUE, print = FALSE),
14 | "chi^2(2, n = 2757) = 242.30, p < .001")
15 | })
16 |
17 | test_that("Formal structure for chisq_apa output", {
18 | expect_match(chisq_apa(chisq.test(m), print = FALSE),
19 | paste0("chi\\^2\\([[:digit:]]+\\) = [[:digit:]]+\\.",
20 | "[[:digit:]]{2}, p [=<] \\.[[:digit:]]{3}"))
21 | })
22 |
23 | # Output formats ---------------------------------------------------------------
24 |
25 | test_that("chisq_apa: markdown format", {
26 | expect_identical(chisq_apa(chisq.test(m), format = "markdown", print = FALSE),
27 | "*chi^2*(2) = 242.30, *p* < .001")
28 | })
29 |
30 | test_that("chisq_apa: rmarkdown format", {
31 | expect_identical(chisq_apa(chisq.test(m), format = "rmarkdown",
32 | print = FALSE),
33 | "$\\chi^2$(2) = 242.30, *p* < .001")
34 | })
35 |
36 | test_that("chisq_apa: html format", {
37 | expect_identical(chisq_apa(chisq.test(m), format = "html", print = FALSE),
38 | "χ2(2) = 242.30, p < .001")
39 | })
40 |
41 | test_that("chisq_apa: latex format", {
42 | expect_identical(chisq_apa(chisq.test(m), format = "latex", print = FALSE),
43 | "$\\chi^2$(2)~=~242.30, \\textit{p}~<~.001")
44 | })
45 |
46 | test_that("chisq_apa: plotmath format", {
47 | expect_identical(
48 | as.character(chisq_apa(chisq.test(m), format = "plotmath", print = FALSE)),
49 | "paste(chi^2, \"(2) = 242.30, \", italic(\"p\"), \" < .001\")"
50 | )
51 | })
52 |
--------------------------------------------------------------------------------
/tests/testthat/test-cohens-d.R:
--------------------------------------------------------------------------------
1 | context("cohens_d")
2 |
3 | # Example data from Lakens, D. (2013). Calculating and reporting effect sizes to
4 | # facilitate cumulative science: a practical primer for t-tests and ANOVAs.
5 | # Frontiers in Psychology, 4, 863. doi:10.3389/fpsyg.2013.00863
6 |
7 | df <- data.frame(movie_1 = c(9, 7, 8, 9, 8, 9, 9, 10, 9, 9),
8 | movie_2 = c(9, 6, 7, 8, 7, 9, 8, 8, 8, 7))
9 |
10 | df_long <- data.frame(movie = rep(names(df), each = 10),
11 | rating = c(df$movie_1, df$movie_2))
12 |
13 | test_that("Between group cohen's d", {
14 | expect_equal(round(cohens_d(df$movie_1, df$movie_2), 2), 1.13)
15 | expect_equal(round(cohens_d(df_long, dv = "rating", iv = "movie"), 2), 1.13)
16 | expect_equal(round(cohens_d(rating ~ movie, df_long), 2), 1.13)
17 | expect_equal(round(cohens_d(t_test(rating ~ movie, df_long)), 2), 1.13)
18 | expect_equal(round(cohens_d(t.test(rating ~ movie, df_long,
19 | var.equal = TRUE)), 2), 1.13)
20 | expect_equal(round(cohens_d_(m1 = 8.7, m2 = 7.7, sd1 = .82, sd2 = .95,
21 | n1 = 10, n2 = 10), 2), 1.13)
22 | expect_equal(round(cohens_d_(t = 2.52, n1 = 10, n2 = 10), 2), 1.13)
23 | expect_equal(round(cohens_d_(t = 2.52, n = 20), 2), 1.13)
24 | })
25 |
26 | test_that("Between group cohen's d, hedges correction", {
27 | expect_equal(round(cohens_d(df$movie_1, df$movie_2, corr = "hedges_g"), 2),
28 | 1.08)
29 | })
30 |
31 | test_that("Within group cohen's d", {
32 | expect_equal(round(cohens_d(df$movie_1, df$movie_2, paired = TRUE), 2), 1.5)
33 | })
34 |
--------------------------------------------------------------------------------
/tests/testthat/test-cor-apa.R:
--------------------------------------------------------------------------------
1 | context("cor_apa")
2 |
3 | # Example data from Hollander, M. & Wolfe, D. A. (1973). Nonparametric
4 | # Statistical Methods. New York: John Wiley & Sons. Pages 185–194.
5 |
6 | x <- c(44.4, 45.9, 41.9, 53.3, 44.7, 44.1, 50.7, 45.2, 60.1)
7 | y <- c( 2.6, 3.1, 2.5, 5.0, 3.6, 4.0, 5.2, 2.8, 3.8)
8 |
9 | test_that("Output for cor_apa", {
10 | # Pearson's r
11 | expect_identical(
12 | cor_apa(cor.test(x, y, alternative = "greater"), print = FALSE),
13 | "r(7) = .57, p = .054"
14 | )
15 | # Kendall's tau
16 | expect_identical(
17 | cor_apa(cor.test(x, y, method = "kendall", alternative = "greater"),
18 | print = FALSE),
19 | "r_tau = .44, p = .060"
20 | )
21 | # Spearman's rho
22 | expect_identical(
23 | cor_apa(cor.test(x, y, method = "spearman", alternative = "greater"),
24 | print = FALSE),
25 | "r_s = .60, p = .048"
26 | )
27 | })
28 |
29 | test_that("Formal structure of cor_apa output", {
30 | expect_match(
31 | cor_apa(cor.test(x, y), print = FALSE),
32 | "r\\([[:digit:]]+\\) [=<] \\.[[:digit:]]{2}, p [=<] \\.[[:digit:]]{3}"
33 | )
34 | })
35 |
36 | # Output formats ---------------------------------------------------------------
37 |
38 | test_that("cor_apa: markdown format", {
39 | expect_identical(
40 | cor_apa(cor.test(x, y, alternative = "greater"), print = FALSE,
41 | format = "markdown"),
42 | "*r*(7) = .57, *p* = .054"
43 | )
44 | expect_identical(
45 | cor_apa(cor.test(x, y, method = "kendall", alternative = "greater"),
46 | print = FALSE, format = "markdown"),
47 | "*r_tau* = .44, *p* = .060"
48 | )
49 | expect_identical(
50 | cor_apa(cor.test(x, y, method = "spearman", alternative = "greater"),
51 | print = FALSE, format = "markdown"),
52 | "*r_s* = .60, *p* = .048"
53 | )
54 | })
55 |
56 | test_that("cor_apa: rmarkdown format", {
57 | expect_identical(
58 | cor_apa(cor.test(x, y, alternative = "greater"), print = FALSE,
59 | format = "rmarkdown"),
60 | "*r*(7) = .57, *p* = .054"
61 | )
62 | expect_identical(
63 | cor_apa(cor.test(x, y, method = "kendall", alternative = "greater"),
64 | print = FALSE, format = "rmarkdown"),
65 | "$r_\\tau$ = .44, *p* = .060"
66 | )
67 | expect_identical(
68 | cor_apa(cor.test(x, y, method = "spearman", alternative = "greater"),
69 | print = FALSE, format = "rmarkdown"),
70 | "$r_s$ = .60, *p* = .048"
71 | )
72 | })
73 |
74 | test_that("cor_apa: html format", {
75 | expect_identical(
76 | cor_apa(cor.test(x, y, alternative = "greater"), print = FALSE,
77 | format = "html"),
78 | "r(7) = .57, p = .054"
79 | )
80 | expect_identical(
81 | cor_apa(cor.test(x, y, method = "kendall", alternative = "greater"),
82 | print = FALSE, format = "html"),
83 | "rτ = .44, p = .060"
84 | )
85 | expect_identical(
86 | cor_apa(cor.test(x, y, method = "spearman", alternative = "greater"),
87 | print = FALSE, format = "html"),
88 | "rs = .60, p = .048"
89 | )
90 | })
91 |
92 | test_that("cor_apa: latex format", {
93 | expect_identical(
94 | cor_apa(cor.test(x, y, alternative = "greater"), print = FALSE,
95 | format = "latex"),
96 | "\\textit{r}(7)~=~.57, \\textit{p}~=~.054"
97 | )
98 | expect_identical(
99 | cor_apa(cor.test(x, y, method = "kendall", alternative = "greater"),
100 | print = FALSE, format = "latex"),
101 | "$r_\\tau$~=~.44, \\textit{p}~=~.060"
102 | )
103 | expect_identical(
104 | cor_apa(cor.test(x, y, method = "spearman", alternative = "greater"),
105 | print = FALSE, format = "latex"),
106 | "$r_s$~=~.60, \\textit{p}~=~.048"
107 | )
108 | })
109 |
110 | test_that("cor_apa: plotmath format", {
111 | expect_identical(
112 | as.character(cor_apa(cor.test(x, y, alternative = "greater"), print = FALSE,
113 | format = "plotmath")),
114 | "paste(italic(\"r\"), \"(7)\", , \" = .57, \", italic(\"p\"), \" = .054\")"
115 | )
116 | expect_identical(
117 | as.character(cor_apa(cor.test(x, y, method = "kendall",
118 | alternative = "greater"),
119 | print = FALSE, format = "plotmath")),
120 | "paste(italic(r)[tau], \" = .44, \", italic(\"p\"), \" = .060\")"
121 | )
122 | expect_identical(
123 | as.character(cor_apa(cor.test(x, y, method = "spearman",
124 | alternative = "greater"),
125 | print = FALSE, format = "plotmath")),
126 | "paste(italic(r)[s], \" = .60, \", italic(\"p\"), \" = .048\")"
127 | )
128 | })
129 |
--------------------------------------------------------------------------------
/tests/testthat/test-t-apa.R:
--------------------------------------------------------------------------------
1 | context("t_apa")
2 |
3 | # Example data from Lakens, D. (2013). Calculating and reporting effect sizes to
4 | # facilitate cumulative science: a practical primer for t-tests and ANOVAs.
5 | # Frontiers in Psychology, 4, 863. doi:10.3389/fpsyg.2013.00863
6 |
7 | df <- data.frame(movie_1 = c(9, 7, 8, 9, 8, 9, 9, 10, 9, 9),
8 | movie_2 = c(9, 6, 7, 8, 7, 9, 8, 8, 8, 7))
9 |
10 | test_that("Output for t_apa between subject", {
11 | expect_identical(t_apa(t_test(df$movie_1, df$movie_2, var.equal = TRUE),
12 | print = FALSE),
13 | "t(18) = 2.52, p = .022, d = 1.13")
14 | })
15 |
16 | test_that("Output for t_apa within subject", {
17 | expect_identical(t_apa(t_test(df$movie_1, df$movie_2, paired = TRUE),
18 | print = FALSE),
19 | "t(9) = 4.74, p = .001, d = 1.50")
20 | })
21 |
22 | test_that("Formal structure of t_apa output)", {
23 | expect_match(t_apa(t_test(df$movie_1, df$movie_2, var.equal = TRUE),
24 | print = FALSE),
25 | paste0("t\\([[:digit:]]+\\) [=<] [[:digit:]]+\\.[[:digit:]]{2},",
26 | " p [=<] \\.[[:digit:]]{3}, d [=<] [[:digit:]]+\\.",
27 | "[[:digit:]]{2}"))
28 | expect_match(t_apa(t_test(df$movie_1, df$movie_2), print = FALSE),
29 | paste0("t\\([[:digit:]]+\\.[[:digit:]]{2}\\) [=<] ",
30 | "[[:digit:]]+\\.[[:digit:]]{2}, p [=<] \\.[[:digit:]]{3}",
31 | ", d [=<] [[:digit:]]+\\.[[:digit:]]{2}"))
32 | })
33 |
34 | # Output formats ---------------------------------------------------------------
35 |
36 | test_that("t_apa: markdown format", {
37 | expect_identical(t_apa(t_test(df$movie_1, df$movie_2, var.equal = TRUE),
38 | format = "markdown", print = FALSE),
39 | "*t*(18) = 2.52, *p* = .022, *d* = 1.13")
40 | })
41 |
42 | test_that("t_apa: rmarkdown format", {
43 | expect_identical(t_apa(t_test(df$movie_1, df$movie_2, var.equal = TRUE),
44 | format = "rmarkdown", print = FALSE),
45 | "*t*(18) = 2.52, *p* = .022, *d* = 1.13")
46 | })
47 |
48 | test_that("t_apa: html format", {
49 | expect_identical(t_apa(t_test(df$movie_1, df$movie_2, var.equal = TRUE),
50 | format = "html", print = FALSE),
51 | "t(18) = 2.52, p = .022, d = 1.13")
52 | })
53 |
54 | test_that("t_apa: latex format", {
55 | expect_identical(t_apa(t_test(df$movie_1, df$movie_2, var.equal = TRUE),
56 | format = "latex", print = FALSE),
57 | paste0("\\textit{t}(18)~=~2.52, \\textit{p}~=~.022, ",
58 | "\\textit{d}~=~1.13"))
59 | })
60 |
61 | test_that("t_apa: plotmath format", {
62 | expect_identical(
63 | as.character(t_apa(t_test(df$movie_1, df$movie_2, var.equal = TRUE),
64 | format = "plotmath", print = FALSE)),
65 | paste0("paste(italic(\"t\"), \"(18) = 2.52, \", ",
66 | "italic(\"p\"), \" = .022, \", ",
67 | "italic(\"d\"), \" = 1.13\")")
68 | )
69 | })
70 |
71 |
--------------------------------------------------------------------------------
/tests/testthat/test-t-test.R:
--------------------------------------------------------------------------------
1 | context("t_test")
2 |
3 | test_that("t_test equals to t.test", {
4 |
5 | x <- t.test(1:10, y = c(7:20))[]
6 |
7 | y <- t_test(1:10, y = c(7:20))
8 | # Remove 'data' entry
9 | y <- y[!(names(y) == "data")]
10 |
11 | expect_equal(x, y)
12 | })
13 |
14 | test_that("t_test returns input data", {
15 | expect_equal(t_test(1:10, y = c(7:20))[["data"]],
16 | list(x = 1:10, y = c(7:20)))
17 | })
18 |
--------------------------------------------------------------------------------
/tests/testthat/test-utils.R:
--------------------------------------------------------------------------------
1 | context("utils")
2 |
3 | test_that("Formatting of statistics", {
4 | expect_match(fmt_stat(12.345), "= 12\\.35")
5 | expect_match(fmt_stat(-12.345), "= -12\\.35")
6 | expect_match(fmt_stat(12.345, equal_sign = FALSE), "12\\.35")
7 | expect_match(fmt_stat(.004), "0\\.00")
8 | expect_match(fmt_stat(.004, negative_values = FALSE), "< 0\\.01")
9 | expect_match(fmt_stat(.004, leading_zero = FALSE, negative_values = FALSE),
10 | "< \\.01")
11 | expect_match(fmt_stat(-.93, equal_sign = FALSE, leading_zero = FALSE),
12 | "-\\.93")
13 | })
14 |
15 | test_that("Formatting of p-values", {
16 | expect_match(fmt_pval(0.12345), "^= \\.123$")
17 | expect_match(fmt_pval(0.12345, equal_sign = FALSE), "^\\.123$")
18 | expect_match(fmt_pval(0.00012), "^< \\.001$")
19 | expect_match(fmt_pval(1), "^> \\.999$")
20 | })
21 |
22 | test_that("Formatting significance as symbols", {
23 | expect_match(p_to_symbol(.5), "")
24 | expect_match(p_to_symbol(.1), "")
25 | expect_match(p_to_symbol(.09), "\\.")
26 | expect_match(p_to_symbol(.05), "\\.")
27 | expect_match(p_to_symbol(.049), "\\*")
28 | expect_match(p_to_symbol(.01), "\\*")
29 | expect_match(p_to_symbol(.009), "\\*\\*")
30 | expect_match(p_to_symbol(.001), "\\*\\*")
31 | expect_match(p_to_symbol(.0009), "\\*\\*\\*")
32 | })
33 |
34 | test_that("Formatting of effect sizes", {
35 | expect_match(fmt_es(1.234), "= 1.23")
36 | expect_match(fmt_es(1.234, equal_sign = FALSE), "1.23")
37 | expect_match(fmt_es(0.234), "= 0.23")
38 | expect_match(fmt_es(0.234, leading_zero = FALSE), "= .23")
39 | expect_match(fmt_es(0.00234, leading_zero = FALSE), "< .01")
40 | })
41 |
--------------------------------------------------------------------------------
/vignettes/cor_apa_docx.png:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/dgromer/apa/ec5a2d744ec1e9b5782ad0f1091d18adb9f95c3b/vignettes/cor_apa_docx.png
--------------------------------------------------------------------------------
/vignettes/introduction.Rmd:
--------------------------------------------------------------------------------
1 | ---
2 | title: "Introduction to apa"
3 | author: "Daniel Gromer"
4 | date: "`r Sys.Date()`"
5 | output: rmarkdown::html_vignette
6 | vignette: >
7 | %\VignetteIndexEntry{Introduction to apa}
8 | %\VignetteEngine{knitr::rmarkdown}
9 | %\VignetteEncoding{UTF-8}
10 | ---
11 |
12 | ```{r, warning=FALSE, echo=FALSE}
13 | library(apa)
14 | ```
15 |
16 | The `*_apa()` functions help you to format outputs of statistical tests according to guidelines of the APA (American Psychological Association).
17 |
18 | The functions take the return value of a test function as the first argument, e.g. a call to `chisq.test()` is passed to `chisq_apa()`, which returns a formatted string.
19 |
20 | The idea of such formatters was introduced in the [schoRsch package](https://cran.r-project.org/package=schoRsch/). apa generalizes this idea by providing formatters for different output formats (text, Markdown, RMarkdown, HTML, LaTeX, LaTeX inline math, docx and R's plotmath syntax).
21 |
22 | Currently supported tests are:
23 |
24 | - t-test (`t.test` and `apa::t_test`)
25 | - ANOVA (`aov`, `ez::ezANOVA`, `afex::aov_car`, `afex::aov_ez`, and `afex::aov_4`)
26 | - chi-squared test (`chisq.test`)
27 | - test of a correlation (`cor.test`)
28 |
29 | ## Example
30 |
31 | Take the following test of a correlation as an example:
32 |
33 | ```{r}
34 | # Data from ?cor.test
35 | x <- c(44.4, 45.9, 41.9, 53.3, 44.7, 44.1, 50.7, 45.2, 60.1)
36 | y <- c( 2.6, 3.1, 2.5, 5.0, 3.6, 4.0, 5.2, 2.8, 3.8)
37 |
38 | ct <- cor.test(x, y)
39 | ct
40 | ```
41 |
42 | Calling `cor_apa()` then returns a string ready to copy-and-paste into manuscripts or presentations.
43 |
44 | ```{r}
45 | cor_apa(ct)
46 | ```
47 |
48 | The `format` argument of `cor_apa()` allows you to specify the output format, which can be one of `"text"` (default), `"markdown"`, `"rmarkdown"`, `"html"`, `"latex"`, `"latex_math"`, `"docx"` or `"plotmath"`.
49 |
50 |
51 | ```{r}
52 | cor_apa(ct, format = "rmarkdown")
53 | ```
54 |
55 | Which is printed as `r apa(ct)` in a RMarkdown document.
56 |
57 | ```{r}
58 | cor_apa(ct, format = "latex")
59 | ```
60 |
61 | ```{r, eval=FALSE}
62 | # Opens a temporary document in your word processor
63 | cor_apa(ct, format = "docx")
64 | ```
65 |
66 | 
67 |
68 | ```{r, fig.width=6, fig.height=5}
69 | # Paste output in a plot using R's plotmath syntax
70 | plot(x, y)
71 | abline(lm(y ~ x))
72 | text(55, 3.9, cor_apa(ct, format = "plotmath"))
73 | ```
74 |
--------------------------------------------------------------------------------