├── .Rbuildignore ├── .gitignore ├── DESCRIPTION ├── LICENSE ├── NAMESPACE ├── NEWS.md ├── R ├── formatters.R ├── lme4.R ├── models.R ├── printy-package.R ├── skeletons.R ├── split.R ├── stringr-like.R ├── utils-dplyr.R └── utils-tidy-eval.R ├── README.Rmd ├── README.md ├── man ├── fmt_effect_md.Rd ├── fmt_fix_digits.Rd ├── fmt_leading_zero.Rd ├── fmt_minus_sign.Rd ├── fmt_p_value.Rd ├── fmt_p_value_md.Rd ├── fmt_remove_html_entities.Rd ├── fmt_replace_na.Rd ├── printy-package.Rd ├── skel_conf_interval.Rd ├── skel_range.Rd ├── skel_se.Rd ├── skel_stat_n_value_pair.Rd ├── str_replace_same_as_previous.Rd ├── str_tokenize.Rd ├── super_split.Rd └── tidyeval.Rd ├── printy.Rproj └── tests ├── testthat.R └── testthat ├── test-effect.R ├── test-formatting.R ├── test-misc.R ├── test-split.R └── test-strings.R /.Rbuildignore: -------------------------------------------------------------------------------- 1 | ^printy\.Rproj$ 2 | ^\.Rproj\.user$ 3 | ^.*\.Rproj$ 4 | ^README\.Rmd$ 5 | ^README-.*\.png$ 6 | ^fig/README-.*\.png$ 7 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | # History files 2 | .Rhistory 3 | .Rapp.history 4 | 5 | # Session Data files 6 | .RData 7 | # Example code in package build process 8 | *-Ex.R 9 | # Output files from R CMD build 10 | /*.tar.gz 11 | # Output files from R CMD check 12 | /*.Rcheck/ 13 | # RStudio files 14 | .Rproj.user/ 15 | # produced vignettes 16 | vignettes/*.html 17 | vignettes/*.pdf 18 | # OAuth2 token, see https://github.com/hadley/httr/releases/tag/v0.3 19 | .httr-oauth 20 | # knitr and R markdown default cache directories 21 | /*_cache/ 22 | /cache/ 23 | # Temporary files created by R markdown 24 | *.utf8.md 25 | *.knit.md 26 | .Rproj.user 27 | -------------------------------------------------------------------------------- /DESCRIPTION: -------------------------------------------------------------------------------- 1 | Package: printy 2 | Title: Helper functions for pretty-printing numbers 3 | Version: 0.0.0.9005 4 | Authors@R: 5 | person( 6 | given = "Tristan", 7 | family = "Mahr", 8 | role = c("aut", "cre"), 9 | email = "tristan.mahr@wisc.edu", 10 | comment = c(ORCID = "0000-0002-8890-5116") 11 | ) 12 | Description: This package contains helper functions for formatting numbers. 13 | Depends: R (>= 4.2.0) 14 | License: GPL-3 + file LICENSE 15 | Encoding: UTF-8 16 | LazyData: true 17 | Suggests: 18 | testthat, 19 | pbkrtest, 20 | roxygen2 21 | Roxygen: list(markdown = TRUE) 22 | RoxygenNote: 7.3.1 23 | Imports: 24 | stringr, 25 | lme4, 26 | dplyr, 27 | tidyr, 28 | stats, 29 | tibble, 30 | scales (>= 1.1.0), 31 | broom, 32 | glue, 33 | broom.mixed, 34 | rlang (>= 0.1.2), 35 | parameters, 36 | purrr 37 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | GNU General Public License 2 | ========================== 3 | 4 | _Version 3, 29 June 2007_ 5 | _Copyright © 2007 Free Software Foundation, Inc. <>_ 6 | 7 | Everyone is permitted to copy and distribute verbatim copies of this license 8 | document, but changing it is not allowed. 9 | 10 | ## Preamble 11 | 12 | The GNU General Public License is a free, copyleft license for software and other 13 | kinds of works. 14 | 15 | The licenses for most software and other practical works are designed to take away 16 | your freedom to share and change the works. By contrast, the GNU General Public 17 | License is intended to guarantee your freedom to share and change all versions of a 18 | program--to make sure it remains free software for all its users. We, the Free 19 | Software Foundation, use the GNU General Public License for most of our software; it 20 | applies also to any other work released this way by its authors. You can apply it to 21 | your programs, too. 22 | 23 | When we speak of free software, we are referring to freedom, not price. Our General 24 | Public Licenses are designed to make sure that you have the freedom to distribute 25 | copies of free software (and charge for them if you wish), that you receive source 26 | code or can get it if you want it, that you can change the software or use pieces of 27 | it in new 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 these rights or 30 | asking you to surrender the rights. Therefore, you have certain responsibilities if 31 | you distribute copies of the software, or if you modify it: responsibilities to 32 | respect the freedom of others. 33 | 34 | For example, if you distribute copies of such a program, whether gratis or for a fee, 35 | you must pass on to the recipients the same freedoms that you received. You must make 36 | sure that they, too, receive or can get the source code. And you must show them these 37 | terms so they know their rights. 38 | 39 | Developers that use the GNU GPL protect your rights with two steps: **(1)** assert 40 | copyright on the software, and **(2)** offer you this License giving you legal permission 41 | to copy, distribute and/or modify it. 42 | 43 | For the developers' and authors' protection, the GPL clearly explains that there is 44 | no warranty for this free software. For both users' and authors' sake, the GPL 45 | requires that modified versions be marked as changed, so that their problems will not 46 | be attributed erroneously to authors of previous versions. 47 | 48 | Some devices are designed to deny users access to install or run modified versions of 49 | the software inside them, although the manufacturer can do so. This is fundamentally 50 | incompatible with the aim of protecting users' freedom to change the software. The 51 | systematic pattern of such abuse occurs in the area of products for individuals to 52 | use, which is precisely where it is most unacceptable. Therefore, we have designed 53 | this version of the GPL to prohibit the practice for those products. If such problems 54 | arise substantially in other domains, we stand ready to extend this provision to 55 | those domains in future versions of the GPL, as needed to protect the freedom of 56 | users. 57 | 58 | Finally, every program is threatened constantly by software patents. States should 59 | not allow patents to restrict development and use of software on general-purpose 60 | computers, but in those that do, we wish to avoid the special danger that patents 61 | applied to a free program could make it effectively proprietary. To prevent this, the 62 | GPL assures that patents cannot be used to render the program non-free. 63 | 64 | The precise terms and conditions for copying, distribution and modification follow. 65 | 66 | ## TERMS AND CONDITIONS 67 | 68 | ### 0. Definitions 69 | 70 | “This License” refers to version 3 of the GNU General Public License. 71 | 72 | “Copyright” also means copyright-like laws that apply to other kinds of 73 | works, such as semiconductor masks. 74 | 75 | “The Program” refers to any copyrightable work licensed under this 76 | License. Each licensee is addressed as “you”. “Licensees” and 77 | “recipients” may be individuals or organizations. 78 | 79 | To “modify” a work means to copy from or adapt all or part of the work in 80 | a fashion requiring copyright permission, other than the making of an exact copy. The 81 | resulting work is called a “modified version” of the earlier work or a 82 | work “based on” the earlier work. 83 | 84 | A “covered work” means either the unmodified Program or a work based on 85 | the Program. 86 | 87 | To “propagate” a work means to do anything with it that, without 88 | permission, would make you directly or secondarily liable for infringement under 89 | applicable copyright law, except executing it on a computer or modifying a private 90 | copy. Propagation includes copying, distribution (with or without modification), 91 | making available to the public, and in some countries other activities as well. 92 | 93 | To “convey” a work means any kind of propagation that enables other 94 | parties to make or receive copies. Mere interaction with a user through a computer 95 | network, with no transfer of a copy, is not conveying. 96 | 97 | An interactive user interface displays “Appropriate Legal Notices” to the 98 | extent that it includes a convenient and prominently visible feature that **(1)** 99 | displays an appropriate copyright notice, and **(2)** tells the user that there is no 100 | warranty for the work (except to the extent that warranties are provided), that 101 | licensees may convey the work under this License, and how to view a copy of this 102 | License. If the interface presents a list of user commands or options, such as a 103 | menu, a prominent item in the list meets this criterion. 104 | 105 | ### 1. Source Code 106 | 107 | The “source code” for a work means the preferred form of the work for 108 | making modifications to it. “Object code” means any non-source form of a 109 | work. 110 | 111 | A “Standard Interface” means an interface that either is an official 112 | standard defined by a recognized standards body, or, in the case of interfaces 113 | specified for a particular programming language, one that is widely used among 114 | developers working in that language. 115 | 116 | The “System Libraries” of an executable work include anything, other than 117 | the work as a whole, that **(a)** is included in the normal form of packaging a Major 118 | Component, but which is not part of that Major Component, and **(b)** serves only to 119 | enable use of the work with that Major Component, or to implement a Standard 120 | Interface for which an implementation is available to the public in source code form. 121 | A “Major Component”, in this context, means a major essential component 122 | (kernel, window system, and so on) of the specific operating system (if any) on which 123 | the executable work runs, or a compiler used to produce the work, or an object code 124 | interpreter used to run it. 125 | 126 | The “Corresponding Source” for a work in object code form means all the 127 | source code needed to generate, install, and (for an executable work) run the object 128 | code and to modify the work, including scripts to control those activities. However, 129 | it does not include the work's System Libraries, or general-purpose tools or 130 | generally available free programs which are used unmodified in performing those 131 | activities but which are not part of the work. For example, Corresponding Source 132 | includes interface definition files associated with source files for the work, and 133 | the source code for shared libraries and dynamically linked subprograms that the work 134 | is specifically designed to require, such as by intimate data communication or 135 | control flow between those subprograms and other parts of the work. 136 | 137 | The Corresponding Source need not include anything that users can regenerate 138 | automatically from other parts of the Corresponding Source. 139 | 140 | The Corresponding Source for a work in source code form is that same work. 141 | 142 | ### 2. Basic Permissions 143 | 144 | All rights granted under this License are granted for the term of copyright on the 145 | Program, and are irrevocable provided the stated conditions are met. This License 146 | explicitly affirms your unlimited permission to run the unmodified Program. The 147 | output from running a covered work is covered by this License only if the output, 148 | given its content, constitutes a covered work. This License acknowledges your rights 149 | of fair use or other equivalent, as provided by copyright law. 150 | 151 | You may make, run and propagate covered works that you do not convey, without 152 | conditions so long as your license otherwise remains in force. You may convey covered 153 | works to others for the sole purpose of having them make modifications exclusively 154 | for you, or provide you with facilities for running those works, provided that you 155 | comply with the terms of this License in conveying all material for which you do not 156 | control copyright. Those thus making or running the covered works for you must do so 157 | exclusively on your behalf, under your direction and control, on terms that prohibit 158 | them from making any copies of your copyrighted material outside their relationship 159 | with you. 160 | 161 | Conveying under any other circumstances is permitted solely under the conditions 162 | stated below. Sublicensing is not allowed; section 10 makes it unnecessary. 163 | 164 | ### 3. Protecting Users' Legal Rights From Anti-Circumvention Law 165 | 166 | No covered work shall be deemed part of an effective technological measure under any 167 | applicable law fulfilling obligations under article 11 of the WIPO copyright treaty 168 | adopted on 20 December 1996, or similar laws prohibiting or restricting circumvention 169 | of such measures. 170 | 171 | When you convey a covered work, you waive any legal power to forbid circumvention of 172 | technological measures to the extent such circumvention is effected by exercising 173 | rights under this License with respect to the covered work, and you disclaim any 174 | intention to limit operation or modification of the work as a means of enforcing, 175 | against the work's users, your or third parties' legal rights to forbid circumvention 176 | of technological measures. 177 | 178 | ### 4. Conveying Verbatim Copies 179 | 180 | You may convey verbatim copies of the Program's source code as you receive it, in any 181 | medium, provided that you conspicuously and appropriately publish on each copy an 182 | appropriate copyright notice; keep intact all notices stating that this License and 183 | any non-permissive terms added in accord with section 7 apply to the code; keep 184 | intact all notices of the absence of any warranty; and give all recipients a copy of 185 | this License along with the Program. 186 | 187 | You may charge any price or no price for each copy that you convey, and you may offer 188 | support or warranty protection for a fee. 189 | 190 | ### 5. Conveying Modified Source Versions 191 | 192 | You may convey a work based on the Program, or the modifications to produce it from 193 | the Program, in the form of source code under the terms of section 4, provided that 194 | you also meet all of these conditions: 195 | 196 | * **a)** The work must carry prominent notices stating that you modified it, and giving a 197 | relevant date. 198 | * **b)** The work must carry prominent notices stating that it is released under this 199 | License and any conditions added under section 7. This requirement modifies the 200 | requirement in section 4 to “keep intact all notices”. 201 | * **c)** You must license the entire work, as a whole, under this License to anyone who 202 | comes into possession of a copy. This License will therefore apply, along with any 203 | applicable section 7 additional terms, to the whole of the work, and all its parts, 204 | regardless of how they are packaged. This License gives no permission to license the 205 | work in any other way, but it does not invalidate such permission if you have 206 | separately received it. 207 | * **d)** If the work has interactive user interfaces, each must display Appropriate Legal 208 | Notices; however, if the Program has interactive interfaces that do not display 209 | Appropriate Legal Notices, your work need not make them do so. 210 | 211 | A compilation of a covered work with other separate and independent works, which are 212 | not by their nature extensions of the covered work, and which are not combined with 213 | it such as to form a larger program, in or on a volume of a storage or distribution 214 | medium, is called an “aggregate” if the compilation and its resulting 215 | copyright are not used to limit the access or legal rights of the compilation's users 216 | beyond what the individual works permit. Inclusion of a covered work in an aggregate 217 | does not cause this License to apply to the other parts of the aggregate. 218 | 219 | ### 6. Conveying Non-Source Forms 220 | 221 | You may convey a covered work in object code form under the terms of sections 4 and 222 | 5, provided that you also convey the machine-readable Corresponding Source under the 223 | terms of this License, in one of these ways: 224 | 225 | * **a)** Convey the object code in, or embodied in, a physical product (including a 226 | physical distribution medium), accompanied by the Corresponding Source fixed on a 227 | durable physical medium customarily used for software interchange. 228 | * **b)** Convey the object code in, or embodied in, a physical product (including a 229 | physical distribution medium), accompanied by a written offer, valid for at least 230 | three years and valid for as long as you offer spare parts or customer support for 231 | that product model, to give anyone who possesses the object code either **(1)** a copy of 232 | the Corresponding Source for all the software in the product that is covered by this 233 | License, on a durable physical medium customarily used for software interchange, for 234 | a price no more than your reasonable cost of physically performing this conveying of 235 | source, or **(2)** access to copy the Corresponding Source from a network server at no 236 | charge. 237 | * **c)** Convey individual copies of the object code with a copy of the written offer to 238 | provide the Corresponding Source. This alternative is allowed only occasionally and 239 | noncommercially, and only if you received the object code with such an offer, in 240 | accord with subsection 6b. 241 | * **d)** Convey the object code by offering access from a designated place (gratis or for 242 | a charge), and offer equivalent access to the Corresponding Source in the same way 243 | through the same place at no further charge. You need not require recipients to copy 244 | the Corresponding Source along with the object code. If the place to copy the object 245 | code is a network server, the Corresponding Source may be on a different server 246 | (operated by you or a third party) that supports equivalent copying facilities, 247 | provided you maintain clear directions next to the object code saying where to find 248 | the Corresponding Source. Regardless of what server hosts the Corresponding Source, 249 | you remain obligated to ensure that it is available for as long as needed to satisfy 250 | these requirements. 251 | * **e)** Convey the object code using peer-to-peer transmission, provided you inform 252 | other peers where the object code and Corresponding Source of the work are being 253 | offered to the general public at no charge under subsection 6d. 254 | 255 | A separable portion of the object code, whose source code is excluded from the 256 | Corresponding Source as a System Library, need not be included in conveying the 257 | object code work. 258 | 259 | A “User Product” is either **(1)** a “consumer product”, which 260 | means any tangible personal property which is normally used for personal, family, or 261 | household purposes, or **(2)** anything designed or sold for incorporation into a 262 | dwelling. In determining whether a product is a consumer product, doubtful cases 263 | shall be resolved in favor of coverage. For a particular product received by a 264 | particular user, “normally used” refers to a typical or common use of 265 | that class of product, regardless of the status of the particular user or of the way 266 | in which the particular user actually uses, or expects or is expected to use, the 267 | product. A product is a consumer product regardless of whether the product has 268 | substantial commercial, industrial or non-consumer uses, unless such uses represent 269 | the only significant mode of use of the product. 270 | 271 | “Installation Information” for a User Product means any methods, 272 | procedures, authorization keys, or other information required to install and execute 273 | modified versions of a covered work in that User Product from a modified version of 274 | its Corresponding Source. The information must suffice to ensure that the continued 275 | functioning of the modified object code is in no case prevented or interfered with 276 | solely because modification has been made. 277 | 278 | If you convey an object code work under this section in, or with, or specifically for 279 | use in, a User Product, and the conveying occurs as part of a transaction in which 280 | the right of possession and use of the User Product is transferred to the recipient 281 | in perpetuity or for a fixed term (regardless of how the transaction is 282 | characterized), the Corresponding Source conveyed under this section must be 283 | accompanied by the Installation Information. But this requirement does not apply if 284 | neither you nor any third party retains the ability to install modified object code 285 | on the User Product (for example, the work has been installed in ROM). 286 | 287 | The requirement to provide Installation Information does not include a requirement to 288 | continue to provide support service, warranty, or updates for a work that has been 289 | modified or installed by the recipient, or for the User Product in which it has been 290 | modified or installed. Access to a network may be denied when the modification itself 291 | materially and adversely affects the operation of the network or violates the rules 292 | and protocols for communication across the network. 293 | 294 | Corresponding Source conveyed, and Installation Information provided, in accord with 295 | this section must be in a format that is publicly documented (and with an 296 | implementation available to the public in source code form), and must require no 297 | special password or key for unpacking, reading or copying. 298 | 299 | ### 7. Additional Terms 300 | 301 | “Additional permissions” are terms that supplement the terms of this 302 | License by making exceptions from one or more of its conditions. Additional 303 | permissions that are applicable to the entire Program shall be treated as though they 304 | were included in this License, to the extent that they are valid under applicable 305 | law. If additional permissions apply only to part of the Program, that part may be 306 | used separately under those permissions, but the entire Program remains governed by 307 | this License without regard to the additional permissions. 308 | 309 | When you convey a copy of a covered work, you may at your option remove any 310 | additional permissions from that copy, or from any part of it. (Additional 311 | permissions may be written to require their own removal in certain cases when you 312 | modify the work.) You may place additional permissions on material, added by you to a 313 | covered work, for which you have or can give appropriate copyright permission. 314 | 315 | Notwithstanding any other provision of this License, for material you add to a 316 | covered work, you may (if authorized by the copyright holders of that material) 317 | supplement the terms of this License with terms: 318 | 319 | * **a)** Disclaiming warranty or limiting liability differently from the terms of 320 | sections 15 and 16 of this License; or 321 | * **b)** Requiring preservation of specified reasonable legal notices or author 322 | attributions in that material or in the Appropriate Legal Notices displayed by works 323 | containing it; or 324 | * **c)** Prohibiting misrepresentation of the origin of that material, or requiring that 325 | modified versions of such material be marked in reasonable ways as different from the 326 | original version; or 327 | * **d)** Limiting the use for publicity purposes of names of licensors or authors of the 328 | material; or 329 | * **e)** Declining to grant rights under trademark law for use of some trade names, 330 | trademarks, or service marks; or 331 | * **f)** Requiring indemnification of licensors and authors of that material by anyone 332 | who conveys the material (or modified versions of it) with contractual assumptions of 333 | liability to the recipient, for any liability that these contractual assumptions 334 | directly impose on those licensors and authors. 335 | 336 | All other non-permissive additional terms are considered “further 337 | restrictions” within the meaning of section 10. If the Program as you received 338 | it, or any part of it, contains a notice stating that it is governed by this License 339 | along with a term that is a further restriction, you may remove that term. If a 340 | license document contains a further restriction but permits relicensing or conveying 341 | under this License, you may add to a covered work material governed by the terms of 342 | that license document, provided that the further restriction does not survive such 343 | relicensing or conveying. 344 | 345 | If you add terms to a covered work in accord with this section, you must place, in 346 | the relevant source files, a statement of the additional terms that apply to those 347 | files, or a notice indicating where to find the applicable terms. 348 | 349 | Additional terms, permissive or non-permissive, may be stated in the form of a 350 | separately written license, or stated as exceptions; the above requirements apply 351 | either way. 352 | 353 | ### 8. Termination 354 | 355 | You may not propagate or modify a covered work except as expressly provided under 356 | this License. Any attempt otherwise to propagate or modify it is void, and will 357 | automatically terminate your rights under this License (including any patent licenses 358 | granted under the third paragraph of section 11). 359 | 360 | However, if you cease all violation of this License, then your license from a 361 | particular copyright holder is reinstated **(a)** provisionally, unless and until the 362 | copyright holder explicitly and finally terminates your license, and **(b)** permanently, 363 | if the copyright holder fails to notify you of the violation by some reasonable means 364 | prior to 60 days after the cessation. 365 | 366 | Moreover, your license from a particular copyright holder is reinstated permanently 367 | if the copyright holder notifies you of the violation by some reasonable means, this 368 | is the first time you have received notice of violation of this License (for any 369 | work) from that copyright holder, and you cure the violation prior to 30 days after 370 | your receipt of the notice. 371 | 372 | Termination of your rights under this section does not terminate the licenses of 373 | parties who have received copies or rights from you under this License. If your 374 | rights have been terminated and not permanently reinstated, you do not qualify to 375 | receive new licenses for the same material under section 10. 376 | 377 | ### 9. Acceptance Not Required for Having Copies 378 | 379 | You are not required to accept this License in order to receive or run a copy of the 380 | Program. Ancillary propagation of a covered work occurring solely as a consequence of 381 | using peer-to-peer transmission to receive a copy likewise does not require 382 | acceptance. However, nothing other than this License grants you permission to 383 | propagate or modify any covered work. These actions infringe copyright if you do not 384 | accept this License. Therefore, by modifying or propagating a covered work, you 385 | indicate your acceptance of this License to do so. 386 | 387 | ### 10. Automatic Licensing of Downstream Recipients 388 | 389 | Each time you convey a covered work, the recipient automatically receives a license 390 | from the original licensors, to run, modify and propagate that work, subject to this 391 | License. You are not responsible for enforcing compliance by third parties with this 392 | License. 393 | 394 | An “entity transaction” is a transaction transferring control of an 395 | organization, or substantially all assets of one, or subdividing an organization, or 396 | merging organizations. If propagation of a covered work results from an entity 397 | transaction, each party to that transaction who receives a copy of the work also 398 | receives whatever licenses to the work the party's predecessor in interest had or 399 | could give under the previous paragraph, plus a right to possession of the 400 | Corresponding Source of the work from the predecessor in interest, if the predecessor 401 | has it or can get it with reasonable efforts. 402 | 403 | You may not impose any further restrictions on the exercise of the rights granted or 404 | affirmed under this License. For example, you may not impose a license fee, royalty, 405 | or other charge for exercise of rights granted under this License, and you may not 406 | initiate litigation (including a cross-claim or counterclaim in a lawsuit) alleging 407 | that any patent claim is infringed by making, using, selling, offering for sale, or 408 | importing the Program or any portion of it. 409 | 410 | ### 11. Patents 411 | 412 | A “contributor” is a copyright holder who authorizes use under this 413 | License of the Program or a work on which the Program is based. The work thus 414 | licensed is called the contributor's “contributor version”. 415 | 416 | A contributor's “essential patent claims” are all patent claims owned or 417 | controlled by the contributor, whether already acquired or hereafter acquired, that 418 | would be infringed by some manner, permitted by this License, of making, using, or 419 | selling its contributor version, but do not include claims that would be infringed 420 | only as a consequence of further modification of the contributor version. For 421 | purposes of this definition, “control” includes the right to grant patent 422 | sublicenses in a manner consistent with the requirements of this License. 423 | 424 | Each contributor grants you a non-exclusive, worldwide, royalty-free patent license 425 | under the contributor's essential patent claims, to make, use, sell, offer for sale, 426 | import and otherwise run, modify and propagate the contents of its contributor 427 | version. 428 | 429 | In the following three paragraphs, a “patent license” is any express 430 | agreement or commitment, however denominated, not to enforce a patent (such as an 431 | express permission to practice a patent or covenant not to sue for patent 432 | infringement). To “grant” such a patent license to a party means to make 433 | such an agreement or commitment not to enforce a patent against the party. 434 | 435 | If you convey a covered work, knowingly relying on a patent license, and the 436 | Corresponding Source of the work is not available for anyone to copy, free of charge 437 | and under the terms of this License, through a publicly available network server or 438 | other readily accessible means, then you must either **(1)** cause the Corresponding 439 | Source to be so available, or **(2)** arrange to deprive yourself of the benefit of the 440 | patent license for this particular work, or **(3)** arrange, in a manner consistent with 441 | the requirements of this License, to extend the patent license to downstream 442 | recipients. “Knowingly relying” means you have actual knowledge that, but 443 | for the patent license, your conveying the covered work in a country, or your 444 | recipient's use of the covered work in a country, would infringe one or more 445 | identifiable patents in that country that you have reason to believe are valid. 446 | 447 | If, pursuant to or in connection with a single transaction or arrangement, you 448 | convey, or propagate by procuring conveyance of, a covered work, and grant a patent 449 | license to some of the parties receiving the covered work authorizing them to use, 450 | propagate, modify or convey a specific copy of the covered work, then the patent 451 | license you grant is automatically extended to all recipients of the covered work and 452 | works based on it. 453 | 454 | A patent license is “discriminatory” if it does not include within the 455 | scope of its coverage, prohibits the exercise of, or is conditioned on the 456 | non-exercise of one or more of the rights that are specifically granted under this 457 | License. You may not convey a covered work if you are a party to an arrangement with 458 | a third party that is in the business of distributing software, under which you make 459 | payment to the third party based on the extent of your activity of conveying the 460 | work, and under which the third party grants, to any of the parties who would receive 461 | the covered work from you, a discriminatory patent license **(a)** in connection with 462 | copies of the covered work conveyed by you (or copies made from those copies), or **(b)** 463 | primarily for and in connection with specific products or compilations that contain 464 | the covered work, unless you entered into that arrangement, or that patent license 465 | was granted, prior to 28 March 2007. 466 | 467 | Nothing in this License shall be construed as excluding or limiting any implied 468 | license or other defenses to infringement that may otherwise be available to you 469 | under applicable patent law. 470 | 471 | ### 12. No Surrender of Others' Freedom 472 | 473 | If conditions are imposed on you (whether by court order, agreement or otherwise) 474 | that contradict the conditions of this License, they do not excuse you from the 475 | conditions of this License. If you cannot convey a covered work so as to satisfy 476 | simultaneously your obligations under this License and any other pertinent 477 | obligations, then as a consequence you may not convey it at all. For example, if you 478 | agree to terms that obligate you to collect a royalty for further conveying from 479 | those to whom you convey the Program, the only way you could satisfy both those terms 480 | and this License would be to refrain entirely from conveying the Program. 481 | 482 | ### 13. Use with the GNU Affero General Public License 483 | 484 | Notwithstanding any other provision of this License, you have permission to link or 485 | combine any covered work with a work licensed under version 3 of the GNU Affero 486 | General Public License into a single combined work, and to convey the resulting work. 487 | The terms of this License will continue to apply to the part which is the covered 488 | work, but the special requirements of the GNU Affero General Public License, section 489 | 13, concerning interaction through a network will apply to the combination as such. 490 | 491 | ### 14. Revised Versions of this License 492 | 493 | The Free Software Foundation may publish revised and/or new versions of the GNU 494 | General Public License from time to time. Such new versions will be similar in spirit 495 | to the present version, but may differ in detail to address new problems or concerns. 496 | 497 | Each version is given a distinguishing version number. If the Program specifies that 498 | a certain numbered version of the GNU General Public License “or any later 499 | version” applies to it, you have the option of following the terms and 500 | conditions either of that numbered version or of any later version published by the 501 | Free Software Foundation. If the Program does not specify a version number of the GNU 502 | General Public License, you may choose any version ever published by the Free 503 | Software Foundation. 504 | 505 | If the Program specifies that a proxy can decide which future versions of the GNU 506 | General Public License can be used, that proxy's public statement of acceptance of a 507 | version permanently authorizes you to choose that version for the Program. 508 | 509 | Later license versions may give you additional or different permissions. However, no 510 | additional obligations are imposed on any author or copyright holder as a result of 511 | your choosing to follow a later version. 512 | 513 | ### 15. Disclaimer of Warranty 514 | 515 | THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. 516 | EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES 517 | PROVIDE THE PROGRAM “AS IS” WITHOUT WARRANTY OF ANY KIND, EITHER 518 | EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF 519 | MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS TO THE 520 | QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE PROGRAM PROVE 521 | DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, REPAIR OR CORRECTION. 522 | 523 | ### 16. Limitation of Liability 524 | 525 | IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING WILL ANY 526 | COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MODIFIES AND/OR CONVEYS THE PROGRAM AS 527 | PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, 528 | INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THE 529 | PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE 530 | OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE 531 | WITH ANY OTHER PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE 532 | POSSIBILITY OF SUCH DAMAGES. 533 | 534 | ### 17. Interpretation of Sections 15 and 16 535 | 536 | If the disclaimer of warranty and limitation of liability provided above cannot be 537 | given local legal effect according to their terms, reviewing courts shall apply local 538 | law that most closely approximates an absolute waiver of all civil liability in 539 | connection with the Program, unless a warranty or assumption of liability accompanies 540 | a copy of the Program in return for a fee. 541 | 542 | _END OF TERMS AND CONDITIONS_ 543 | 544 | ## How to Apply These Terms to Your New Programs 545 | 546 | If you develop a new program, and you want it to be of the greatest possible use to 547 | the public, the best way to achieve this is to make it free software which everyone 548 | can redistribute and change under these terms. 549 | 550 | To do so, attach the following notices to the program. It is safest to attach them 551 | to the start of each source file to most effectively state the exclusion of warranty; 552 | and each file should have at least the “copyright” line and a pointer to 553 | where the full notice is found. 554 | 555 | 556 | Copyright (C) 557 | 558 | This program is free software: you can redistribute it and/or modify 559 | it under the terms of the GNU General Public License as published by 560 | the Free Software Foundation, either version 3 of the License, or 561 | (at your option) any later version. 562 | 563 | This program is distributed in the hope that it will be useful, 564 | but WITHOUT ANY WARRANTY; without even the implied warranty of 565 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 566 | GNU General Public License for more details. 567 | 568 | You should have received a copy of the GNU General Public License 569 | along with this program. If not, see . 570 | 571 | Also add information on how to contact you by electronic and paper mail. 572 | 573 | If the program does terminal interaction, make it output a short notice like this 574 | when it starts in an interactive mode: 575 | 576 | Copyright (C) 577 | This program comes with ABSOLUTELY NO WARRANTY; for details type 'show w'. 578 | This is free software, and you are welcome to redistribute it 579 | under certain conditions; type 'show c' for details. 580 | 581 | The hypothetical commands `show w` and `show c` should show the appropriate parts of 582 | the General Public License. Of course, your program's commands might be different; 583 | for a GUI interface, you would use an “about box”. 584 | 585 | You should also get your employer (if you work as a programmer) or school, if any, to 586 | sign a “copyright disclaimer” for the program, if necessary. For more 587 | information on this, and how to apply and follow the GNU GPL, see 588 | <>. 589 | 590 | The GNU General Public License does not permit incorporating your program into 591 | proprietary programs. If your program is a subroutine library, you may consider it 592 | more useful to permit linking proprietary applications with the library. If this is 593 | what you want to do, use the GNU Lesser General Public License instead of this 594 | License. But first, please read 595 | <>. 596 | -------------------------------------------------------------------------------- /NAMESPACE: -------------------------------------------------------------------------------- 1 | # Generated by roxygen2: do not edit by hand 2 | 3 | export(fmt_effect_md) 4 | export(fmt_fix_digits) 5 | export(fmt_leading_zero) 6 | export(fmt_minus_sign) 7 | export(fmt_p_value) 8 | export(fmt_p_value_md) 9 | export(fmt_remove_html_entities) 10 | export(fmt_replace_na) 11 | export(pretty_lme4_ranefs) 12 | export(skel_ci) 13 | export(skel_conf_interval) 14 | export(skel_conf_interval_pair) 15 | export(skel_range) 16 | export(skel_range_pair) 17 | export(skel_se) 18 | export(skel_stat_n_value_pair) 19 | export(str_replace_same_as_previous) 20 | export(str_tokenize) 21 | export(super_split) 22 | importFrom(rlang,":=") 23 | importFrom(rlang,.data) 24 | importFrom(rlang,as_label) 25 | importFrom(rlang,as_name) 26 | importFrom(rlang,enquo) 27 | importFrom(rlang,enquos) 28 | importFrom(rlang,expr) 29 | importFrom(rlang,sym) 30 | importFrom(rlang,syms) 31 | -------------------------------------------------------------------------------- /NEWS.md: -------------------------------------------------------------------------------- 1 | # printy 0.0.0.9005 2 | 3 | - Remove magrittr depedency 4 | - Fix `fmt_fix_digits()` typo from last update 5 | 6 | # printy 0.0.0.9004 7 | 8 | - Require R version >= 4.2.0 (when UTF-8 support for Windows and native pipe 9 | placeholders were added.) 10 | - Renamed argument `n` to `digits` in `fmt_fix_digits()`. 11 | - Added `fmt_remove_html_entities()` because R on Windows has UTF-8 support. 12 | 13 | # printy 0.0.0.9003 14 | 15 | - Renamed functions: 16 | - `skel_conf_interval_v()` -\> `skel_conf_interval()` 17 | - `skel_conf_interval()` -\> `skel_conf_interval_pair()` 18 | - `skel_stat_n_value()` -\> `skel_stat_n_value_pair()` 19 | 20 | # printy 0.0.0.9002 21 | 22 | * Added a `NEWS.md` file to track changes to the package. 23 | -------------------------------------------------------------------------------- /R/formatters.R: -------------------------------------------------------------------------------- 1 | 2 | #' Format a number with a fixed number of digits 3 | #' @param xs a vector of numbers or a character vector representing numbers 4 | #' @param digits number of digits of precision 5 | #' @export 6 | #' @examples 7 | #' # what we want to avoid 8 | #' as.character(round(c(.4001, .1000, .5500), 2)) 9 | #' 10 | #' fmt_fix_digits(c(.4001, .1000, .5500), 1) 11 | #' fmt_fix_digits(c(.4001, .1000, .5500), 2) 12 | #' fmt_fix_digits(c(.4001, .1000, .5500), 3) 13 | fmt_fix_digits <- function(xs, digits = 2) { 14 | stopifnot(length(digits) == 1) 15 | rounded_xs <- round(xs, digits) 16 | decimals <- if (digits < 0) 0 else digits 17 | printed <- sprintf("%.*f", decimals, rounded_xs) 18 | printed[is.na(xs)] <- NA 19 | printed 20 | } 21 | 22 | #' Format negative numbers with a minus sign 23 | #' 24 | #' @inheritParams fmt_fix_digits 25 | #' @return the vector with leading hyphens replaced with HTML minus signs 26 | #' (`−`). 27 | #' @export 28 | #' @details Negative zero `-0`, which might happen from aggressive rounding, 29 | #' does not get a minus sign. 30 | #' @examples 31 | #' fmt_minus_sign(c(1, .2, -1, -.2)) 32 | #' 33 | #' # Don't allow zero to be signed 34 | #' fmt_minus_sign(c(-0, round(-0.001))) 35 | fmt_minus_sign <- function(xs) { 36 | xs |> 37 | stringr::str_replace("^-", "−") |> 38 | # Don't want a signed zero 39 | stringr::str_replace("^(−)(0)$", "\\2") |> 40 | stringr::str_replace("^(−)(0[.]0+)$", "\\2") 41 | } 42 | 43 | #' Replace HTML entities used by this package with UTF-8 codes 44 | #' @param xs a character vector 45 | #' @return the updated character vector 46 | #' @export 47 | #' @examples 48 | #' x <- "a < −12" |> 49 | #' fmt_remove_html_entities() 50 | #' x 51 | #' charToRaw(x) 52 | #' charToRaw("a < -12") 53 | #' 54 | #' fmt_remove_html_entities("1–2") 55 | fmt_remove_html_entities <- function(xs) { 56 | xs |> 57 | stringr::str_replace_all(stringr::fixed("−"), "\u2212") |> 58 | stringr::str_replace_all(stringr::fixed(" "), "\u00A0") |> 59 | stringr::str_replace_all(stringr::fixed("–"), "\u2013") 60 | } 61 | 62 | #' Format numbers to remove leading zeros 63 | #' 64 | #' @inheritParams fmt_fix_digits 65 | #' @return the vector with leading zeros removed. This function returns a 66 | #' warning if any of the values have an absolute value greater than 1. 67 | #' @export 68 | #' @details APA format says that values that are bounded between \[-1, 1\] 69 | #' should not be formatted with a leading zero. Common examples would be 70 | #' correlations, proportions, probabilities and p-values. Why print the digit 71 | #' if it's almost never used? 72 | #' 73 | #' Zeros are printed to match the precision of the most precise number. For 74 | #' example, `c(0, 0.111)` becomes `c(.000, .111)` 75 | #' @examples 76 | #' fmt_leading_zero(c(0, 0.111)) 77 | #' fmt_leading_zero(c(0.99, -0.9, -0.0)) 78 | fmt_leading_zero <- function(xs) { 79 | digit_matters <- xs |> 80 | as.numeric() |> 81 | abs() |> 82 | # Problem if any value is greater than 1.0 83 | is_greater_than_1() |> 84 | stats::na.omit() 85 | 86 | if (any(digit_matters)) { 87 | warning("Non-zero leading digit") 88 | } 89 | 90 | replaced <- stringr::str_replace(xs, "^(-?)0", "\\1") 91 | 92 | if (any(as.numeric(xs) == 0, na.rm = TRUE)) { 93 | # Match the most precise number (or use .0) 94 | precision <- max(c(stringr::str_count(replaced, "\\d"), 1)) 95 | new_zero <- paste0(".", paste0(rep(0, precision), collapse = "")) 96 | replaced[xs == 0] <- new_zero 97 | } 98 | 99 | replaced 100 | } 101 | 102 | is_greater_than_1 <- function(xs) { 103 | xs > 1 104 | } 105 | 106 | 107 | #' Replace NAs with another value 108 | #' @param x a character vector 109 | #' @return the updated vector 110 | #' @export 111 | fmt_replace_na <- function(xs, replacement = "") { 112 | ifelse(is.na(xs), replacement, xs) 113 | } 114 | 115 | 116 | #' Format a *p*-value 117 | #' @inheritParams fmt_fix_digits 118 | #' @return formatted *-values. Values smaller than the precision `1 / (10 ^ 119 | #' digits)` are replaced with a less than statement `< [precision]`. 120 | #' @export 121 | #' @examples 122 | #' p <- c(1, 0.1, 0.01, 0.001, 0.0001) 123 | #' fmt_p_value(p, digits = 2) 124 | #' fmt_p_value(p, digits = 3) 125 | fmt_p_value <- function(xs, digits = 3) { 126 | stopifnot(digits >= 1, length(digits) == 1) 127 | 128 | smallest_value <- 1 / (10 ^ digits) 129 | smallest_form <- smallest_value |> 130 | fmt_fix_digits(digits) |> 131 | fmt_leading_zero() |> 132 | paste0_after(.first = "< ") 133 | 134 | xs_chr <- xs |> 135 | fmt_fix_digits(digits) |> 136 | fmt_leading_zero() 137 | 138 | xs_chr[xs < smallest_value] <- smallest_form 139 | xs_chr 140 | } 141 | 142 | paste0_after <- function(..., .first) { 143 | paste0(.first, ...) 144 | } 145 | 146 | #' Format a *p*-value in markdown 147 | #' 148 | #' @param ps *p*-values to format 149 | #' @return a character vector of markdown formatted *p*-values 150 | #' 151 | #' @details 152 | #' 153 | #' `fmt_p_value()` is for formatting p-values with manual precision, but this 154 | #' functions follows some reasonable defaults and returns a markdown formatted 155 | #' string. 156 | #' 157 | #' Values less than .06 are formatted with 3 digits. Values equal to .06 or 158 | #' greater are formatted with 2 digits. 159 | #' 160 | #' [scales::label_pvalue()] does the initial rounding and formatting. Then this 161 | #' function strips off the leading 0 of the *p* value. 162 | #' 163 | #' @export 164 | #' @examples 165 | #' fmt_p_value_md(0.0912) 166 | #' fmt_p_value_md(0.0512) 167 | #' fmt_p_value_md(0.005) 168 | #' 169 | #' # "p less than" notation kicks in below .001. 170 | #' fmt_p_value_md(0.0005) 171 | fmt_p_value_md <- function(ps) { 172 | prefixes <- c("*p* < ", "*p* = ", "*p* > ") 173 | label_pvalue_2 <- scales::label_pvalue(accuracy = .01 , prefix = prefixes) 174 | label_pvalue_3 <- scales::label_pvalue(accuracy = .001, prefix = prefixes) 175 | 176 | # use three digits if less than .06 177 | ps <- ifelse( 178 | ps < .06 | is.na(ps), 179 | label_pvalue_3(ps), 180 | label_pvalue_2(ps) 181 | ) 182 | 183 | ps |> 184 | stringr::str_replace("(=|<|>) 0[.]", "\\1 .") 185 | } 186 | -------------------------------------------------------------------------------- /R/lme4.R: -------------------------------------------------------------------------------- 1 | 2 | #' @export 3 | pretty_lme4_ranefs <- function(model) { 4 | vars <- dplyr::vars 5 | funs <- dplyr::funs 6 | 7 | table <- tidy_ranef_summary(model) 8 | 9 | ranef_names <- setdiff(names(table), c("var1", "grp", "vcov", "sdcor")) 10 | 11 | table <- table |> 12 | # Format the numbers 13 | dplyr::mutate_at(c("vcov", "sdcor"), format_fixef_num) |> 14 | dplyr::mutate_at( 15 | vars(dplyr::one_of(ranef_names)), 16 | format_ranef_cor 17 | ) |> 18 | sort_ranef_grps() |> 19 | # Format variable names and group names 20 | dplyr::mutate( 21 | var1 = fmt_replace_na(.data$var1, " "), 22 | grp = str_replace_same_as_previous(.data$grp, " ") 23 | ) |> 24 | rename_names( 25 | Group = "grp", 26 | Parameter = "var1", 27 | Variance = "vcov", 28 | SD = "sdcor" 29 | ) 30 | 31 | # Rename columns 5:n to c("Correlations", " ", ..., " ") 32 | names_to_replace <- seq(from = 5, to = length(names(table))) 33 | new_names <- rep(" ", length(names_to_replace)) 34 | new_names[1] <- "Correlations" 35 | names(table)[names_to_replace] <- new_names 36 | 37 | table 38 | } 39 | 40 | tidy_lme4_variances <- function(model) { 41 | lme4::VarCorr(model) |> 42 | as.data.frame() |> 43 | dplyr::filter(is.na(.data$var2)) |> 44 | unselect_names("var2") 45 | } 46 | 47 | tidy_lme4_covariances <- function(model) { 48 | lme4::VarCorr(model) |> 49 | as.data.frame() |> 50 | dplyr::filter(!is.na(.data$var2)) 51 | } 52 | 53 | # Create a data-frame with random effect variances and correlations 54 | tidy_ranef_summary <- function(model) { 55 | vars <- tidy_lme4_variances(model) 56 | cors <- tidy_lme4_covariances(model) |> 57 | unselect_names("vcov") 58 | 59 | # Create some 1s for the diagonal of the correlation matrix 60 | self_cor <- vars |> 61 | unselect_names("vcov") |> 62 | dplyr::mutate(var2 = .data$var1, sdcor = 1.0) |> 63 | stats::na.omit() 64 | 65 | # Spread out long-from correlations into a matrix 66 | cor_df <- dplyr::bind_rows(cors, self_cor) |> 67 | dplyr::mutate(sdcor = fmt_fix_digits(.data$sdcor, 2)) 68 | 69 | # Sort the var1, var2 columns by descending frequency of variable names 70 | sort_vars <- function(xs) { 71 | sorted1 <- rev(sort(table(xs$var1))) 72 | sorted2 <- rev(sort(table(xs$var2))) 73 | xs$var1 <- factor(xs$var1, names(sorted1)) 74 | xs$var2 <- factor(xs$var2, names(sorted2)) 75 | xs[1:4] 76 | } 77 | 78 | blank_param_col_names <- function(xs) { 79 | stats::setNames(xs, c("grp", "var2", rep("", length(xs) - 2))) 80 | } 81 | 82 | cor_matrix <- split(cor_df, cor_df$grp) |> 83 | lapply(sort_vars) |> 84 | lapply(tidyr::spread, "var1", "sdcor") |> 85 | lapply(dplyr::arrange, dplyr::desc(.data$var2)) |> 86 | lapply(blank_param_col_names) |> 87 | lapply(tibble::repair_names) |> 88 | lapply(dplyr::mutate, var2 = as.character(.data$var2)) |> 89 | dplyr::bind_rows() |> 90 | rename_names(var1 = "var2") 91 | 92 | sorting_names <- utils::tail(names(cor_matrix), -2) 93 | sorters <- syms(c("grp", sorting_names)) 94 | 95 | dplyr::left_join(vars, cor_matrix, by = c("grp", "var1")) 96 | } 97 | 98 | # Sort random effects groups, and make sure residual comes last 99 | sort_ranef_grps <- function(df) { 100 | residual <- dplyr::filter(df, .data$grp == "Residual") 101 | df |> 102 | dplyr::filter(.data$grp != "Residual") |> 103 | dplyr::arrange(.data$grp) |> 104 | dplyr::bind_rows(residual) 105 | } 106 | 107 | format_fixef_num <- function(xs) { 108 | xs |> 109 | fmt_fix_digits(2) |> 110 | fmt_minus_sign() 111 | } 112 | 113 | format_ranef_cor <- function(xs) { 114 | xs |> 115 | fmt_leading_zero() |> 116 | fmt_minus_sign() |> 117 | fmt_replace_na(replacement = " ") 118 | } 119 | -------------------------------------------------------------------------------- /R/models.R: -------------------------------------------------------------------------------- 1 | #' Format an effect from a model object in markdown 2 | #' 3 | #' @param model a model object 4 | #' @param effect string naming an effect from a model 5 | #' @param terms a string representing the terms about the effect to extract and 6 | #' format and the order to print the terms. See details below. Defaults to 7 | #' `"besp"` for parameter estimate, standard error, statistic, *p*-value. 8 | #' @param digits a vector of digits to use for non-*p*-value terms. Defaults to 9 | #' 2 for 2 decimal places of precision for all terms. This argument can be a 10 | #' vector to set the digits for each term, but in this case, the digits is 11 | #' still ignored for *p*-values. 12 | #' @param statistic symbol to use for statistic. Defaults to *t* (or *z* in 13 | #' glmer models). 14 | #' @param b_lab label to print in subscripts after *b* for when `"B"` is one of 15 | #' the terms. 16 | #' @param ci_width width to use for confidence intervals when the term `"i"` is 17 | #' used. 18 | #' @export 19 | #' 20 | #' @details Currently only effects fit by [stats::lm()] and [lme4::lmer()]. 21 | #' 22 | #' The supported terms are: 23 | #' 24 | #' * `"b"` - parameter estimate (think b for _beta_) 25 | #' * `"B"` - parameter estimate with a subscript label provided by `b_lab` 26 | #' * `"e"` - standard error 27 | #' * `"s"` - statistic. The symbol for the statistic is set by 28 | #' `statistic`. The default value is `"t"` for a *t*-statistic. Example 29 | #' output: _t_ = 1. 30 | #' * `"S"` - statistic as in `"s"` but with degrees of freedom. Example 31 | #' output: _t_(12) = 1. 32 | #' * `"i"` - confidence interval. Width is set by `ci_width`. 33 | #' * `"p"` - _p_-value. The p-value is formatted by [fmt_p_value_md()]. 34 | #' 35 | #' Degrees of freedom and *p*-values for `lmer()` models use the 36 | #' Kenwood-Rogers approximation provided by [parameters::p_value_kenward()]. 37 | #' This computation can take a while. The confidence-interval calculation uses 38 | #' default confidence interval calculation method used by 39 | #' [`broom.mixed::tidy.merMod()`][broom.mixed::lme4_tidiers]. 40 | #' 41 | #' @examples 42 | #' model <- lm(breaks ~ wool * tension, warpbreaks) 43 | #' 44 | #' # default to: b (beta), e (error), s (statistic), p (p value) 45 | #' fmt_effect_md(model, "woolB", "besp") 46 | #' 47 | #' fmt_effect_md(model, "woolB", "Besp", b_lab = "WoolB") 48 | #' 49 | #' fmt_effect_md(model, "woolB", "i") 50 | fmt_effect_md <- function( 51 | model, 52 | effect, 53 | terms = "besp", 54 | digits = 2, 55 | statistic = NULL, 56 | b_lab = NULL, 57 | ci_width = .95, 58 | p_value_method = NULL 59 | ) { 60 | stopifnot(length(digits) %in% c(1, nchar(terms))) 61 | stopifnot(inherits(model, c("lm", "lmerMod", "glmerMod"))) 62 | 63 | if (is.null(statistic)) { 64 | statistic <- if (inherits(model, "glmerMod")) "z" else "t" 65 | } 66 | 67 | if (length(digits) == 1) { 68 | digits <- rep(digits, nchar(terms)) 69 | } 70 | 71 | term_values <- get_terms( 72 | model, 73 | effect, 74 | terms, 75 | ci_width = ci_width, 76 | p_value_method = p_value_method 77 | ) 78 | output <- seq_along(term_values) 79 | 80 | b_lab <- ifelse(is.null(b_lab), effect, b_lab) 81 | 82 | for (item_i in seq_along(term_values)) { 83 | item_value <- term_values[[item_i]] 84 | item_name <- names(term_values[item_i]) 85 | 86 | output[item_i] <- switch( 87 | item_name, 88 | B = item_value |> 89 | fmt_fix_digits(digits[item_i]) |> 90 | fmt_minus_sign() |> 91 | prefix_equals("*b*", b_lab), 92 | b = item_value |> 93 | fmt_fix_digits(digits[item_i]) |> 94 | fmt_minus_sign() |> 95 | prefix_equals("*b*"), 96 | e = item_value |> 97 | fmt_fix_digits(digits[item_i]) |> 98 | prefix_equals("SE"), 99 | i = item_value |> 100 | fmt_fix_digits(digits[item_i]) |> 101 | fmt_minus_sign() |> 102 | skel_conf_interval_pair() |> 103 | prefix_equals( 104 | paste0(scales::percent(ci_width, accuracy = 1), " CI") 105 | ), 106 | s = item_value |> 107 | fmt_fix_digits(digits[item_i]) |> 108 | fmt_minus_sign() |> 109 | prefix_equals(md_ital(statistic)), 110 | S = item_value |> 111 | round_S(digits[item_i]) |> 112 | fmt_minus_sign() |> 113 | skel_stat_n_value_pair(stat = md_ital(statistic)), 114 | p = item_value |> 115 | fmt_p_value_md(), 116 | NA 117 | ) 118 | } 119 | 120 | paste0(output, collapse = ", ") 121 | } 122 | 123 | # round the first item (degrees of freedom), fix digits on second (statistic) 124 | round_S <- function(x, digits) { 125 | c(round(x[1], digits), fmt_fix_digits(x[2], digits)) 126 | } 127 | 128 | prefix_equals <- function(x, main, sub = NULL) { 129 | if (is.null(sub)) { 130 | paste0(main, " = ", x) 131 | } else { 132 | paste0(main, "", sub, "", " = ", x) 133 | } 134 | } 135 | 136 | md_ital <- function(x) paste0("*", x, "*") 137 | 138 | get_terms <- function(model, effect, terms, ...) { 139 | UseMethod("get_terms") 140 | } 141 | 142 | get_terms.default <- function( 143 | model, 144 | effect, 145 | terms, 146 | ci_width = .95, 147 | ... 148 | ) { 149 | to_get <- str_tokenize(terms) 150 | ci <- "i" %in% to_get 151 | 152 | summary <- broom::tidy( 153 | model, 154 | conf.int = ci, 155 | conf.level = ci_width 156 | ) 157 | 158 | if (!effect %in% summary[["term"]]) { 159 | stop(rlang::as_label(effect), " is not a parameter name") 160 | } 161 | 162 | if ("S" %in% to_get) { 163 | summary[["df"]] <- mod_get_residual_df(model) 164 | } 165 | 166 | summary <- summary[summary$term == effect, ] 167 | 168 | to_get |> 169 | lapply(function(t) get_term_from_broom(t, summary)) |> 170 | stats::setNames(to_get) 171 | } 172 | 173 | 174 | get_terms.glmerMod <- function( 175 | model, 176 | effect, 177 | terms, 178 | ci_width = .95, 179 | ... 180 | ) { 181 | to_get <- str_tokenize(terms) 182 | ci <- "i" %in% to_get 183 | 184 | summary <- broom.mixed::tidy( 185 | model, 186 | conf.int = ci, 187 | conf.level = ci_width 188 | ) 189 | 190 | if (!effect %in% summary[["term"]]) { 191 | stop(rlang::as_label(effect), " is not a parameter name") 192 | } 193 | 194 | if ("S" %in% to_get) { 195 | stop("S is not supported for glmer models") 196 | } 197 | 198 | summary <- summary[summary$term == effect, ] 199 | 200 | to_get |> 201 | lapply(function(t) get_term_from_broom(t, summary)) |> 202 | stats::setNames(to_get) 203 | } 204 | 205 | 206 | get_terms.lmerMod <- function( 207 | model, 208 | effect, 209 | terms, 210 | ci_width = .95, 211 | p_value_method = NULL 212 | ) { 213 | to_get <- str_tokenize(terms) 214 | ci <- "i" %in% to_get 215 | 216 | if (is.null(p_value_method)) { 217 | p_value_method = "kenward" 218 | } 219 | 220 | summary <- broom.mixed::tidy( 221 | model, 222 | effects = "fixed", 223 | conf.int = ci, 224 | conf.level = ci_width 225 | ) 226 | 227 | if (!effect %in% summary[["term"]]) { 228 | stop(rlang::as_label(effect), " is not a parameter name") 229 | } 230 | 231 | compute_p <- any(c("S", "p") %in% to_get) 232 | if (compute_p) { 233 | p_stats <- parameters::p_value(model, method = p_value_method) |> 234 | as.data.frame() |> 235 | rename_names(term = "Parameter", p.value = "p") 236 | 237 | p_stats[["df"]] <- model |> 238 | parameters::dof(method = p_value_method) 239 | p_stats[["std.error"]] <- model |> 240 | parameters::standard_error(method = p_value_method) |> 241 | getElement("SE") 242 | p_stats[["statistic"]] <- lme4::fixef(model) / p_stats[["std.error"]] 243 | 244 | summary[["std.error"]] <- NULL 245 | summary[["statistic"]] <- NULL 246 | summary <- dplyr::left_join(summary, p_stats, by = "term") 247 | } 248 | 249 | summary <- summary[summary$term == effect, ] 250 | 251 | to_get |> 252 | lapply(function(t) get_term_from_broom(t, summary)) |> 253 | stats::setNames(to_get) 254 | } 255 | 256 | 257 | get_term_from_broom <- function(term, summary) { 258 | slist <- as.list(summary) 259 | switch( 260 | term, 261 | b = slist[["estimate"]], 262 | B = slist[["estimate"]], 263 | e = slist[["std.error"]], 264 | s = slist[["statistic"]], 265 | S = c(slist[["df"]], slist[["statistic"]]), 266 | p = slist[["p.value"]], 267 | i = c(slist[["conf.low"]], slist[["conf.high"]]), 268 | NA 269 | ) 270 | } 271 | 272 | mod_get_residual_df <- function(model, ...) UseMethod("mod_get_residual_df") 273 | 274 | mod_get_residual_df.default <- function(model) { 275 | summary <- broom::glance(model) 276 | stopifnot("df.residual" %in% names(summary)) 277 | summary[["df.residual"]] 278 | } 279 | -------------------------------------------------------------------------------- /R/printy-package.R: -------------------------------------------------------------------------------- 1 | #' @keywords internal 2 | "_PACKAGE" 3 | 4 | # The following block is used by usethis to automatically manage 5 | # roxygen namespace tags. Modify with care! 6 | ## usethis namespace: start 7 | ## usethis namespace: end 8 | NULL 9 | -------------------------------------------------------------------------------- /R/skeletons.R: -------------------------------------------------------------------------------- 1 | 2 | #' Skeleton for a confidence interval 3 | #' 4 | #' `skel_conf_interval()` is a vectorized function. Use it to make multiple 5 | #' intervals from, say, data-frame columns. `skel_conf_interval_pair()` is the 6 | #' unvectorized function. Use it to make a single interval from a vector (pair) of two 7 | #' numbers. 8 | #' 9 | #' @details These functions are wrappers around calls to `glue::glue()`. 10 | #' 11 | #' Originally, `skel_conf_interval()` was named `skel_conf_interval_v()`. 12 | #' 13 | #' @param xs a vector of the first elements in the intervals 14 | #' @param ys a vector of the second elements in the intervals 15 | #' @param x a vector of two elements to plug into the confidence interval 16 | #' @param skeleton glue-style format to fill. defaults to `"[{xs}, {ys}]"` for 17 | #' `skel_conf_interval()` and `"[{x[1]}, {x[2]}]"` for 18 | #' `skel_conf_interval_pair()`. 19 | #' @return strings representing confidence intervals 20 | #' @name skel_conf_interval 21 | #' @rdname skel_conf_interval 22 | #' @examples 23 | #' skel_conf_interval(c(.1, .2), c(.3, .4)) 24 | #' skel_conf_interval_pair(c(.1, .3)) 25 | NULL 26 | 27 | #' @rdname skel_conf_interval 28 | #' @export 29 | skel_conf_interval <- function(xs, ys, skeleton = "[{xs}, {ys}]") { 30 | as.character(glue::glue(skeleton)) 31 | } 32 | 33 | #' @rdname skel_conf_interval 34 | #' @export 35 | skel_conf_interval_pair <- function(x, skeleton = "[{x[1]}, {x[2]}]") { 36 | stopifnot(length(x) == 2) 37 | as.character(glue::glue(skeleton)) 38 | } 39 | 40 | #' Skeleton for a range of numbers 41 | #' 42 | #' `skel_range()` is a vectorized function. Use it to make multiple range from, 43 | #' say, data-frame columns. `skel_range_pair()` is the unvectorized function. 44 | #' Use it to make a single range from a vector (pair) of two numbers. 45 | #' 46 | #' @details These functions are wrappers around calls to `glue::glue()`. 47 | #' 48 | #' @param xs a vector of the first elements in the range 49 | #' @param ys a vector of the second elements in the range 50 | #' @param x a vector of two elements to plug into the range 51 | #' @param skeleton glue-style format to fill. defaults to `"{xs}–{ys}"` for 52 | #' `skel_range()` and `"{x[1]}–{x[2]}"` for 53 | #' `skel_range_pair()`. 54 | #' @return strings representing ranges 55 | #' @name skel_range 56 | #' @rdname skel_range 57 | #' @examples 58 | #' skel_range(c(.1, .2), c(.3, .4)) 59 | #' skel_range_pair(c(.1, .3)) 60 | NULL 61 | 62 | 63 | #' Skeleton for ranges 64 | #' 65 | #' `skel_range()` is a vectorized function. Use it to make multiple range from, 66 | #' say, data-frame columns. `skel_range_pair()` is the unvectorized function. 67 | #' Use it to make a single range from a vector (pair) of two numbers. 68 | #' 69 | #' @details These functions are wrappers around calls to `glue::glue()`. 70 | #' 71 | #' @param xs a vector of the first elements in the range 72 | #' @param ys a vector of the second elements in the range 73 | #' @param x a vector of two elements to plug into the range 74 | #' @param skeleton glue-style format to fill. defaults to `"{xs}–{ys}"` for 75 | #' `skel_range()` and `"{x[1]}–{x[2]}"` for 76 | #' `skel_range_pair()`. 77 | #' @return strings representing ranges 78 | #' @name skel_range 79 | #' @rdname skel_range 80 | #' @examples 81 | #' skel_range(c(.1, .2), c(.3, .4)) 82 | #' skel_range_pair(c(.1, .3)) 83 | NULL 84 | 85 | #' @rdname skel_range 86 | #' @export 87 | skel_range_pair <- function(x, skeleton = "{x[1]}–{x[2]}") { 88 | stopifnot(length(x) == 2) 89 | as.character(glue::glue(skeleton)) 90 | } 91 | 92 | #' @rdname skel_range 93 | #' @export 94 | skel_range <- function(xs, ys, skeleton = "{xs}–{ys}") { 95 | as.character(glue::glue(skeleton)) 96 | } 97 | 98 | 99 | #' Skeletons for inline stats 100 | #' 101 | #' @param xs a vector of the values to plug into the skeleton 102 | #' @param skeleton glue-style format to fill. defaults to `"SE = {x}"` for 103 | #' `skel_se()` and `"95% CI = {x}"` for `skel_ci()`. 104 | #' @return strings with stats plugged in. 105 | #' @export 106 | #' @name skel_se 107 | #' @rdname skel_se 108 | skel_se <- function(x, skeleton = "SE = {x}") { 109 | as.character(glue::glue(skeleton)) 110 | } 111 | 112 | 113 | #' @param ci_width width of the confidence interval to report. Defaults to 114 | #' `"95"`. 115 | #' @rdname skel_se 116 | #' @export 117 | skel_ci <- function( 118 | x, 119 | ci_width = "95", 120 | skeleton = "{ci_width}% CI = {x}" 121 | ) { 122 | as.character(glue::glue(skeleton)) 123 | } 124 | 125 | 126 | #' Skeleton for t-statistic-like functions 127 | #' 128 | #' This skeleton handles formats like t-statistics (`t(df) = value`) or 129 | #' correlations (`r(df) = value`). 130 | #' 131 | #' @param x a two-element vector where the first number is the argument to the 132 | #' statistical function and the second is its value. 133 | #' @param stat symbol for the statistic. defaults to `"t"`. 134 | #' @param skeleton glue-style format to fill. defaults to 135 | #' `"{stat}({x[1]}) = {x[2]}"`. 136 | #' @return the formatted string 137 | #' @rdname skel_stat_n_value_pair 138 | #' @export 139 | skel_stat_n_value_pair <- function( 140 | x, 141 | stat = "t", 142 | skeleton = "{stat}({x[1]}) = {x[2]}" 143 | ) { 144 | stopifnot(length(x) == 2) 145 | as.character(glue::glue(skeleton)) 146 | } 147 | -------------------------------------------------------------------------------- /R/split.R: -------------------------------------------------------------------------------- 1 | #' Split a dataframe into a list of (lists of ...) dataframes 2 | #' 3 | #' This function is a streamlined, recursive version of 4 | #' [`split()`][base::split()]. 5 | #' 6 | #' @param .data a dataframe 7 | #' @param ... (unquoted) names of columns to split by 8 | #' 9 | #' @return a list of dataframes when splitting by a single variable, a list of 10 | #' lists of dataframes when splitting by 2 variables, and so on. 11 | #' @export 12 | #' 13 | #' @examples 14 | #' # some kind of 2 by 2 design 15 | #' df <- data.frame( 16 | #' x = c(1, 2, 3, 4, 5, 6, 7, 8), 17 | #' time = c(1, 1, 2, 2, 1, 1, 2, 2), 18 | #' group = c("a", "a", "a", "a", "b", "b", "b", "b") 19 | #' ) 20 | #' 21 | #' super_split(df, group) 22 | #' 23 | #' super_split(df, time) 24 | #' 25 | #' # split by group and then split each of those by time 26 | #' super_split(df, group, time) 27 | super_split <- function(.data, ...) { 28 | dots <- rlang::enquos(...) 29 | for (var in seq_along(dots)) { 30 | var_name <- rlang::as_name(dots[[var]]) 31 | .data <- purrr::map_depth( 32 | .x = .data, 33 | .depth = var - 1, 34 | .f = function(xs) split(xs, xs[var_name]) 35 | ) 36 | } 37 | .data 38 | } 39 | -------------------------------------------------------------------------------- /R/stringr-like.R: -------------------------------------------------------------------------------- 1 | #' Break a string to individual (character) tokens 2 | #' 3 | #' The usual job of this function is to break a string into a vector of 4 | #' individual characters, but it can break strings using other separators. 5 | #' 6 | #' @param string a character vector of strings to break 7 | #' @param pattern pattern to use for splitting. Defaults to `NULL` so that 8 | #' strings are split into individual characters. 9 | #' @return a single character vector of the tokens 10 | #' @export 11 | #' @examples 12 | #' str_tokenize(c("abc", "de")) 13 | #' str_tokenize(c("abc de fg"), " ") 14 | str_tokenize <- function(string, pattern = NULL) { 15 | unlist(strsplit(string, split = pattern, perl = TRUE)) 16 | } 17 | 18 | #' Replace strings that duplicate the previous string 19 | #' 20 | #' The common use of this function to clean up columns in a presentation-quality 21 | #' table. 22 | #' @param string a character vector 23 | #' @param replacement text to use as a replacement for duplicated values 24 | #' @return a single character vector with immediately repeating items replaced 25 | #' @export 26 | #' @examples 27 | #' str_replace_same_as_previous( 28 | #' c("a", "a", "a", "b", "b", "c", "d", "d"), 29 | #' "" 30 | #' ) 31 | str_replace_same_as_previous <- function(string, replacement) { 32 | string[is_same_as_previous(string)] <- replacement 33 | string 34 | } 35 | 36 | # Is x[n] the same as x[n-1] 37 | is_same_as_previous <- function(xs) { 38 | same_as_previous <- xs == dplyr::lag(xs) 39 | 40 | if (length(xs) > 0) { 41 | # Overwrite NA (first lag) from lag(xs) 42 | same_as_previous[1] <- FALSE 43 | } 44 | 45 | same_as_previous 46 | } 47 | -------------------------------------------------------------------------------- /R/utils-dplyr.R: -------------------------------------------------------------------------------- 1 | 2 | 3 | unselect_names <- function(data, ...) { 4 | dplyr::select(data, -dplyr::all_of(c(...))) 5 | } 6 | 7 | rename_names <- function(data, ...) { 8 | dplyr::rename(data, dplyr::all_of(c(...))) 9 | } 10 | -------------------------------------------------------------------------------- /R/utils-tidy-eval.R: -------------------------------------------------------------------------------- 1 | #' Tidy eval helpers 2 | #' 3 | #' @description 4 | #' 5 | #' * \code{\link[rlang]{sym}()} creates a symbol from a string and 6 | #' \code{\link[rlang:sym]{syms}()} creates a list of symbols from a 7 | #' character vector. 8 | #' 9 | #' * \code{\link[rlang:nse-defuse]{enquo}()} and 10 | #' \code{\link[rlang:nse-defuse]{enquos}()} delay the execution of one or 11 | #' several function arguments. \code{enquo()} returns a single quoted 12 | #' expression, which is like a blueprint for the delayed computation. 13 | #' \code{enquos()} returns a list of such quoted expressions. 14 | #' 15 | #' * \code{\link[rlang:nse-defuse]{expr}()} quotes a new expression _locally_. It 16 | #' is mostly useful to build new expressions around arguments 17 | #' captured with [enquo()] or [enquos()]: 18 | #' \code{expr(mean(!!enquo(arg), na.rm = TRUE))}. 19 | #' 20 | #' * \code{\link[rlang]{as_name}()} transforms a quoted variable name 21 | #' into a string. Supplying something else than a quoted variable 22 | #' name is an error. 23 | #' 24 | #' That's unlike \code{\link[rlang]{as_label}()} which also returns 25 | #' a single string but supports any kind of R object as input, 26 | #' including quoted function calls and vectors. Its purpose is to 27 | #' summarise that object into a single label. That label is often 28 | #' suitable as a default name. 29 | #' 30 | #' If you don't know what a quoted expression contains (for instance 31 | #' expressions captured with \code{enquo()} could be a variable 32 | #' name, a call to a function, or an unquoted constant), then use 33 | #' \code{as_label()}. If you know you have quoted a simple variable 34 | #' name, or would like to enforce this, use \code{as_name()}. 35 | #' 36 | #' To learn more about tidy eval and how to use these tools, visit 37 | #' \url{https://tidyeval.tidyverse.org} and the 38 | #' \href{https://adv-r.hadley.nz/metaprogramming.html}{Metaprogramming 39 | #' section} of \href{https://adv-r.hadley.nz}{Advanced R}. 40 | #' 41 | #' @md 42 | #' @name tidyeval 43 | #' @keywords internal 44 | #' @importFrom rlang expr enquo enquos sym syms .data := as_name as_label 45 | NULL 46 | -------------------------------------------------------------------------------- /README.Rmd: -------------------------------------------------------------------------------- 1 | --- 2 | output: 3 | github_document: 4 | default 5 | --- 6 | 7 | 8 | 9 | ```{r, include = FALSE} 10 | library(dplyr, warn.conflicts = FALSE) 11 | library(lme4) 12 | 13 | knitr::opts_chunk$set( 14 | collapse = TRUE, 15 | comment = "#>", 16 | fig.path = "fig/README-" 17 | ) 18 | ``` 19 | 20 | # printy 21 | 22 | Over the years, I've written a lot of one-off functions for formatting numbers 23 | in RMarkdown documents. This packages collects them in a single location. 24 | 25 | ## Installation 📚 26 | 27 | You can install printy from github with: 28 | 29 | ```{r gh-installation, eval = FALSE} 30 | # install.packages("remotes") 31 | remotes::install_github("tjmahr/printy") 32 | ``` 33 | 34 | ## Formatters ✍ 35 | 36 | `fmt_fix_digits()` prints a number with n digits of precision. R numbers lose 37 | precision when converted to strings. This function converts the numbers to 38 | strings and keeps precision. (It's a wrapper for `sprintf()`.) 39 | 40 | ```{r fix-digits} 41 | library(dplyr) 42 | library(printy) 43 | test_cor <- cor(mtcars[, 1:4]) 44 | 45 | # Typical loss of trailing zeroes 46 | test_cor[1:4, 3] |> round(2) |> as.character() 47 | 48 | test_cor[1:4, 3] |> fmt_fix_digits(2) 49 | ``` 50 | 51 | `fmt_leading_zero()` removes a leading zero on numbers that are bounded between 52 | −1 and 1, such as correlations or *p*-values. 53 | 54 | ```{r leading-zero} 55 | fmt_leading_zero(c(-0.3, 0.4, 1)) 56 | ``` 57 | 58 | `fmt_minus_sign()` formats negative numbers with a minus sign. 59 | 60 | ```{r minus-sign} 61 | fmt_minus_sign(c(1, 2, -3, -0.4, -pi)) 62 | ``` 63 | 64 | Putting it all together: Print a correlation matrix with 2 digits, no leading 65 | zero and with minus signs. 66 | 67 | ```{r} 68 | fmt_correlation <- function(xs, digits = 2) { 69 | xs |> fmt_fix_digits(digits) |> fmt_leading_zero() |> fmt_minus_sign() 70 | } 71 | 72 | test_cor |> 73 | as.data.frame() |> 74 | tibble::rownames_to_column(".rowname") |> 75 | tibble::as_tibble() |> 76 | mutate( 77 | across(-.rowname, fmt_correlation) 78 | ) |> 79 | rename(` ` = .rowname) |> 80 | knitr::kable(align = "lrrrr") 81 | ``` 82 | 83 | ### *p*-values 🎣 84 | 85 | `fmt_p_value()` formats *p*-values with *n* digits of precision, with no leading 86 | zero, and with very small values being printed with a `<` sign. 87 | 88 | ```{r} 89 | p <- c(1, 0.1, 0.01, 0.001, 0.0001) 90 | fmt_p_value(p, digits = 2) 91 | fmt_p_value(p, digits = 3) 92 | ``` 93 | 94 | `fmt_p_value_md()` formats *p*-values in markdown with nice defaults. 95 | 96 | * Use 3 digits of precision for values less than .06 97 | * Otherwise, use 2 digits of precision. 98 | * Include *p* in markdown 99 | 100 | ```{r} 101 | p <- c(1, 0.1, 0.06, 0.059, 0.051, 0.01, 0.001, 0.0001) 102 | fmt_p_value_md(p) 103 | ``` 104 | 105 | These render as: `r paste0(fmt_p_value_md(p), collapse = ", ")`. 106 | 107 | 108 | ### Experimental formatters 🧪 109 | 110 | `fmt_effect_md()` is an experimental function for getting model effects 111 | formatted in markdown. You give the function a model, an effect and a string 112 | listing the quantities you want. 113 | 114 | ```{r} 115 | model <- lm(breaks ~ wool * tension, warpbreaks) 116 | summary(model) 117 | ``` 118 | 119 | ```{r} 120 | # default to: b (beta), e (error), s (statistic), p (p value) 121 | fmt_effect_md(model, "woolB", "besp") 122 | ``` 123 | 124 | `r fmt_effect_md(model, "woolB", "besp")` 125 | 126 | ```{r} 127 | # Just a subset of them 128 | fmt_effect_md(model, "woolB", terms = "bp") 129 | ``` 130 | 131 | `r fmt_effect_md(model, "woolB", terms = "bp")` 132 | 133 | ```{r} 134 | # B for labeled b 135 | fmt_effect_md(model, "woolB", terms = "Bp", b_lab = "Wool B") 136 | ``` 137 | 138 | `r fmt_effect_md(model, "woolB", terms = "Bp", b_lab = "Wool B")` 139 | 140 | ```{r bi} 141 | # i for interval 142 | fmt_effect_md(model, "woolB", terms = "bi") 143 | ``` 144 | 145 | `r fmt_effect_md(model, "woolB", terms = "bi")` 146 | 147 | ```{r bSp} 148 | # S for statistic with df 149 | fmt_effect_md(model, "woolB", terms = "bSp") 150 | ``` 151 | 152 | `r fmt_effect_md(model, "woolB", terms = "bSp")` 153 | 154 | ```{r} 155 | # extra digits (except for p-values; those go through `fmt_p_value_md()`) 156 | fmt_effect_md(model, "woolB", terms = "bep", digits = 6) 157 | ``` 158 | 159 | `r fmt_effect_md(model, "woolB", terms = "bep", digits = 6)` 160 | 161 | These are the currently supported models: 162 | 163 | - `lm()` 164 | - `lme4::lmer()` 165 | 166 | For lme4 models, Wald confidence intervals are provided. For *p*-values, the 167 | Kenwood--Roger approximation for the degrees of freedom is used by default. We 168 | can also choose a [method supported by the parameters 169 | package](https://easystats.github.io/parameters/reference/p_value.lmerMod.html). 170 | 171 | ```{r} 172 | library(lme4) 173 | data(Machines, package = "nlme") 174 | 175 | m <- lmer(score ~ 1 + Machine + (Machine | Worker), data = Machines) 176 | 177 | # Default is Kenward 178 | fmt_effect_md(m, "MachineB", terms = "beSp") 179 | fmt_effect_md(m, "MachineB", terms = "beSp", p_value_method = "kenward") 180 | 181 | # Note residual degrees of freedom for Wald 182 | fmt_effect_md(m, "MachineB", terms = "beSp", p_value_method = "wald") 183 | 184 | # This example doesn't find differences between Satterthwaite and Kenward 185 | fmt_effect_md(m, "MachineB", terms = "beSp", p_value_method = "satterthwaite") 186 | ``` 187 | 188 | We can also format effects from `glmer()` models. `"S"` is not supported because 189 | the model summary uses *z* statistics, not *t* statistics. 190 | 191 | ```{r, error = TRUE} 192 | gm1 <- glmer( 193 | cbind(incidence, size - incidence) ~ period + (1 | herd), 194 | data = cbpp, 195 | family = binomial 196 | ) 197 | 198 | round(coef(summary(gm1)), 3) 199 | 200 | fmt_effect_md(gm1, "period2", terms = "bespi") 201 | 202 | # Don't use S here 203 | fmt_effect_md(gm1, "period2", terms = "beSp") 204 | ``` 205 | 206 | 207 | 208 | Skeletons 🦴 209 | ----------------------------------------------------------------------- 210 | 211 | I use `fmt_` for formatting functions. The other convention in the package is 212 | `skel_` to plug values into a formatting skeleton. 213 | 214 | `skel_conf_interval_pair()` creates a confidence interval from two numbers. 215 | 216 | ```{r} 217 | skel_conf_interval_pair(c(1, 2)) 218 | ``` 219 | 220 | `skel_conf_interval()` is the vectorized version. It is suitable for working 221 | on columns of numbers. 222 | 223 | ```{r} 224 | model <- lm(breaks ~ wool * tension, warpbreaks) 225 | 226 | ci_starts <- confint(model)[, 1] |> 227 | fmt_fix_digits(2) |> 228 | fmt_minus_sign() 229 | 230 | ci_ends <- confint(model)[, 2] |> 231 | fmt_fix_digits(2) |> 232 | fmt_minus_sign() 233 | 234 | skel_conf_interval(ci_starts, ci_ends) 235 | ``` 236 | 237 | `skel_stat_n_value_pair()` creates *t*-test-like or correlation-like statistic 238 | from a vector of two numbers. 239 | 240 | ```{r} 241 | skel_stat_n_value_pair(c("20", "2.0")) 242 | skel_stat_n_value_pair(c("39", ".98"), stat = "*r*") 243 | ``` 244 | 245 | `skel_se()` and `skel_ci()` are shorthand functions to help with inline 246 | reporting. 247 | 248 | ```{r} 249 | skel_se(c(10, 4)) 250 | 251 | skel_ci(c("[1, 2]")) 252 | 253 | skel_ci(c("[1, 2]"), ci_width = 90) 254 | ``` 255 | 256 | 257 | ## Formatting tables from lme4 models 🖇 258 | 259 | One thing I've had to do a lot is summarize mixed effects models fit with lme4. 260 | This package provides `pretty_lme4_ranefs()` which creates a dataframe random 261 | effect variances and covariances like those printed by `summary()`. 262 | 263 | For example, we can fit the model. 264 | 265 | ```{r} 266 | library(lme4) 267 | model <- lmer(Reaction ~ Days + (Days | Subject), sleepstudy) 268 | summary(model) 269 | ``` 270 | 271 | `pretty_lme4_ranefs()` creates the following dataframe. 272 | 273 | ```{r} 274 | pretty_lme4_ranefs(model) 275 | ``` 276 | 277 | Which in markdown renders as 278 | 279 | ```{r} 280 | knitr::kable( 281 | pretty_lme4_ranefs(model), 282 | align = c("l", "l", "r", "r", "r") 283 | ) 284 | ``` 285 | 286 | Here's a dumb model with a lot going on in the random effects. 287 | 288 | ```{r, warning = FALSE} 289 | model <- lmer(mpg ~ wt * hp + (drat | gear) + (hp * cyl | am), mtcars) 290 | model 291 | 292 | knitr::kable( 293 | pretty_lme4_ranefs(model), 294 | align = c("l", "l", "r", "r", "r", "r", "r", "r", "r") 295 | ) 296 | ``` 297 | 298 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | # printy 5 | 6 | Over the years, I’ve written a lot of one-off functions for formatting 7 | numbers in RMarkdown documents. This packages collects them in a single 8 | location. 9 | 10 | ## Installation 📚 11 | 12 | You can install printy from github with: 13 | 14 | ``` r 15 | # install.packages("remotes") 16 | remotes::install_github("tjmahr/printy") 17 | ``` 18 | 19 | ## Formatters ✍ 20 | 21 | `fmt_fix_digits()` prints a number with n digits of precision. R numbers 22 | lose precision when converted to strings. This function converts the 23 | numbers to strings and keeps precision. (It’s a wrapper for 24 | `sprintf()`.) 25 | 26 | ``` r 27 | library(dplyr) 28 | library(printy) 29 | test_cor <- cor(mtcars[, 1:4]) 30 | 31 | # Typical loss of trailing zeroes 32 | test_cor[1:4, 3] |> round(2) |> as.character() 33 | #> [1] "-0.85" "0.9" "1" "0.79" 34 | 35 | test_cor[1:4, 3] |> fmt_fix_digits(2) 36 | #> [1] "-0.85" "0.90" "1.00" "0.79" 37 | ``` 38 | 39 | `fmt_leading_zero()` removes a leading zero on numbers that are bounded 40 | between −1 and 1, such as correlations or *p*-values. 41 | 42 | ``` r 43 | fmt_leading_zero(c(-0.3, 0.4, 1)) 44 | #> [1] "-.3" ".4" "1" 45 | ``` 46 | 47 | `fmt_minus_sign()` formats negative numbers with a minus sign. 48 | 49 | ``` r 50 | fmt_minus_sign(c(1, 2, -3, -0.4, -pi)) 51 | #> [1] "1" "2" 52 | #> [3] "−3" "−0.4" 53 | #> [5] "−3.14159265358979" 54 | ``` 55 | 56 | Putting it all together: Print a correlation matrix with 2 digits, no 57 | leading zero and with minus signs. 58 | 59 | ``` r 60 | fmt_correlation <- function(xs, digits = 2) { 61 | xs |> fmt_fix_digits(digits) |> fmt_leading_zero() |> fmt_minus_sign() 62 | } 63 | 64 | test_cor |> 65 | as.data.frame() |> 66 | tibble::rownames_to_column(".rowname") |> 67 | tibble::as_tibble() |> 68 | mutate( 69 | across(-.rowname, fmt_correlation) 70 | ) |> 71 | rename(` ` = .rowname) |> 72 | knitr::kable(align = "lrrrr") 73 | ``` 74 | 75 | | | mpg | cyl | disp | hp | 76 | |:-----|-----:|-----:|-----:|-----:| 77 | | mpg | 1.00 | −.85 | −.85 | −.78 | 78 | | cyl | −.85 | 1.00 | .90 | .83 | 79 | | disp | −.85 | .90 | 1.00 | .79 | 80 | | hp | −.78 | .83 | .79 | 1.00 | 81 | 82 | ### *p*-values 🎣 83 | 84 | `fmt_p_value()` formats *p*-values with *n* digits of precision, with no 85 | leading zero, and with very small values being printed with a `<` sign. 86 | 87 | ``` r 88 | p <- c(1, 0.1, 0.01, 0.001, 0.0001) 89 | fmt_p_value(p, digits = 2) 90 | #> [1] "1.00" ".10" ".01" "< .01" "< .01" 91 | fmt_p_value(p, digits = 3) 92 | #> [1] "1.000" ".100" ".010" ".001" "< .001" 93 | ``` 94 | 95 | `fmt_p_value_md()` formats *p*-values in markdown with nice defaults. 96 | 97 | - Use 3 digits of precision for values less than .06 98 | - Otherwise, use 2 digits of precision. 99 | - Include *p* in markdown 100 | 101 | ``` r 102 | p <- c(1, 0.1, 0.06, 0.059, 0.051, 0.01, 0.001, 0.0001) 103 | fmt_p_value_md(p) 104 | #> [1] "*p* > .99" "*p* = .10" "*p* = .06" "*p* = .059" 105 | #> [5] "*p* = .051" "*p* = .010" "*p* = .001" "*p* < .001" 106 | ``` 107 | 108 | These render as: *p* \> .99, *p* = .10, *p* = .06, *p* = .059, *p* = 109 | .051, *p* = .010, *p* = .001, *p* \< .001. 110 | 111 | ### Experimental formatters 🧪 112 | 113 | `fmt_effect_md()` is an experimental function for getting model effects 114 | formatted in markdown. You give the function a model, an effect and a 115 | string listing the quantities you want. 116 | 117 | ``` r 118 | model <- lm(breaks ~ wool * tension, warpbreaks) 119 | summary(model) 120 | #> 121 | #> Call: 122 | #> lm(formula = breaks ~ wool * tension, data = warpbreaks) 123 | #> 124 | #> Residuals: 125 | #> Min 1Q Median 3Q Max 126 | #> -19.5556 -6.8889 -0.6667 7.1944 25.4444 127 | #> 128 | #> Coefficients: 129 | #> Estimate Std. Error t value Pr(>|t|) 130 | #> (Intercept) 44.556 3.647 12.218 2.43e-16 *** 131 | #> woolB -16.333 5.157 -3.167 0.002677 ** 132 | #> tensionM -20.556 5.157 -3.986 0.000228 *** 133 | #> tensionH -20.000 5.157 -3.878 0.000320 *** 134 | #> woolB:tensionM 21.111 7.294 2.895 0.005698 ** 135 | #> woolB:tensionH 10.556 7.294 1.447 0.154327 136 | #> --- 137 | #> Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 138 | #> 139 | #> Residual standard error: 10.94 on 48 degrees of freedom 140 | #> Multiple R-squared: 0.3778, Adjusted R-squared: 0.3129 141 | #> F-statistic: 5.828 on 5 and 48 DF, p-value: 0.0002772 142 | ``` 143 | 144 | ``` r 145 | # default to: b (beta), e (error), s (statistic), p (p value) 146 | fmt_effect_md(model, "woolB", "besp") 147 | #> [1] "*b* = −16.33, SE = 5.16, *t* = −3.17, *p* = .003" 148 | ``` 149 | 150 | *b* = −16.33, SE = 5.16, *t* = −3.17, *p* = .003 151 | 152 | ``` r 153 | # Just a subset of them 154 | fmt_effect_md(model, "woolB", terms = "bp") 155 | #> [1] "*b* = −16.33, *p* = .003" 156 | ``` 157 | 158 | *b* = −16.33, *p* = .003 159 | 160 | ``` r 161 | # B for labeled b 162 | fmt_effect_md(model, "woolB", terms = "Bp", b_lab = "Wool B") 163 | #> [1] "*b*Wool B = −16.33, *p* = .003" 164 | ``` 165 | 166 | *b*Wool B = −16.33, *p* = .003 167 | 168 | ``` r 169 | # i for interval 170 | fmt_effect_md(model, "woolB", terms = "bi") 171 | #> [1] "*b* = −16.33, 95% CI = [−26.70, −5.96]" 172 | ``` 173 | 174 | *b* = −16.33, 95% CI = \[−26.70, −5.96\] 175 | 176 | ``` r 177 | # S for statistic with df 178 | fmt_effect_md(model, "woolB", terms = "bSp") 179 | #> [1] "*b* = −16.33, *t*(48) = −3.17, *p* = .003" 180 | ``` 181 | 182 | *b* = −16.33, *t*(48) = −3.17, *p* = .003 183 | 184 | ``` r 185 | # extra digits (except for p-values; those go through `fmt_p_value_md()`) 186 | fmt_effect_md(model, "woolB", terms = "bep", digits = 6) 187 | #> [1] "*b* = −16.333333, SE = 5.157299, *p* = .003" 188 | ``` 189 | 190 | *b* = −16.333333, SE = 5.157299, *p* = .003 191 | 192 | These are the currently supported models: 193 | 194 | - `lm()` 195 | - `lme4::lmer()` 196 | 197 | For lme4 models, Wald confidence intervals are provided. For *p*-values, 198 | the Kenwood–Roger approximation for the degrees of freedom is used by 199 | default. We can also choose a [method supported by the parameters 200 | package](https://easystats.github.io/parameters/reference/p_value.lmerMod.html). 201 | 202 | ``` r 203 | library(lme4) 204 | data(Machines, package = "nlme") 205 | 206 | m <- lmer(score ~ 1 + Machine + (Machine | Worker), data = Machines) 207 | 208 | # Default is Kenward 209 | fmt_effect_md(m, "MachineB", terms = "beSp") 210 | #> [1] "*b* = 7.97, SE = 2.42, *t*(5) = 3.29, *p* = .022" 211 | fmt_effect_md(m, "MachineB", terms = "beSp", p_value_method = "kenward") 212 | #> [1] "*b* = 7.97, SE = 2.42, *t*(5) = 3.29, *p* = .022" 213 | 214 | # Note residual degrees of freedom for Wald 215 | fmt_effect_md(m, "MachineB", terms = "beSp", p_value_method = "wald") 216 | #> [1] "*b* = 7.97, SE = 2.42, *t*(44) = 3.29, *p* = .002" 217 | 218 | # This example doesn't find differences between Satterthwaite and Kenward 219 | fmt_effect_md(m, "MachineB", terms = "beSp", p_value_method = "satterthwaite") 220 | #> [1] "*b* = 7.97, SE = 2.42, *t*(5) = 3.29, *p* = .022" 221 | ``` 222 | 223 | We can also format effects from `glmer()` models. `"S"` is not supported 224 | because the model summary uses *z* statistics, not *t* statistics. 225 | 226 | ``` r 227 | gm1 <- glmer( 228 | cbind(incidence, size - incidence) ~ period + (1 | herd), 229 | data = cbpp, 230 | family = binomial 231 | ) 232 | 233 | round(coef(summary(gm1)), 3) 234 | #> Estimate Std. Error z value Pr(>|z|) 235 | #> (Intercept) -1.398 0.231 -6.048 0.000 236 | #> period2 -0.992 0.303 -3.272 0.001 237 | #> period3 -1.128 0.323 -3.495 0.000 238 | #> period4 -1.580 0.422 -3.743 0.000 239 | 240 | fmt_effect_md(gm1, "period2", terms = "bespi") 241 | #> [1] "*b* = −0.99, SE = 0.30, *z* = −3.27, *p* = .001, 95% CI = [−1.59, −0.40]" 242 | 243 | # Don't use S here 244 | fmt_effect_md(gm1, "period2", terms = "beSp") 245 | #> Error in get_terms.glmerMod(model, effect, terms, ci_width = ci_width, : S is not supported for glmer models 246 | ``` 247 | 248 | ## Skeletons 🦴 249 | 250 | I use `fmt_` for formatting functions. The other convention in the 251 | package is `skel_` to plug values into a formatting skeleton. 252 | 253 | `skel_conf_interval_pair()` creates a confidence interval from two 254 | numbers. 255 | 256 | ``` r 257 | skel_conf_interval_pair(c(1, 2)) 258 | #> [1] "[1, 2]" 259 | ``` 260 | 261 | `skel_conf_interval()` is the vectorized version. It is suitable for 262 | working on columns of numbers. 263 | 264 | ``` r 265 | model <- lm(breaks ~ wool * tension, warpbreaks) 266 | 267 | ci_starts <- confint(model)[, 1] |> 268 | fmt_fix_digits(2) |> 269 | fmt_minus_sign() 270 | 271 | ci_ends <- confint(model)[, 2] |> 272 | fmt_fix_digits(2) |> 273 | fmt_minus_sign() 274 | 275 | skel_conf_interval(ci_starts, ci_ends) 276 | #> [1] "[37.22, 51.89]" "[−26.70, −5.96]" 277 | #> [3] "[−30.93, −10.19]" "[−30.37, −9.63]" 278 | #> [5] "[6.45, 35.78]" "[−4.11, 25.22]" 279 | ``` 280 | 281 | `skel_stat_n_value_pair()` creates *t*-test-like or correlation-like 282 | statistic from a vector of two numbers. 283 | 284 | ``` r 285 | skel_stat_n_value_pair(c("20", "2.0")) 286 | #> [1] "t(20) = 2.0" 287 | skel_stat_n_value_pair(c("39", ".98"), stat = "*r*") 288 | #> [1] "*r*(39) = .98" 289 | ``` 290 | 291 | `skel_se()` and `skel_ci()` are shorthand functions to help with inline 292 | reporting. 293 | 294 | ``` r 295 | skel_se(c(10, 4)) 296 | #> [1] "SE = 10" "SE = 4" 297 | 298 | skel_ci(c("[1, 2]")) 299 | #> [1] "95% CI = [1, 2]" 300 | 301 | skel_ci(c("[1, 2]"), ci_width = 90) 302 | #> [1] "90% CI = [1, 2]" 303 | ``` 304 | 305 | ## Formatting tables from lme4 models 🖇 306 | 307 | One thing I’ve had to do a lot is summarize mixed effects models fit 308 | with lme4. This package provides `pretty_lme4_ranefs()` which creates a 309 | dataframe random effect variances and covariances like those printed by 310 | `summary()`. 311 | 312 | For example, we can fit the model. 313 | 314 | ``` r 315 | library(lme4) 316 | model <- lmer(Reaction ~ Days + (Days | Subject), sleepstudy) 317 | summary(model) 318 | #> Linear mixed model fit by REML ['lmerMod'] 319 | #> Formula: Reaction ~ Days + (Days | Subject) 320 | #> Data: sleepstudy 321 | #> 322 | #> REML criterion at convergence: 1743.6 323 | #> 324 | #> Scaled residuals: 325 | #> Min 1Q Median 3Q Max 326 | #> -3.9536 -0.4634 0.0231 0.4634 5.1793 327 | #> 328 | #> Random effects: 329 | #> Groups Name Variance Std.Dev. Corr 330 | #> Subject (Intercept) 612.10 24.741 331 | #> Days 35.07 5.922 0.07 332 | #> Residual 654.94 25.592 333 | #> Number of obs: 180, groups: Subject, 18 334 | #> 335 | #> Fixed effects: 336 | #> Estimate Std. Error t value 337 | #> (Intercept) 251.405 6.825 36.838 338 | #> Days 10.467 1.546 6.771 339 | #> 340 | #> Correlation of Fixed Effects: 341 | #> (Intr) 342 | #> Days -0.138 343 | ``` 344 | 345 | `pretty_lme4_ranefs()` creates the following dataframe. 346 | 347 | ``` r 348 | pretty_lme4_ranefs(model) 349 | #> Group Parameter Variance SD Correlations   350 | #> 1 Subject (Intercept) 612.10 24.74 1.00   351 | #> 2   Days 35.07 5.92 .07 1.00 352 | #> 3 Residual   654.94 25.59     353 | ``` 354 | 355 | Which in markdown renders as 356 | 357 | ``` r 358 | knitr::kable( 359 | pretty_lme4_ranefs(model), 360 | align = c("l", "l", "r", "r", "r") 361 | ) 362 | ``` 363 | 364 | | Group | Parameter | Variance | SD | Correlations |   | 365 | |:---------|:------------|---------:|------:|-------------:|:-----| 366 | | Subject | (Intercept) | 612.10 | 24.74 | 1.00 |   | 367 | |   | Days | 35.07 | 5.92 | .07 | 1.00 | 368 | | Residual |   | 654.94 | 25.59 |   |   | 369 | 370 | Here’s a dumb model with a lot going on in the random effects. 371 | 372 | ``` r 373 | model <- lmer(mpg ~ wt * hp + (drat | gear) + (hp * cyl | am), mtcars) 374 | #> boundary (singular) fit: see help('isSingular') 375 | model 376 | #> Linear mixed model fit by REML ['lmerMod'] 377 | #> Formula: mpg ~ wt * hp + (drat | gear) + (hp * cyl | am) 378 | #> Data: mtcars 379 | #> REML criterion at convergence: 152.7432 380 | #> Random effects: 381 | #> Groups Name Std.Dev. Corr 382 | #> gear (Intercept) 1.556809 383 | #> drat 0.166292 -1.00 384 | #> am (Intercept) 1.940271 385 | #> hp 0.004055 -0.96 386 | #> cyl 0.456219 -0.98 0.93 387 | #> hp:cyl 0.001508 0.95 -0.94 -0.99 388 | #> Residual 2.113554 389 | #> Number of obs: 32, groups: gear, 3; am, 2 390 | #> Fixed Effects: 391 | #> (Intercept) wt hp wt:hp 392 | #> 48.98745 -7.80904 -0.12118 0.02737 393 | #> optimizer (nloptwrap) convergence code: 0 (OK) ; 0 optimizer warnings; 1 lme4 warnings 394 | 395 | knitr::kable( 396 | pretty_lme4_ranefs(model), 397 | align = c("l", "l", "r", "r", "r", "r", "r", "r", "r") 398 | ) 399 | ``` 400 | 401 | | Group | Parameter | Variance | SD | Correlations |   |   |   | 402 | |:---------|:------------|---------:|-----:|-------------:|-----:|-----:|-----:| 403 | | am | (Intercept) | 3.76 | 1.94 | 1.00 |   |   |   | 404 | |   | hp | 0.00 | 0.00 | −.96 | 1.00 |   |   | 405 | |   | cyl | 0.21 | 0.46 | −.98 | .93 | 1.00 |   | 406 | |   | hp:cyl | 0.00 | 0.00 | .95 | −.94 | −.99 | 1.00 | 407 | | gear | (Intercept) | 2.42 | 1.56 | 1.00 |   |   |   | 408 | |   | drat | 0.03 | 0.17 | −1.00 | 1.00 |   |   | 409 | | Residual |   | 4.47 | 2.11 |   |   |   |   | 410 | -------------------------------------------------------------------------------- /man/fmt_effect_md.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/models.R 3 | \name{fmt_effect_md} 4 | \alias{fmt_effect_md} 5 | \title{Format an effect from a model object in markdown} 6 | \usage{ 7 | fmt_effect_md( 8 | model, 9 | effect, 10 | terms = "besp", 11 | digits = 2, 12 | statistic = NULL, 13 | b_lab = NULL, 14 | ci_width = 0.95, 15 | p_value_method = NULL 16 | ) 17 | } 18 | \arguments{ 19 | \item{model}{a model object} 20 | 21 | \item{effect}{string naming an effect from a model} 22 | 23 | \item{terms}{a string representing the terms about the effect to extract and 24 | format and the order to print the terms. See details below. Defaults to 25 | \code{"besp"} for parameter estimate, standard error, statistic, \emph{p}-value.} 26 | 27 | \item{digits}{a vector of digits to use for non-\emph{p}-value terms. Defaults to 28 | 2 for 2 decimal places of precision for all terms. This argument can be a 29 | vector to set the digits for each term, but in this case, the digits is 30 | still ignored for \emph{p}-values.} 31 | 32 | \item{statistic}{symbol to use for statistic. Defaults to \emph{t} (or \emph{z} in 33 | glmer models).} 34 | 35 | \item{b_lab}{label to print in subscripts after \emph{b} for when \code{"B"} is one of 36 | the terms.} 37 | 38 | \item{ci_width}{width to use for confidence intervals when the term \code{"i"} is 39 | used.} 40 | } 41 | \description{ 42 | Format an effect from a model object in markdown 43 | } 44 | \details{ 45 | Currently only effects fit by \code{\link[stats:lm]{stats::lm()}} and \code{\link[lme4:lmer]{lme4::lmer()}}. 46 | 47 | The supported terms are: 48 | \itemize{ 49 | \item \code{"b"} - parameter estimate (think b for \emph{beta}) 50 | \item \code{"B"} - parameter estimate with a subscript label provided by \code{b_lab} 51 | \item \code{"e"} - standard error 52 | \item \code{"s"} - statistic. The symbol for the statistic is set by 53 | \code{statistic}. The default value is \code{"t"} for a \emph{t}-statistic. Example 54 | output: \emph{t} = 1. 55 | \item \code{"S"} - statistic as in \code{"s"} but with degrees of freedom. Example 56 | output: \emph{t}(12) = 1. 57 | \item \code{"i"} - confidence interval. Width is set by \code{ci_width}. 58 | \item \code{"p"} - \emph{p}-value. The p-value is formatted by \code{\link[=fmt_p_value_md]{fmt_p_value_md()}}. 59 | } 60 | 61 | Degrees of freedom and \emph{p}-values for \code{lmer()} models use the 62 | Kenwood-Rogers approximation provided by \code{\link[parameters:p_value_kenward]{parameters::p_value_kenward()}}. 63 | This computation can take a while. The confidence-interval calculation uses 64 | default confidence interval calculation method used by 65 | \code{\link[broom.mixed:lme4_tidiers]{broom.mixed::tidy.merMod()}}. 66 | } 67 | \examples{ 68 | model <- lm(breaks ~ wool * tension, warpbreaks) 69 | 70 | # default to: b (beta), e (error), s (statistic), p (p value) 71 | fmt_effect_md(model, "woolB", "besp") 72 | 73 | fmt_effect_md(model, "woolB", "Besp", b_lab = "WoolB") 74 | 75 | fmt_effect_md(model, "woolB", "i") 76 | } 77 | -------------------------------------------------------------------------------- /man/fmt_fix_digits.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/formatters.R 3 | \name{fmt_fix_digits} 4 | \alias{fmt_fix_digits} 5 | \title{Format a number with a fixed number of digits} 6 | \usage{ 7 | fmt_fix_digits(xs, digits = 2) 8 | } 9 | \arguments{ 10 | \item{xs}{a vector of numbers or a character vector representing numbers} 11 | 12 | \item{digits}{number of digits of precision} 13 | } 14 | \description{ 15 | Format a number with a fixed number of digits 16 | } 17 | \examples{ 18 | # what we want to avoid 19 | as.character(round(c(.4001, .1000, .5500), 2)) 20 | 21 | fmt_fix_digits(c(.4001, .1000, .5500), 1) 22 | fmt_fix_digits(c(.4001, .1000, .5500), 2) 23 | fmt_fix_digits(c(.4001, .1000, .5500), 3) 24 | } 25 | -------------------------------------------------------------------------------- /man/fmt_leading_zero.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/formatters.R 3 | \name{fmt_leading_zero} 4 | \alias{fmt_leading_zero} 5 | \title{Format numbers to remove leading zeros} 6 | \usage{ 7 | fmt_leading_zero(xs) 8 | } 9 | \arguments{ 10 | \item{xs}{a vector of numbers or a character vector representing numbers} 11 | } 12 | \value{ 13 | the vector with leading zeros removed. This function returns a 14 | warning if any of the values have an absolute value greater than 1. 15 | } 16 | \description{ 17 | Format numbers to remove leading zeros 18 | } 19 | \details{ 20 | APA format says that values that are bounded between [-1, 1] 21 | should not be formatted with a leading zero. Common examples would be 22 | correlations, proportions, probabilities and p-values. Why print the digit 23 | if it's almost never used? 24 | 25 | Zeros are printed to match the precision of the most precise number. For 26 | example, \code{c(0, 0.111)} becomes \code{c(.000, .111)} 27 | } 28 | \examples{ 29 | fmt_leading_zero(c(0, 0.111)) 30 | fmt_leading_zero(c(0.99, -0.9, -0.0)) 31 | } 32 | -------------------------------------------------------------------------------- /man/fmt_minus_sign.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/formatters.R 3 | \name{fmt_minus_sign} 4 | \alias{fmt_minus_sign} 5 | \title{Format negative numbers with a minus sign} 6 | \usage{ 7 | fmt_minus_sign(xs) 8 | } 9 | \arguments{ 10 | \item{xs}{a vector of numbers or a character vector representing numbers} 11 | } 12 | \value{ 13 | the vector with leading hyphens replaced with HTML minus signs 14 | (\verb{−}). 15 | } 16 | \description{ 17 | Format negative numbers with a minus sign 18 | } 19 | \details{ 20 | Negative zero \code{-0}, which might happen from aggressive rounding, 21 | does not get a minus sign. 22 | } 23 | \examples{ 24 | fmt_minus_sign(c(1, .2, -1, -.2)) 25 | 26 | # Don't allow zero to be signed 27 | fmt_minus_sign(c(-0, round(-0.001))) 28 | } 29 | -------------------------------------------------------------------------------- /man/fmt_p_value.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/formatters.R 3 | \name{fmt_p_value} 4 | \alias{fmt_p_value} 5 | \title{Format a \emph{p}-value} 6 | \usage{ 7 | fmt_p_value(xs, digits = 3) 8 | } 9 | \arguments{ 10 | \item{xs}{a vector of numbers or a character vector representing numbers} 11 | 12 | \item{digits}{number of digits of precision} 13 | } 14 | \value{ 15 | formatted *-values. Values smaller than the precision \code{1 / (10 ^ digits)} are replaced with a less than statement \verb{< [precision]}. 16 | } 17 | \description{ 18 | Format a \emph{p}-value 19 | } 20 | \examples{ 21 | p <- c(1, 0.1, 0.01, 0.001, 0.0001) 22 | fmt_p_value(p, digits = 2) 23 | fmt_p_value(p, digits = 3) 24 | } 25 | -------------------------------------------------------------------------------- /man/fmt_p_value_md.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/formatters.R 3 | \name{fmt_p_value_md} 4 | \alias{fmt_p_value_md} 5 | \title{Format a \emph{p}-value in markdown} 6 | \usage{ 7 | fmt_p_value_md(ps) 8 | } 9 | \arguments{ 10 | \item{ps}{\emph{p}-values to format} 11 | } 12 | \value{ 13 | a character vector of markdown formatted \emph{p}-values 14 | } 15 | \description{ 16 | Format a \emph{p}-value in markdown 17 | } 18 | \details{ 19 | \code{fmt_p_value()} is for formatting p-values with manual precision, but this 20 | functions follows some reasonable defaults and returns a markdown formatted 21 | string. 22 | 23 | Values less than .06 are formatted with 3 digits. Values equal to .06 or 24 | greater are formatted with 2 digits. 25 | 26 | \code{\link[scales:label_pvalue]{scales::label_pvalue()}} does the initial rounding and formatting. Then this 27 | function strips off the leading 0 of the \emph{p} value. 28 | } 29 | \examples{ 30 | fmt_p_value_md(0.0912) 31 | fmt_p_value_md(0.0512) 32 | fmt_p_value_md(0.005) 33 | 34 | # "p less than" notation kicks in below .001. 35 | fmt_p_value_md(0.0005) 36 | } 37 | -------------------------------------------------------------------------------- /man/fmt_remove_html_entities.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/formatters.R 3 | \name{fmt_remove_html_entities} 4 | \alias{fmt_remove_html_entities} 5 | \title{Replace HTML entities used by this package with UTF-8 codes} 6 | \usage{ 7 | fmt_remove_html_entities(xs) 8 | } 9 | \arguments{ 10 | \item{xs}{a character vector} 11 | } 12 | \value{ 13 | the updated character vector 14 | } 15 | \description{ 16 | Replace HTML entities used by this package with UTF-8 codes 17 | } 18 | \examples{ 19 | x <- "a < −12" |> 20 | fmt_remove_html_entities() 21 | x 22 | charToRaw(x) 23 | charToRaw("a < -12") 24 | 25 | fmt_remove_html_entities("1–2") 26 | } 27 | -------------------------------------------------------------------------------- /man/fmt_replace_na.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/formatters.R 3 | \name{fmt_replace_na} 4 | \alias{fmt_replace_na} 5 | \title{Replace NAs with another value} 6 | \usage{ 7 | fmt_replace_na(xs, replacement = "") 8 | } 9 | \arguments{ 10 | \item{x}{a character vector} 11 | } 12 | \value{ 13 | the updated vector 14 | } 15 | \description{ 16 | Replace NAs with another value 17 | } 18 | -------------------------------------------------------------------------------- /man/printy-package.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/printy-package.R 3 | \docType{package} 4 | \name{printy-package} 5 | \alias{printy} 6 | \alias{printy-package} 7 | \title{printy: Helper functions for pretty-printing numbers} 8 | \description{ 9 | This package contains helper functions for formatting numbers. 10 | } 11 | \author{ 12 | \strong{Maintainer}: Tristan Mahr \email{tristan.mahr@wisc.edu} (\href{https://orcid.org/0000-0002-8890-5116}{ORCID}) 13 | 14 | } 15 | \keyword{internal} 16 | -------------------------------------------------------------------------------- /man/skel_conf_interval.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/skeletons.R 3 | \name{skel_conf_interval} 4 | \alias{skel_conf_interval} 5 | \alias{skel_conf_interval_pair} 6 | \title{Skeleton for a confidence interval} 7 | \usage{ 8 | skel_conf_interval(xs, ys, skeleton = "[{xs}, {ys}]") 9 | 10 | skel_conf_interval_pair(x, skeleton = "[{x[1]}, {x[2]}]") 11 | } 12 | \arguments{ 13 | \item{xs}{a vector of the first elements in the intervals} 14 | 15 | \item{ys}{a vector of the second elements in the intervals} 16 | 17 | \item{skeleton}{glue-style format to fill. defaults to \code{"[{xs}, {ys}]"} for 18 | \code{skel_conf_interval()} and \code{"[{x[1]}, {x[2]}]"} for 19 | \code{skel_conf_interval_pair()}.} 20 | 21 | \item{x}{a vector of two elements to plug into the confidence interval} 22 | } 23 | \value{ 24 | strings representing confidence intervals 25 | } 26 | \description{ 27 | \code{skel_conf_interval()} is a vectorized function. Use it to make multiple 28 | intervals from, say, data-frame columns. \code{skel_conf_interval_pair()} is the 29 | unvectorized function. Use it to make a single interval from a vector (pair) of two 30 | numbers. 31 | } 32 | \details{ 33 | These functions are wrappers around calls to \code{glue::glue()}. 34 | 35 | Originally, \code{skel_conf_interval()} was named \code{skel_conf_interval_v()}. 36 | } 37 | \examples{ 38 | skel_conf_interval(c(.1, .2), c(.3, .4)) 39 | skel_conf_interval_pair(c(.1, .3)) 40 | } 41 | -------------------------------------------------------------------------------- /man/skel_range.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/skeletons.R 3 | \name{skel_range} 4 | \alias{skel_range} 5 | \alias{skel_range_pair} 6 | \title{Skeleton for a range of numbers} 7 | \usage{ 8 | skel_range_pair(x, skeleton = "{x[1]}–{x[2]}") 9 | 10 | skel_range(xs, ys, skeleton = "{xs}–{ys}") 11 | } 12 | \arguments{ 13 | \item{x}{a vector of two elements to plug into the range} 14 | 15 | \item{skeleton}{glue-style format to fill. defaults to \code{"{xs}–{ys}"} for 16 | \code{skel_range()} and \code{"{x[1]}–{x[2]}"} for 17 | \code{skel_range_pair()}.} 18 | 19 | \item{xs}{a vector of the first elements in the range} 20 | 21 | \item{ys}{a vector of the second elements in the range} 22 | } 23 | \value{ 24 | strings representing ranges 25 | 26 | strings representing ranges 27 | } 28 | \description{ 29 | \code{skel_range()} is a vectorized function. Use it to make multiple range from, 30 | say, data-frame columns. \code{skel_range_pair()} is the unvectorized function. 31 | Use it to make a single range from a vector (pair) of two numbers. 32 | 33 | \code{skel_range()} is a vectorized function. Use it to make multiple range from, 34 | say, data-frame columns. \code{skel_range_pair()} is the unvectorized function. 35 | Use it to make a single range from a vector (pair) of two numbers. 36 | } 37 | \details{ 38 | These functions are wrappers around calls to \code{glue::glue()}. 39 | 40 | These functions are wrappers around calls to \code{glue::glue()}. 41 | } 42 | \examples{ 43 | skel_range(c(.1, .2), c(.3, .4)) 44 | skel_range_pair(c(.1, .3)) 45 | skel_range(c(.1, .2), c(.3, .4)) 46 | skel_range_pair(c(.1, .3)) 47 | } 48 | -------------------------------------------------------------------------------- /man/skel_se.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/skeletons.R 3 | \name{skel_se} 4 | \alias{skel_se} 5 | \alias{skel_ci} 6 | \title{Skeletons for inline stats} 7 | \usage{ 8 | skel_se(x, skeleton = "SE = {x}") 9 | 10 | skel_ci(x, ci_width = "95", skeleton = "{ci_width}\% CI = {x}") 11 | } 12 | \arguments{ 13 | \item{skeleton}{glue-style format to fill. defaults to \code{"SE = {x}"} for 14 | \code{skel_se()} and \code{"95\% CI = {x}"} for \code{skel_ci()}.} 15 | 16 | \item{ci_width}{width of the confidence interval to report. Defaults to 17 | \code{"95"}.} 18 | 19 | \item{xs}{a vector of the values to plug into the skeleton} 20 | } 21 | \value{ 22 | strings with stats plugged in. 23 | } 24 | \description{ 25 | Skeletons for inline stats 26 | } 27 | -------------------------------------------------------------------------------- /man/skel_stat_n_value_pair.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/skeletons.R 3 | \name{skel_stat_n_value_pair} 4 | \alias{skel_stat_n_value_pair} 5 | \title{Skeleton for t-statistic-like functions} 6 | \usage{ 7 | skel_stat_n_value_pair( 8 | x, 9 | stat = "t", 10 | skeleton = "{stat}({x[1]}) = {x[2]}" 11 | ) 12 | } 13 | \arguments{ 14 | \item{x}{a two-element vector where the first number is the argument to the 15 | statistical function and the second is its value.} 16 | 17 | \item{stat}{symbol for the statistic. defaults to \code{"t"}.} 18 | 19 | \item{skeleton}{glue-style format to fill. defaults to 20 | \code{"{stat}({x[1]}) = {x[2]}"}.} 21 | } 22 | \value{ 23 | the formatted string 24 | } 25 | \description{ 26 | This skeleton handles formats like t-statistics (\code{t(df) = value}) or 27 | correlations (\code{r(df) = value}). 28 | } 29 | -------------------------------------------------------------------------------- /man/str_replace_same_as_previous.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/stringr-like.R 3 | \name{str_replace_same_as_previous} 4 | \alias{str_replace_same_as_previous} 5 | \title{Replace strings that duplicate the previous string} 6 | \usage{ 7 | str_replace_same_as_previous(string, replacement) 8 | } 9 | \arguments{ 10 | \item{string}{a character vector} 11 | 12 | \item{replacement}{text to use as a replacement for duplicated values} 13 | } 14 | \value{ 15 | a single character vector with immediately repeating items replaced 16 | } 17 | \description{ 18 | The common use of this function to clean up columns in a presentation-quality 19 | table. 20 | } 21 | \examples{ 22 | str_replace_same_as_previous( 23 | c("a", "a", "a", "b", "b", "c", "d", "d"), 24 | "" 25 | ) 26 | } 27 | -------------------------------------------------------------------------------- /man/str_tokenize.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/stringr-like.R 3 | \name{str_tokenize} 4 | \alias{str_tokenize} 5 | \title{Break a string to individual (character) tokens} 6 | \usage{ 7 | str_tokenize(string, pattern = NULL) 8 | } 9 | \arguments{ 10 | \item{string}{a character vector of strings to break} 11 | 12 | \item{pattern}{pattern to use for splitting. Defaults to \code{NULL} so that 13 | strings are split into individual characters.} 14 | } 15 | \value{ 16 | a single character vector of the tokens 17 | } 18 | \description{ 19 | The usual job of this function is to break a string into a vector of 20 | individual characters, but it can break strings using other separators. 21 | } 22 | \examples{ 23 | str_tokenize(c("abc", "de")) 24 | str_tokenize(c("abc de fg"), " ") 25 | } 26 | -------------------------------------------------------------------------------- /man/super_split.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/split.R 3 | \name{super_split} 4 | \alias{super_split} 5 | \title{Split a dataframe into a list of (lists of ...) dataframes} 6 | \usage{ 7 | super_split(.data, ...) 8 | } 9 | \arguments{ 10 | \item{.data}{a dataframe} 11 | 12 | \item{...}{(unquoted) names of columns to split by} 13 | } 14 | \value{ 15 | a list of dataframes when splitting by a single variable, a list of 16 | lists of dataframes when splitting by 2 variables, and so on. 17 | } 18 | \description{ 19 | This function is a streamlined, recursive version of 20 | \code{\link[base:split]{split()}}. 21 | } 22 | \examples{ 23 | # some kind of 2 by 2 design 24 | df <- data.frame( 25 | x = c(1, 2, 3, 4, 5, 6, 7, 8), 26 | time = c(1, 1, 2, 2, 1, 1, 2, 2), 27 | group = c("a", "a", "a", "a", "b", "b", "b", "b") 28 | ) 29 | 30 | super_split(df, group) 31 | 32 | super_split(df, time) 33 | 34 | # split by group and then split each of those by time 35 | super_split(df, group, time) 36 | } 37 | -------------------------------------------------------------------------------- /man/tidyeval.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/utils-tidy-eval.R 3 | \name{tidyeval} 4 | \alias{tidyeval} 5 | \title{Tidy eval helpers} 6 | \description{ 7 | \itemize{ 8 | \item \code{\link[rlang]{sym}()} creates a symbol from a string and 9 | \code{\link[rlang:sym]{syms}()} creates a list of symbols from a 10 | character vector. 11 | \item \code{\link[rlang:nse-defuse]{enquo}()} and 12 | \code{\link[rlang:nse-defuse]{enquos}()} delay the execution of one or 13 | several function arguments. \code{enquo()} returns a single quoted 14 | expression, which is like a blueprint for the delayed computation. 15 | \code{enquos()} returns a list of such quoted expressions. 16 | \item \code{\link[rlang:nse-defuse]{expr}()} quotes a new expression \emph{locally}. It 17 | is mostly useful to build new expressions around arguments 18 | captured with \code{\link[=enquo]{enquo()}} or \code{\link[=enquos]{enquos()}}: 19 | \code{expr(mean(!!enquo(arg), na.rm = TRUE))}. 20 | \item \code{\link[rlang]{as_name}()} transforms a quoted variable name 21 | into a string. Supplying something else than a quoted variable 22 | name is an error. 23 | 24 | That's unlike \code{\link[rlang]{as_label}()} which also returns 25 | a single string but supports any kind of R object as input, 26 | including quoted function calls and vectors. Its purpose is to 27 | summarise that object into a single label. That label is often 28 | suitable as a default name. 29 | 30 | If you don't know what a quoted expression contains (for instance 31 | expressions captured with \code{enquo()} could be a variable 32 | name, a call to a function, or an unquoted constant), then use 33 | \code{as_label()}. If you know you have quoted a simple variable 34 | name, or would like to enforce this, use \code{as_name()}. 35 | } 36 | 37 | To learn more about tidy eval and how to use these tools, visit 38 | \url{https://tidyeval.tidyverse.org} and the 39 | \href{https://adv-r.hadley.nz/metaprogramming.html}{Metaprogramming 40 | section} of \href{https://adv-r.hadley.nz}{Advanced R}. 41 | } 42 | \keyword{internal} 43 | -------------------------------------------------------------------------------- /printy.Rproj: -------------------------------------------------------------------------------- 1 | Version: 1.0 2 | 3 | RestoreWorkspace: No 4 | SaveWorkspace: No 5 | AlwaysSaveHistory: No 6 | 7 | EnableCodeIndexing: Yes 8 | UseSpacesForTab: Yes 9 | NumSpacesForTab: 2 10 | Encoding: UTF-8 11 | 12 | RnwWeave: knitr 13 | LaTeX: XeLaTeX 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,vignette 22 | -------------------------------------------------------------------------------- /tests/testthat.R: -------------------------------------------------------------------------------- 1 | library(testthat) 2 | library(printy) 3 | 4 | test_check("printy") 5 | -------------------------------------------------------------------------------- /tests/testthat/test-effect.R: -------------------------------------------------------------------------------- 1 | context("reporting effects from models") 2 | 3 | test_that("fmt_effect_md() matches hand-formatted results on lm() models", { 4 | # model <- readRDS(testthat::test_path("data/lm-model.rds")) 5 | model <- stats::lm(breaks ~ wool, datasets::warpbreaks) 6 | model_summary <- stats::coef(summary(model)) 7 | effect <- "woolB" 8 | 9 | b_value <- model_summary[effect, "Estimate", drop = TRUE] %>% 10 | fmt_fix_digits(2) %>% 11 | fmt_minus_sign() 12 | 13 | # This also tests `digits = 3` 14 | e_value <- model_summary[effect, "Std. Error", drop = TRUE] %>% 15 | fmt_fix_digits(3) 16 | 17 | s_value <- model_summary[effect, "t value", drop = TRUE] %>% 18 | fmt_fix_digits(2) %>% 19 | fmt_minus_sign() 20 | 21 | p_value <- model_summary[effect, "Pr(>|t|)", drop = TRUE] %>% 22 | fmt_fix_digits(2) %>% 23 | fmt_leading_zero() 24 | 25 | b_manual <- paste0("*b* = ", b_value) 26 | b_printy <- fmt_effect_md(model, effect, "b") 27 | 28 | e_manual <- paste0("SE = ", e_value) 29 | e_printy <- fmt_effect_md(model, effect, "e", digits = 3) 30 | 31 | s_manual <- paste0("*t* = ", s_value) 32 | s_printy <- fmt_effect_md(model, effect, "s") 33 | 34 | S_manual <- paste0("*t*(", model$df.residual, ") = ", s_value) 35 | S_printy <- fmt_effect_md(model, effect, "S") 36 | 37 | p_manual <- paste0("*p* = ", p_value) 38 | p_printy <- fmt_effect_md(model, effect, "p") 39 | 40 | i_manual <- stats::confint(model)[effect, ] %>% 41 | as.vector() %>% 42 | fmt_fix_digits(2) %>% 43 | fmt_minus_sign() %>% 44 | skel_conf_interval_pair() %>% 45 | paste0("95% CI = ", .) 46 | 47 | i_printy <- fmt_effect_md(model, effect, "i") 48 | 49 | expect_equal(b_manual, b_printy) 50 | expect_equal(e_manual, e_printy) 51 | expect_equal(s_manual, s_printy) 52 | expect_equal(S_manual, S_printy) 53 | expect_equal(p_manual, p_printy) 54 | expect_equal(i_manual, i_printy) 55 | }) 56 | 57 | 58 | test_that("fmt_effect_md() fails on missing parameters", { 59 | model <- stats::lm(breaks ~ wool, datasets::warpbreaks) 60 | expect_error(fmt_effect_md(model, "intercept"), "not a parameter name") 61 | }) 62 | 63 | 64 | test_that("fmt_effect_md() handles lmer() models", { 65 | skip_on_cran() 66 | 67 | if (!requireNamespace("pbkrtest", quietly = TRUE)) { 68 | skip("pbkrtest is not available") 69 | } 70 | 71 | data(beets, package = "pbkrtest") 72 | 73 | f1 <- sugpct ~ block + sow + harvest + (1 | block:harvest) 74 | f2 <- sugpct ~ block + sow + + (1 | block:harvest) 75 | model <- lme4::lmer(f1, beets) 76 | model2 <- lme4::lmer(f2, beets) 77 | model_summary <- stats::coef(summary(model)) 78 | effect <- "harvestharv2" 79 | 80 | b_value <- model_summary[effect, "Estimate", drop = TRUE] %>% 81 | fmt_fix_digits(2) %>% 82 | fmt_minus_sign() 83 | 84 | e_value <- model_summary[effect, "Std. Error", drop = TRUE] %>% 85 | fmt_fix_digits(3) 86 | 87 | s_value <- model_summary[effect, "t value", drop = TRUE] %>% 88 | fmt_fix_digits(2) %>% 89 | fmt_minus_sign() 90 | 91 | b_manual <- paste0("*b* = ", b_value) 92 | b_printy <- fmt_effect_md(model, effect, "b") 93 | 94 | e_manual <- paste0("SE = ", e_value) 95 | e_printy <- fmt_effect_md(model, effect, "e", digits = 3) 96 | 97 | s_manual <- paste0("*t* = ", s_value) 98 | s_printy <- fmt_effect_md(model, effect, "s") 99 | 100 | i_manual <- stats::confint(model, method = "Wald")[effect, ] %>% 101 | as.vector() %>% 102 | fmt_fix_digits(2) %>% 103 | fmt_minus_sign() %>% 104 | skel_conf_interval_pair() %>% 105 | paste0("95% CI = ", .) 106 | 107 | i_printy <- fmt_effect_md(model, effect, "i") 108 | 109 | expect_equal(b_manual, b_printy) 110 | expect_equal(e_manual, e_printy) 111 | expect_equal(s_manual, s_printy) 112 | expect_equal(i_manual, i_printy) 113 | 114 | # Get p-value and degrees of freedom from Kenwood-Rogers 115 | kr <- pbkrtest::KRmodcomp(model, model2) 116 | df <- kr$stats$ddf %>% round(2) %>% as.character() 117 | 118 | S_manual <- skel_stat_n_value_pair(c(df, s_value), stat = "*t*") 119 | S_printy <- fmt_effect_md(model, effect, "S") 120 | 121 | p_manual <- kr$stats$p.value %>% 122 | fmt_p_value_md() 123 | p_printy <- fmt_effect_md(model, effect, "p") 124 | 125 | expect_equal(S_manual, S_printy) 126 | expect_equal(p_manual, p_printy) 127 | }) 128 | -------------------------------------------------------------------------------- /tests/testthat/test-formatting.R: -------------------------------------------------------------------------------- 1 | context("formatting") 2 | 3 | test_that("fmt_fix_digits() keeps trailing zeroes", { 4 | test <- c(.4001, .1000, -.5500) 5 | test |> 6 | fmt_fix_digits(1) |> 7 | expect_equal(c("0.4", "0.1", "-0.6")) 8 | 9 | test |> 10 | fmt_fix_digits(2) |> 11 | expect_equal(c("0.40", "0.10", "-0.55")) 12 | 13 | test |> 14 | fmt_fix_digits(3) |> 15 | expect_equal(c("0.400", "0.100", "-0.550")) 16 | }) 17 | 18 | test_that("fmt_minus_sign() handles regular numbers", { 19 | test <- c(0, 1, 2L, 1.00009, -1, -2, -0.5, -0.006, NA) 20 | want <- c("0", "1", "2", "1.00009", "−1", "−2", 21 | "−0.5", "−0.006", NA) 22 | expect_equal(fmt_minus_sign(test), want) 23 | }) 24 | 25 | test_that("fmt_minus_sign() removes sign from negative zero", { 26 | test <- c(-0, -0L, -0.00) 27 | want <- c("0", "0", "0") 28 | expect_equal(fmt_minus_sign(test), want) 29 | 30 | test <- c("-0", "-0.00") 31 | want <- c("0", "0.00") 32 | expect_equal(fmt_minus_sign(test), want) 33 | }) 34 | 35 | test_that("fmt_replace_na() replaces NA values", { 36 | expect_equal(fmt_replace_na(NA, ""), "") 37 | 38 | # Defaults to empty strings 39 | test <- c(-1:3, NA) 40 | want <- c("-1", "0", "1", "2", "3", "") 41 | expect_equal(fmt_replace_na(test), want) 42 | }) 43 | 44 | test_that("fmt_replace_na() does not replace \"NA\"", { 45 | expect_equal(fmt_replace_na(c("hey", "NA")), c("hey", "NA")) 46 | }) 47 | 48 | 49 | test_that("fmt_p_value() prints small values with less-thans, like \"< .001\"", { 50 | ps <- c(1.42950220581308e-12, 4.86751586760195e-08, 1.07359248017686e-23, 51 | 0.0388882596082964, 0.00305963409612887, 0.00258434378890403, .6) 52 | 53 | ps_1 <- c("< .1", "< .1", "< .1", "< .1", "< .1", "< .1", ".6") 54 | ps_2 <- c("< .01", "< .01", "< .01", ".04", "< .01", "< .01", ".60") 55 | ps_3 <- c("< .001", "< .001", "< .001", ".039", ".003", ".003", ".600") 56 | ps_4 <- c("< .0001", "< .0001", "< .0001", ".0389", ".0031", ".0026", ".6000") 57 | 58 | expect_equal(fmt_p_value(ps, 1), ps_1) 59 | expect_equal(fmt_p_value(ps, 2), ps_2) 60 | expect_equal(fmt_p_value(ps, 3), ps_3) 61 | expect_equal(fmt_p_value(ps, 4), ps_4) 62 | }) 63 | 64 | test_that("fmt_p_value_md() produces nice markdown results", { 65 | ps <- c(1.42950220581308e-12, 4.86751586760195e-08, 1.07359248017686e-23, 66 | 0.0388882596082964, 0.00305963409612887, 0.00258434378890403, 67 | .6) 68 | 69 | p_md <- c("*p* < .001", "*p* < .001", "*p* < .001", 70 | "*p* = .039", "*p* = .003", "*p* = .003", 71 | "*p* = .60") 72 | 73 | expect_equal(fmt_p_value_md(ps), p_md) 74 | }) 75 | -------------------------------------------------------------------------------- /tests/testthat/test-misc.R: -------------------------------------------------------------------------------- 1 | 2 | test_that("pretty random effects", { 3 | 4 | model <- lme4::lmer(Reaction ~ Days + (Days | Subject), lme4::sleepstudy) 5 | summary(model) 6 | 7 | results <- as.data.frame(tibble::tribble( 8 | ~Group, ~Parameter, ~Variance, ~SD, ~Correlations, ~` `, 9 | "Subject", "(Intercept)", "612.10", "24.74", "1.00", " ", 10 | " ", "Days", "35.07", "5.92", ".07", "1.00", 11 | "Residual", " ", "654.94", "25.59", " ", " " 12 | )) 13 | expect_equal(pretty_lme4_ranefs(model), results) 14 | }) 15 | -------------------------------------------------------------------------------- /tests/testthat/test-split.R: -------------------------------------------------------------------------------- 1 | test_that("super_split works with 1 variable", { 2 | df <- data.frame( 3 | x = c(1, 2, 3, 4, 5, 6, 7, 8), 4 | time = c(1, 1, 2, 2, 1, 1, 2, 2), 5 | group = c("a", "a", "a", "a", "b", "b", "b", "b") 6 | ) 7 | 8 | result_group <- list( 9 | # names are strings 10 | a = df[df$group == "a", ], 11 | b = df[df$group == "b", ] 12 | ) 13 | 14 | expect_equal(super_split(df, group), result_group) 15 | 16 | result_time <- list( 17 | # names are numbers 18 | `1` = df[df$time == 1, ], 19 | `2` = df[df$time == 2, ] 20 | ) 21 | 22 | expect_equal(super_split(df, time), result_time) 23 | }) 24 | 25 | test_that("super_split works with 2 variables", { 26 | df <- data.frame( 27 | x = c(1, 2, 3, 4, 5, 6, 7, 8), 28 | time = c(1, 1, 2, 2, 1, 1, 2, 2), 29 | group = c("a", "a", "a", "a", "b", "b", "b", "b") 30 | ) 31 | 32 | result_group_time <- list() 33 | result_group <- list( 34 | # names are strings 35 | a = df[df$group == "a", ], 36 | b = df[df$group == "b", ] 37 | ) 38 | 39 | result_group_time$a <- list( 40 | `1` = result_group$a[result_group$a$time == 1, ], 41 | `2` = result_group$a[result_group$a$time == 2, ] 42 | ) 43 | 44 | result_group_time$b <- list( 45 | `1` = result_group$b[result_group$b$time == 1, ], 46 | `2` = result_group$b[result_group$b$time == 2, ] 47 | ) 48 | 49 | expect_equal(super_split(df, group, time), result_group_time) 50 | 51 | result_time_group <- list() 52 | result_time <- list( 53 | # names are numbers 54 | `1` = df[df$time == 1, ], 55 | `2` = df[df$time == 2, ] 56 | ) 57 | 58 | result_time_group$`1` <- list( 59 | a = result_time$`1`[result_time$`1`$group == "a", ], 60 | b = result_time$`1`[result_time$`1`$group == "b", ] 61 | ) 62 | 63 | result_time_group$`2` <- list( 64 | a = result_time$`2`[result_time$`2`$group == "a", ], 65 | b = result_time$`2`[result_time$`2`$group == "b", ] 66 | ) 67 | 68 | expect_equal(super_split(df, time, group), result_time_group) 69 | }) 70 | -------------------------------------------------------------------------------- /tests/testthat/test-strings.R: -------------------------------------------------------------------------------- 1 | context("strings") 2 | 3 | test_that("str_tokenize() works", { 4 | expect_equal(str_tokenize("word"), c("w", "o", "r", "d")) 5 | expect_equal( 6 | str_tokenize("word word word", "\\s+"), 7 | c("word", "word", "word") 8 | ) 9 | }) 10 | 11 | test_that("str_replace_same_as_previous() works", { 12 | expect_equal( 13 | str_replace_same_as_previous(c("a", "a", "a", "b", "b", "c", "a"), "-"), 14 | c("a", "-", "-", "b", "-", "c", "a") 15 | ) 16 | }) 17 | --------------------------------------------------------------------------------