├── .Rbuildignore ├── .Renviron ├── .Rprofile ├── .gitignore ├── .renvignore ├── DESCRIPTION ├── LICENSE.md ├── NAMESPACE ├── NEWS.md ├── R ├── Tplyr_helpers.R ├── app_config.R ├── app_teal.R ├── eff_models.R ├── fmt.R ├── globals.R ├── helpers.R ├── kmplot_helpers.R ├── package.R ├── run_app.R ├── tm_g_kmplot.R ├── tm_i_usage.R ├── tm_t_demographic.R ├── tm_t_disposition.R ├── tm_t_efficacy.R ├── tm_t_primary.R └── utils-pipe.R ├── README.md ├── _pkgdown.yml ├── app.R ├── datasets └── adam │ ├── adadas.xpt │ ├── adlbc.xpt │ ├── adsl.xpt │ └── adtte.xpt ├── dev ├── 01_start.R ├── 02_dev.R ├── 03_deploy.R └── run_dev.R ├── inst ├── app │ ├── docs │ │ └── about.md │ └── www │ │ ├── app_screenshot1.png │ │ ├── app_screenshot2.png │ │ ├── app_screenshot3.png │ │ ├── app_screenshot4.png │ │ └── favicon.ico ├── golem-config.yml ├── pkgdown │ ├── assets │ │ └── readme.txt │ └── templates │ │ └── readme.txt └── startup.R ├── man ├── efficacy_models.Rd ├── filter_active.Rd ├── fmt_ci.Rd ├── fmt_est.Rd ├── fmt_num.Rd ├── fmt_pval.Rd ├── nest_rowlabels.Rd ├── num_fmt.Rd ├── pad_row.Rd ├── pilot2wrappers-package.Rd ├── pipe.Rd ├── run_app.Rd ├── set_data_path.Rd └── tooltip_text.Rd ├── pkgdown └── extra.css ├── renv.lock ├── renv ├── .gitignore ├── activate.R ├── cellar │ └── pilot2wrappers_0.10.0.tar.gz └── settings.dcf ├── submissions-pilot2.Rproj └── vignettes ├── .gitignore ├── R Consortium R Submission Pilot 2 Cover Letter.pdf ├── adrg-prepare.Rmd ├── adrg-quarto.pdf ├── adrg-quarto.qmd ├── cover-letter.Rmd ├── cover-letter_files └── paged-0.18 │ ├── css │ ├── default.css │ └── letter.css │ └── js │ ├── config.js │ ├── hooks.js │ └── paged.js ├── ectd └── r1pkg.txt ├── figures ├── app_screenshot1.png ├── app_screenshot2.png ├── app_screenshot3.png ├── app_screenshot4.png ├── data_dependencies.png └── study_design.png ├── letter_custom.css └── rconsortium.png /.Rbuildignore: -------------------------------------------------------------------------------- 1 | ^renv$ 2 | ^renv\.lock$ 3 | ^\.renvignore 4 | ^.*\.Rproj$ 5 | ^\.Rproj\.user$ 6 | ^pilot1wrappers\.Rcheck$ 7 | ^pilot1wrappers.*\.tar\.gz$ 8 | ^pilot1wrappers.*\.tgz$ 9 | ^_pkgdown\.yml$ 10 | ^docs$ 11 | ^pkgdown$ 12 | ^LICENSE.md$ 13 | ^output$ 14 | ^readme.md$ 15 | ^adam$ 16 | ^vignettes$ 17 | ^\.github$ 18 | ^data-raw$ 19 | dev_history.R 20 | ^dev$ 21 | $run_dev.* 22 | ^.devcontainer$ 23 | ^app\.R$ 24 | ^rsconnect$ 25 | ^LICENSE\.md$ 26 | ^datasets$ 27 | -------------------------------------------------------------------------------- /.Renviron: -------------------------------------------------------------------------------- 1 | RENV_PATHS_CELLAR="renv/cellar" 2 | -------------------------------------------------------------------------------- /.Rprofile: -------------------------------------------------------------------------------- 1 | options("renv.config.mran.enabled" = FALSE) 2 | source("renv/activate.R") 3 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | .Rproj.user 2 | .Rhistory 3 | .RData 4 | .Ruserdata 5 | pilot2wrappers.Rcheck/ 6 | inst/doc 7 | .DS_Store 8 | rsconnect/ 9 | -------------------------------------------------------------------------------- /.renvignore: -------------------------------------------------------------------------------- 1 | .Rproj.user 2 | .Rhistory 3 | .Ruserdata 4 | inst/ 5 | rsconnect/ 6 | dev/ 7 | vignettes/ 8 | pkgdown/ 9 | .devcontainer/ -------------------------------------------------------------------------------- /DESCRIPTION: -------------------------------------------------------------------------------- 1 | Package: pilot2wrappers 2 | Type: Package 3 | Title: R Consortium R Submission Pilot 2 4 | Version: 0.10.0 5 | Authors@R: c( 6 | person("Eric", "Nantz", email = "theRcast@gmail.com", role = c("aut", "cre")), 7 | person("Yilong", "Zhang", role = c("aut")), 8 | person("Heng", "Wang", role = c("aut")), 9 | person("Gregory", "Chen", role = c("aut")), 10 | person("Eli", "Miller", role = c("aut")), 11 | person("Ning", "Leng", role = c("aut")), 12 | person("copyright", role = c("cph")) 13 | ) 14 | Description: Shiny application used within the R Consortium R Submissions 15 | Working Group Pilot submissions. 16 | Depends: R (>= 4.1.0) 17 | License: GPL (>= 3) 18 | Imports: 19 | config (>= 0.3.1), 20 | golem (>= 0.3.1), 21 | teal, 22 | teal.data, 23 | shiny (>= 1.7.1), 24 | rtables, 25 | haven, 26 | dplyr, 27 | Tplyr, 28 | tidyr, 29 | glue, 30 | stringr, 31 | huxtable, 32 | ggplot2, 33 | cowplot, 34 | visR, 35 | emmeans, 36 | reactable, 37 | magrittr, 38 | tibble, 39 | utils, 40 | htmltools, 41 | pkgload, 42 | tippy, 43 | markdown, 44 | purrr, 45 | shinyWidgets 46 | Suggests: 47 | devtools, 48 | testthat, 49 | knitr, 50 | rmarkdown, 51 | pkglite 52 | Encoding: UTF-8 53 | LazyData: true 54 | Roxygen: list(markdown = TRUE) 55 | Rmarkdwon: echo = TRUE 56 | RoxygenNote: 7.1.2 57 | VignetteBuilder: knitr 58 | -------------------------------------------------------------------------------- /LICENSE.md: -------------------------------------------------------------------------------- 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("%>%") 4 | export(efficacy_models) 5 | export(fmt_ci) 6 | export(fmt_est) 7 | export(fmt_num) 8 | export(fmt_pval) 9 | export(nest_rowlabels) 10 | export(num_fmt) 11 | export(pad_row) 12 | export(run_app) 13 | export(set_data_path) 14 | export(tooltip_text) 15 | import(Tplyr) 16 | import(dplyr) 17 | import(ggplot2) 18 | import(rtables) 19 | import(tippy) 20 | importFrom(dplyr,across) 21 | importFrom(dplyr,arrange) 22 | importFrom(dplyr,bind_rows) 23 | importFrom(dplyr,case_when) 24 | importFrom(dplyr,distinct) 25 | importFrom(dplyr,filter) 26 | importFrom(dplyr,group_by) 27 | importFrom(dplyr,mutate) 28 | importFrom(dplyr,n) 29 | importFrom(dplyr,rename) 30 | importFrom(dplyr,rowwise) 31 | importFrom(dplyr,select) 32 | importFrom(dplyr,starts_with) 33 | importFrom(dplyr,summarise) 34 | importFrom(glue,glue) 35 | importFrom(golem,with_golem_options) 36 | importFrom(graphics,pairs) 37 | importFrom(magrittr,"%>%") 38 | importFrom(reactable,colDef) 39 | importFrom(reactable,colGroup) 40 | importFrom(reactable,reactable) 41 | importFrom(reactable,reactableOutput) 42 | importFrom(reactable,renderReactable) 43 | importFrom(shiny,NS) 44 | importFrom(shiny,column) 45 | importFrom(shiny,fluidPage) 46 | importFrom(shiny,fluidRow) 47 | importFrom(shiny,h4) 48 | importFrom(shiny,h6) 49 | importFrom(shiny,imageOutput) 50 | importFrom(shiny,plotOutput) 51 | importFrom(shiny,reactive) 52 | importFrom(shiny,renderImage) 53 | importFrom(shiny,renderPlot) 54 | importFrom(shiny,renderUI) 55 | importFrom(shiny,shinyApp) 56 | importFrom(shiny,tabPanel) 57 | importFrom(shiny,tabsetPanel) 58 | importFrom(shiny,tagList) 59 | importFrom(shiny,tags) 60 | importFrom(shiny,uiOutput) 61 | importFrom(stats,confint) 62 | importFrom(stats,drop1) 63 | importFrom(stats,lm) 64 | importFrom(stats,median) 65 | importFrom(stats,sd) 66 | importFrom(stringr,str_pad) 67 | importFrom(teal,init) 68 | importFrom(teal,module) 69 | importFrom(teal,modules) 70 | importFrom(tidyr,pivot_longer) 71 | importFrom(tidyr,replace_na) 72 | -------------------------------------------------------------------------------- /NEWS.md: -------------------------------------------------------------------------------- 1 | # pilot2wrappers 0.10.0 2 | 3 | - Add usage guide for application (#61) 4 | - Remove treatment variables from the `adtte` set prior to generating filters in KM plot module (#60). 5 | - Ensure data filters within the KM-Plot module are only applied to data sets inside that module, and not on the remaining modules (#59). 6 | - Ensure inference p-values are still displayed within primary and efficacy tables after applying filters in KM-Plot module. 7 | - Add specific notes regarding filter usage and overlapping variables inside the KM module per user feedback. 8 | - Display a message to the user when filtered data does not contain enough observations for survival probabilities and confidence intervals in the KM-Plot module. A note in the ADRG has also been added for this situation. 9 | - Add note in ADRG regarding warning messages when restoring the `teal` and `teal.data` packages after the `renv` package library completes installation. 10 | - Correct typos in ADRG Quarto document. 11 | 12 | # pilot2wrappers 0.9.0 13 | 14 | - Fix RMSE calculation in efficacy table to match result in Pilot 1 15 | 16 | # pilot2wrappers 0.8.0 17 | 18 | - Switch to `adlbc` as source for visit completion to remain consistent with efficacy analysis 19 | - Fix incorrect sample sizes for baseline visit in primary analysis table 20 | - Fix misc typos for ADRG 21 | 22 | # pilot2wrappers 0.7.0 23 | 24 | - Include analysis model specification as a footnote in the efficacy table (#55) 25 | - Add new frequency table of visit completion by treatment group (#53) 26 | - Revise title for efficacy table (#52) 27 | - Fix incorrect header order for primary table (#51) 28 | - Ensure decimal places for rounding numeric results in demographics table is consistent with Pilot 1 programming (#54) 29 | 30 | # pilot2wrappers 0.6.0 31 | 32 | - Remove Teal filters for every module except KM-plot to address FDA reviewer feedback 33 | - Increase risk table and plot label font sizes 34 | - Add bootstrap alert box with subgroup disclaimer in KM-plot module 35 | 36 | # pilot2wrappers 0.5.0 37 | 38 | - Hide p-values when a data filter is applied, and display only when no filters are applied. This addresses comments from FDA reviewers after they saw a preview of the application. 39 | - Add a new description in the App Information module regarding display of p-values. 40 | - Add another footnote to the primary and efficacy table displays regarding the p-value display. 41 | - Increase plot window height for KM module, improving readability 42 | 43 | # pilot2wrappers 0.4.0 44 | 45 | - Ensure column width of efficacy table's 95% CI header is wide enough to fit in a single row 46 | - Add missing footnotes to primary table 47 | - Add new vignettes for ADRG as a [Quarto](https://quarto.org/) document (with HTML and PDF output) and cover letter as a R-Markdown document using the [`{pagedown}`](https://pagedown.rbind.io/#letter) package. 48 | 49 | # pilot2wrappers 0.3.0 50 | 51 | - Enable support for using `{pkglite}` to create package bundle compliant with ECTD submission transfer standards 52 | - Fix display of tooltips in select modules by using the `{tippy}` R package 53 | - Add helper function `set_data_path` for the user to set the directory path to `.xpt` data files loaded into the application 54 | 55 | # pilot2wrappers 0.2.0 56 | 57 | - Convert Shiny application to a package structure using [`{golem}`](https://thinkr-open.github.io/golem). 58 | - Incorporate the open-source [`{teal}`](https://insightsengineering.github.io/teal/main) package inside application to provide dynamic filters in all modules 59 | 60 | # pilot2wrappers 0.1.0 61 | 62 | - Initial version. 63 | - Added a `NEWS.md` file to track changes to the package. 64 | -------------------------------------------------------------------------------- /R/Tplyr_helpers.R: -------------------------------------------------------------------------------- 1 | #' Nest Row Labels in a Tplyr table 2 | #' 3 | #' This is a (high ungeneralized) helper function. Current function assumes that 4 | #' row_label1 groups row_label2, and turns row_label1 into a stub over its 5 | #' related groups of row_label2. 6 | #' 7 | #' @param .dat Input data set - should come from a built Tplyr table. 8 | #' 9 | #' @importFrom dplyr distinct rename bind_rows mutate select arrange across starts_with 10 | #' @importFrom tidyr replace_na 11 | #' 12 | #' @return data.frame with row labels nested 13 | #' @export 14 | nest_rowlabels <- function(.dat) { 15 | stubs <- .dat %>% 16 | distinct(row_label1, ord_layer_index) %>% 17 | rename(row_label = row_label1) %>% 18 | mutate( 19 | ord_layer_1 = 0, 20 | ord_layer_2 = 0 21 | ) 22 | 23 | .dat %>% 24 | select(-row_label1, row_label=row_label2) %>% 25 | bind_rows(stubs) %>% 26 | arrange(ord_layer_index, ord_layer_1, ord_layer_2) %>% 27 | mutate( 28 | across(starts_with('var'), ~ tidyr::replace_na(., '')) 29 | ) 30 | } -------------------------------------------------------------------------------- /R/app_config.R: -------------------------------------------------------------------------------- 1 | #' Access files in the current app 2 | #' 3 | #' NOTE: If you manually change your package name in the DESCRIPTION, 4 | #' don't forget to change it here too, and in the config file. 5 | #' For a safer name change mechanism, use the `golem::set_golem_name()` function. 6 | #' 7 | #' @param ... character vectors, specifying subdirectory and file(s) 8 | #' within your package. The default, none, returns the root of the app. 9 | #' 10 | #' @noRd 11 | app_sys <- function(...){ 12 | system.file(..., package = "pilot2wrappers") 13 | } 14 | 15 | 16 | #' Read App Config 17 | #' 18 | #' @param value Value to retrieve from the config file. 19 | #' @param config GOLEM_CONFIG_ACTIVE value. If unset, R_CONFIG_ACTIVE. 20 | #' If unset, "default". 21 | #' @param use_parent Logical, scan the parent directory for config file. 22 | #' 23 | #' @noRd 24 | get_golem_config <- function( 25 | value, 26 | config = Sys.getenv( 27 | "GOLEM_CONFIG_ACTIVE", 28 | Sys.getenv( 29 | "R_CONFIG_ACTIVE", 30 | "default" 31 | ) 32 | ), 33 | use_parent = TRUE 34 | ){ 35 | config::get( 36 | value = value, 37 | config = config, 38 | # Modify this if your config file is somewhere else: 39 | file = app_sys("golem-config.yml"), 40 | use_parent = use_parent 41 | ) 42 | } 43 | 44 | -------------------------------------------------------------------------------- /R/app_teal.R: -------------------------------------------------------------------------------- 1 | #' @importFrom teal init modules module 2 | #' @importFrom shiny tags 3 | create_teal <- function() { 4 | adam_path <- get_golem_config("adam_path") 5 | adsl <- haven::read_xpt(file.path(adam_path, "adsl.xpt")) 6 | adsl <- adsl %>% 7 | dplyr::mutate( 8 | TRT01P = factor(TRT01P, levels = c("Placebo", "Xanomeline Low Dose", "Xanomeline High Dose")), 9 | AGEGR1 = factor(AGEGR1, levels = c("<65", "65-80", ">80")), 10 | RACE = factor(RACE, levels = c("WHITE", "BLACK OR AFRICAN AMERICAN", "AMERICAN INDIAN OR ALASKA NATIVE")) 11 | ) 12 | adas <- haven::read_xpt(file.path(adam_path, "adadas.xpt")) %>% 13 | dplyr::filter( 14 | EFFFL == "Y", 15 | ITTFL == 'Y', 16 | PARAMCD == 'ACTOT', 17 | ANL01FL == 'Y' 18 | ) 19 | adtte <- haven::read_xpt(file.path(adam_path, "adtte.xpt")) %>% 20 | dplyr::filter(PARAMCD == "TTDE") %>% 21 | select(., -TRTDUR, -TRTP, -TRTA, -TRTAN) 22 | adlb <- haven::read_xpt(file.path(adam_path, "adlbc.xpt")) %>% 23 | filter(PARAMCD == "GLUC" & !is.na(AVISITN)) 24 | 25 | app <- teal::init( 26 | data = teal.data::cdisc_data( 27 | teal.data::cdisc_dataset("ADSL", adsl), 28 | teal.data::cdisc_dataset("ADAS", adas, keys = c("STUDYID", "USUBJID", "PARAMCD", "AVISIT", "QSSEQ")), 29 | teal.data::cdisc_dataset("ADTTE", adtte), 30 | teal.data::cdisc_dataset("ADLB", adlb) 31 | ), 32 | modules = modules( 33 | module( 34 | label = "App Information", 35 | server = function(input, output, session, datasets){}, 36 | ui = function(id, ...) { 37 | shiny::includeMarkdown(app_sys("app", "docs", "about.md")) 38 | }, 39 | filters = NULL 40 | ), 41 | module( 42 | label = "Usage Guide", 43 | ui = ui_i_usage, 44 | server = srv_i_usage, 45 | filters = NULL 46 | ), 47 | module( 48 | label = "Demographic Table", 49 | ui = ui_t_demographic, 50 | server = srv_t_demographic, 51 | filters = NULL 52 | ), 53 | module( 54 | label = "KM plot for TTDE", 55 | ui = ui_g_kmplot, 56 | server = srv_g_kmplot, 57 | filters = c("ADSL", "ADTTE") 58 | ), 59 | module( 60 | label = "Primary Table", 61 | ui = ui_t_primary, 62 | server = srv_t_primary, 63 | filters = NULL 64 | ), 65 | module( 66 | label = "Efficacy Table", 67 | ui = ui_t_efficacy, 68 | server = srv_t_efficacy, 69 | filters = NULL 70 | ), 71 | module( 72 | label = "Visit Completion Table", 73 | ui = ui_t_disposition, 74 | server = srv_t_disposition, 75 | filters = NULL 76 | ) 77 | 78 | ), 79 | header = "Pilot 2 Shiny Application", 80 | footer = tags$p(class="text-muted", "Source: R Consortium") 81 | ) 82 | 83 | return(app) 84 | } -------------------------------------------------------------------------------- /R/eff_models.R: -------------------------------------------------------------------------------- 1 | #' ANCOVA Model data processing necessary for Table 14-3.01 2 | #' 3 | #' This function handles the necessary data processing to handle the CDISC pilot 4 | #' primary endpoint analysis. The original source can be found 5 | #' [here](https://github.com/atorus-research/CDISC_pilot_replication/blob/3c8e9e3798c02be8d93bd8e8944d1e0d3f6519e2/programs/funcs.R#L401) 6 | #' 7 | #' @importFrom tidyr pivot_longer 8 | #' @importFrom glue glue 9 | #' 10 | #' @param data Source dataset (filtered by flags) 11 | #' @param var Variable on which model should be run 12 | #' @param wk Visit to be modeled 13 | #' @param show_pvalue Indicator to display p-values in table 14 | #' 15 | #' @return Formatted dataframe 16 | #' 17 | #' @importFrom dplyr filter mutate case_when rowwise select bind_rows arrange 18 | #' @importFrom stats drop1 confint 19 | #' @export 20 | #' 21 | efficacy_models <- function(data, var=NULL, wk=NULL, show_pvalue = TRUE) { 22 | # Need to set contrasts to work for Type III SS. See analysis results metadata for 23 | # table 14-3.01. Reference for R here: https://www.r-bloggers.com/anova-%E2%80%93-type-iiiiii-ss-explained/ 24 | op <- options(contrasts = c("contr.sum","contr.poly")) 25 | 26 | # Subset to analyze 27 | data <- data %>% 28 | filter(AVISITN == wk) 29 | 30 | data <- data %>% 31 | mutate( 32 | TRTPCD = case_when( 33 | TRTPN == 0 ~ 'Pbo', 34 | TRTPN == 54 ~ 'Xan_Lo', 35 | TRTPN == 81 ~ 'Xan_Hi' 36 | ) 37 | ) 38 | 39 | # Create an ordered factor variable for the models 40 | data['TRTPCD_F'] <- factor(data$TRTPCD, levels=c('Xan_Hi', 'Xan_Lo', 'Pbo')) 41 | data['AWEEKC'] = factor(data$AVISIT) 42 | 43 | # Set up the models 44 | if (var == "CHG") { 45 | model1 <- lm(CHG ~ TRTPN + SITEGR1 + BASE, data=data) 46 | model2 <- lm(CHG ~ TRTPCD_F + SITEGR1 + BASE, data=data) 47 | } else { 48 | model1 <- lm(AVAL ~ TRTPN + SITEGR1, data=data) 49 | model2 <- lm(AVAL ~ TRTPCD_F + SITEGR1, data=data) 50 | } 51 | 52 | ## Dose Response --- NOTE: For statistics portions, I purposefully did not 53 | #import the libraries to make it explicitly clear which packages were being 54 | #used to match P-values. 55 | ancova <- drop1(model1, .~., test="F") 56 | 57 | # Pull it out into a table 58 | sect1 <- tibble::tibble(row_label=c('p-value(Dose Response) [1][2]'), 59 | `81` = ifelse(show_pvalue, c(num_fmt(ancova[2, 'Pr(>F)'], int_len=4, digits=3, size=12)), "Not Applicable") 60 | ) %>% 61 | pad_row() 62 | 63 | ## Pairwise Comparisons ---- 64 | # Here's a reference for the emmeans package and how to use it: 65 | # https://cran.r-project.org/web/packages/emmeans/vignettes/confidence-intervals.html 66 | # Adjustments made are in line with the analysis results metadata in the analysis define 67 | # and PROC GLM documentation. 68 | 69 | # Linear model but use treatment group as a factor now 70 | # LS Means and weight proportionately to match OM option on PROC GLM in SAS 71 | lsm <- emmeans::lsmeans(model2, ~TRTPCD_F, weights='proportional') 72 | 73 | # Here on out - it's all the same data manipulation 74 | # Get pairwise contrast and remove P-values adjustment for multiple groups 75 | cntrst_p <- emmeans::contrast(lsm, method="pairwise", adjust=NULL) 76 | # 95% CI 77 | cntrst_ci <- confint(cntrst_p) 78 | 79 | # merge and convert into dataframe 80 | pw_data <- tibble::as_tibble(summary(cntrst_p)) %>% 81 | merge(tibble::as_tibble(cntrst_ci)) %>% 82 | rowwise() %>% 83 | # Create the display strings 84 | mutate( 85 | p = ifelse(show_pvalue, num_fmt(p.value, int_len=4, digits=3, size=12), "Not Applicable"), 86 | diff_se = as.character( 87 | glue::glue('{num_fmt(estimate, int_len=2, digits=1, size=4)} ({num_fmt(SE, int_len=1, digits=2, size=4)})') 88 | ), 89 | ci = as.character( 90 | glue::glue('({num_fmt(lower.CL, int_len=2, digits=1, size=4)};{num_fmt(upper.CL, int_len=1, digits=1, size=3)})') 91 | ) 92 | ) %>% 93 | # Clean out the numeric variables 94 | select(contrast, p, diff_se, ci) %>% 95 | # Transpose 96 | tidyr::pivot_longer(c('p', 'diff_se', 'ci'), names_to = 'row_label') 97 | 98 | # Subset Xan_Lo - Pbo into table variables 99 | xan_lo <- pw_data %>% 100 | filter(contrast == 'Xan_Lo - Pbo') %>% 101 | # Rename to the table display variable 102 | select(`54`=value) %>% 103 | pad_row() 104 | 105 | #Add in row_label 106 | xan_lo['row_label'] <- c('p-value(Xan - Placebo) [1][3]', ' Diff of LS Means (SE)', ' 95% CI', '') 107 | 108 | # Subset Xan_hi - Pbo into table variables 109 | xan_hi <- pw_data %>% 110 | filter(contrast == 'Xan_Hi - Pbo') %>% 111 | # Rename to the table display variable 112 | select(`81`=value) %>% 113 | pad_row() 114 | # Add in row_label 115 | xan_hi['row_label'] <- c('p-value(Xan - Placebo) [1][3]', ' Diff of LS Means (SE)', ' 95% CI', '') 116 | xan_hi['ord'] <- c(1,2,3,4) # Order for sorting 117 | 118 | # Subset Xan_Hi - Xan_Lo into table variable 119 | xan_xan <- pw_data %>% 120 | filter(contrast == 'Xan_Hi - Xan_Lo') %>% 121 | # Rename to the table display variable 122 | select(`81`=value) 123 | # Add in row_label 124 | xan_xan['row_label'] <- c('p-value(Xan High - Xan Low) [1][3]', ' Diff of LS Means (SE)', ' 95% CI') 125 | xan_xan['ord'] <- c(5,6,7) # Order for sorting 126 | 127 | # Pack it all together 128 | pw_final <- merge(xan_lo, xan_hi, by='row_label') %>% 129 | bind_rows(xan_xan) %>% 130 | arrange(ord) 131 | 132 | # Bind and clean up 133 | bind_rows(sect1, pw_final) %>% 134 | select(row_label, 135 | `var1_Xanomeline Low Dose` = `54`, 136 | `var1_Xanomeline High Dose` = `81` 137 | ) 138 | } -------------------------------------------------------------------------------- /R/fmt.R: -------------------------------------------------------------------------------- 1 | #' Format numeric value 2 | #' 3 | #' @inheritParams base::formatC 4 | #' 5 | #' @examples 6 | #' fmt_num(1.25, digits = 1) 7 | #' @export 8 | fmt_num <- function(x, digits, width = digits + 4) { 9 | formatC(x, 10 | digits = digits, 11 | format = "f", 12 | width = width 13 | ) 14 | } 15 | 16 | #' Format point estimator 17 | #' 18 | #' @param .mean mean of an estimator. 19 | #' @param .sd sd of an estimator. 20 | #' @param digits number of digits for `.mean` and `.sd`. 21 | #' 22 | #' @examples 23 | #' fmt_est(1.25, 0.5) 24 | #' @export 25 | fmt_est <- function(.mean, 26 | .sd, 27 | digits = c(1, 2)) { 28 | .mean <- fmt_num(.mean, digits[1], width = digits[1] + 4) 29 | .sd <- fmt_num(.sd, digits[2], width = digits[2] + 3) 30 | paste0(.mean, " (", .sd, ")") 31 | } 32 | 33 | #' Format confidence interval 34 | #' 35 | #' @param .est an estimator. 36 | #' @param .lower lower confidence interval bound of an estimator. 37 | #' @param .upper upper confidence interval bound of an estimator. 38 | #' @param digits number of digits for `.est`, `.lower`, and `.upper`. 39 | #' @param width the total field width. 40 | #' 41 | #' @examples 42 | #' fmt_ci(1, -0.25, 1.32) 43 | #' @export 44 | fmt_ci <- function(.est, 45 | .lower, 46 | .upper, 47 | digits = 2, 48 | width = digits + 3) { 49 | .est <- fmt_num(.est, digits, width) 50 | .lower <- fmt_num(.lower, digits, width) 51 | .upper <- fmt_num(.upper, digits, width) 52 | paste0(.est, " (", .lower, ",", .upper, ")") 53 | } 54 | 55 | #' Format p-Value 56 | #' 57 | #' @param .p a p-value. 58 | #' @param digits number of digits for `.est`, `.lower`, and `.upper`. 59 | #' 60 | #' @examples 61 | #' fmt_pval(0.2) 62 | #' @export 63 | fmt_pval <- function(.p, digits = 3) { 64 | scale <- 10^(-1 * digits) 65 | p_scale <- paste0("<", digits) 66 | ifelse(.p < scale, p_scale, fmt_num(.p, digits = digits)) 67 | } 68 | -------------------------------------------------------------------------------- /R/globals.R: -------------------------------------------------------------------------------- 1 | utils::globalVariables( 2 | c( 3 | "TRT01P", "AGEGR1", "RACE", "EFFFL", "ITTFL", "PARAMCD", "ANL01FL", "TRTPN", 4 | "AVISITN", "p.value", "contrast", "p", "diff_se", 5 | "ci", "value", "ord", "row_label", "54", "81", "row_label1", "ord_layer_index", "row_label2", "ord_layer_1", 6 | "ord_layer_2", "TRTP", "USUBJID", 7 | "sd", "median", "AVAL", "CHG", ".", "TRTP", "BASE", 8 | "SE", "df", "N", "mean_bl", 9 | "sd_bl", "sd", "mean_chg", "sd_chg", 10 | "emmean", "lower.CL", "upper.CL", "Trt", 11 | "CI", "estimate", "lower", "upper", "p.value", 12 | "comp", "SAFFL", "STUDYID", "USUBJID", "TRT01A", 13 | "AVAL", "CNSR", "PARAM", "PARAMCD", "anl", "TRTDUR", "TRTA", "TRTAN", "VISIT", "distinct_n", 14 | "distinct_pct", "var1_Placebo", "var1_Xanomeline High Dose", "var1_Xanomeline Low Dose", 15 | "var1_Total", "N_20", "y_values", "time" 16 | ) 17 | ) -------------------------------------------------------------------------------- /R/helpers.R: -------------------------------------------------------------------------------- 1 | #' Add a padding row below data 2 | #' 3 | #' @param .data Data to pad 4 | #' @param n Number of rows to pad 5 | #' 6 | #' @importFrom stringr str_pad 7 | #' 8 | #' @return Dataframe with extra blank rows 9 | #' @export 10 | pad_row <- function(.data, n=1) { 11 | .data[(nrow(.data)+1):(nrow(.data)+n), ] <- "" 12 | .data 13 | } 14 | 15 | #' Number formatter 16 | #' 17 | #' Format numbers for presentation, with proper rounding of data 18 | #' 19 | #' @param var Variable to format 20 | #' @param digits Desired number of decimal places 21 | #' @param size String size 22 | #' @param int_len Space allotted for integer side of the decimal 23 | #' 24 | #' @return Formatted string 25 | #' @export 26 | num_fmt <- Vectorize(function(var, digits=0, size=10, int_len=3) { 27 | # Formats summary stat strings to align display correctly 28 | 29 | if (is.na(var)) return('') 30 | 31 | # Set nsmall to input digits 32 | nsmall = digits 33 | 34 | # Incremement digits for to compensate for display 35 | if (digits > 0) { 36 | digits = digits + 1 37 | } 38 | 39 | # Form the string 40 | return(str_pad( 41 | format( 42 | # Round 43 | round(var, nsmall), 44 | # Set width of format string 45 | width=(int_len+digits), 46 | # Decimals to display 47 | nsmall=nsmall 48 | ), 49 | # Overall width padding 50 | side='right', size 51 | )) 52 | }) 53 | 54 | #' style a tooltip produced by the tippy package 55 | #' 56 | #' @param text String for text in tooltip 57 | #' @param font_size Font size (in pixels) 58 | #' 59 | #' @return HTML with font size applied 60 | #' @export 61 | tooltip_text <- function(text, font_size = 16) { 62 | glue::glue("{text}") 63 | } 64 | 65 | #' update data file configuration setting 66 | #' 67 | #' @param path path to directory containing data files 68 | #' used within the Shiny application 69 | #' @return Used for side effects 70 | #' @export 71 | set_data_path <- function(path) { 72 | # assertions on path 73 | path <- normalizePath(path, mustWork = FALSE) 74 | 75 | if (!dir.exists(path)) stop(paste("The path", path, "does not exist. Please use a valid directory path"), call. = FALSE) 76 | 77 | # check if data files are present 78 | data_files <- c("adsl.xpt", "adadas.xpt", "adtte.xpt", "adlbc.xpt") 79 | data_check <-sapply(data_files, function(x) file.exists(file.path(path, x))) 80 | 81 | if (!all(data_check)) { 82 | # determine which files are missing 83 | missing_files <- data_files[!data_check] 84 | stop(paste("The following data files are missing in the specified path", path, ":", paste(missing_files, collapse = ", ")), call. = FALSE) 85 | } 86 | 87 | # set golem config option 88 | golem::amend_golem_config("adam_path", path, talkative = FALSE) 89 | invisible(TRUE) 90 | } 91 | 92 | #' check if a filter is active in a teal module 93 | #' 94 | #' @param datasets instance of teal filtered datasets class 95 | #' 96 | #' @return boolean, TRUE if a filter is applied, FALSE otherwise 97 | filter_active <- function(datasets) { 98 | result <- FALSE 99 | if (length(names(datasets$get_filter_state()) > 0)) { 100 | filter_use <- purrr::map_lgl(names(datasets$get_filter_state()), ~{ 101 | # grab call of filter code 102 | f_call <- datasets$get_call(.x)$filter 103 | f_call != glue::glue("{.x}_FILTERED <- {.x}") 104 | }) 105 | result <- any(filter_use) 106 | } 107 | 108 | return(result) 109 | } -------------------------------------------------------------------------------- /R/kmplot_helpers.R: -------------------------------------------------------------------------------- 1 | add_risktable2 <- function(gg, 2 | times = NULL, 3 | statlist = "n.risk", 4 | label = NULL, 5 | group = "strata", 6 | collapse = FALSE, 7 | rowgutter = .16, 8 | risk_font_size = 6.0, 9 | risk_label_font_size = 12, 10 | ...) { 11 | 12 | # User input validation --------------------------------------------------- 13 | 14 | if (!(is.numeric(rowgutter) == TRUE) || (rowgutter < 0) || (rowgutter > 1)) { 15 | stop("rowgutter should be a numeric value in range [0, 1]") 16 | } 17 | 18 | # Obtain the relevant table -------------------------------------------------- 19 | tidy_object <- gg$data 20 | estimate_object <- visR:::.extract_estimate_object(gg) 21 | 22 | ggbld <- ggplot2::ggplot_build(gg) 23 | 24 | graphtimes <- as.numeric(ggbld$layout$panel_params[[1]]$x$get_labels()) 25 | 26 | if (is.null(times)) times <- graphtimes 27 | 28 | final <- 29 | visR:::get_risktable(estimate_object, 30 | times = times, 31 | statlist = statlist, 32 | label = label, 33 | group = group, 34 | collapse = collapse 35 | ) 36 | 37 | times <- as.numeric(unique(final$time)) 38 | statlist <- attributes(final)$statlist 39 | title <- attributes(final)$title 40 | 41 | attr(final, "time_ticks") <- NULL 42 | attr(final, "statlist") <- NULL 43 | attr(final, "title") <- NULL 44 | 45 | # Plot requested tables below using list approach with map function ------- 46 | 47 | tbls <- 48 | base::Map(function(statlist, title = NA) { 49 | ggrisk <- ggplot2::ggplot( 50 | final, 51 | ggplot2::aes( 52 | x = time, 53 | y = stats::reorder(y_values, dplyr::desc(y_values)), 54 | label = format(get(statlist), nsmall = 0) # = value columns 55 | ) 56 | ) + 57 | ggplot2::geom_text(size = risk_font_size, hjust = 0.5, vjust = 0.5, angle = 0, show.legend = FALSE) + 58 | ggplot2::theme_bw() + 59 | ggplot2::scale_x_continuous( 60 | breaks = graphtimes, 61 | limits = c(min(graphtimes), max(graphtimes)) 62 | ) + 63 | ggplot2::theme( 64 | axis.title.x = ggplot2::element_text( 65 | size = 8, 66 | vjust = 1, 67 | hjust = 1 68 | ), 69 | panel.grid.major = ggplot2::element_blank(), 70 | panel.grid.minor = ggplot2::element_blank(), 71 | panel.border = ggplot2::element_blank(), 72 | axis.line = ggplot2::element_blank(), 73 | axis.text.x = ggplot2::element_blank(), 74 | axis.ticks = ggplot2::element_blank(), 75 | axis.text.y = ggplot2::element_text(size = risk_label_font_size, colour = "black", face = "plain"), 76 | plot.margin = ggplot2::unit(c(1, 0, 0, 0), "lines"), 77 | plot.title = ggplot2::element_text(hjust = 0, vjust = 0), 78 | legend.position = "none" 79 | ) + 80 | ggplot2::xlab(NULL) + 81 | ggplot2::ylab(NULL) 82 | 83 | if (!is.na(title) && !is.null(title)) { 84 | ggrisk <- ggrisk + 85 | ggplot2::ggtitle(title) + 86 | ggplot2::theme(plot.title = ggplot2::element_text(size = 10)) 87 | } 88 | 89 | return(ggrisk) 90 | }, 91 | statlist = as.list(statlist), 92 | title = as.list(title) 93 | ) 94 | 95 | # Align plot and table by adjusting width --------------------------------- 96 | 97 | gglist <- list(gg) %>% 98 | base::append(tbls) 99 | 100 | ggA <- gglist %>% 101 | visR:::align_plots() 102 | 103 | # Create plot and add class ----------------------------------------------- 104 | 105 | ## cowplot allows to align according to an axis (+left) and change the heigth 106 | ggB <- cowplot::plot_grid( 107 | plotlist = ggA, 108 | align = "none", 109 | nrow = length(ggA), 110 | rel_heights = c(1 - (rowgutter * (length(ggA) - 1)), rep(rowgutter, length(ggA) - 1)) 111 | ) 112 | 113 | class(ggB) <- c(class(ggB), intersect(class(gg), c("ggsurvfit", "ggtidycmprsk"))) 114 | 115 | # Add individual components ----------------------------------------------- 116 | 117 | components <- append(list(gg), tbls) 118 | names(components) <- c("visR_plot", title) 119 | ggB[["components"]] <- components 120 | 121 | return(ggB) 122 | } 123 | -------------------------------------------------------------------------------- /R/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/run_app.R: -------------------------------------------------------------------------------- 1 | #' Run the Shiny Application 2 | #' 3 | #' @param ... arguments to pass to golem_opts. 4 | #' See `?golem::get_golem_options` for more details. 5 | #' @inheritParams shiny::shinyApp 6 | #' 7 | #' @export 8 | #' @importFrom shiny shinyApp 9 | #' @importFrom golem with_golem_options 10 | run_app <- function( 11 | onStart = NULL, 12 | options = list(), 13 | enableBookmarking = NULL, 14 | uiPattern = "/", 15 | ... 16 | ) { 17 | app <- create_teal() 18 | with_golem_options( 19 | app = shinyApp( 20 | ui = app$ui, 21 | server = app$server, 22 | onStart = onStart, 23 | options = options, 24 | enableBookmarking = enableBookmarking, 25 | uiPattern = uiPattern 26 | ), 27 | golem_opts = list(...) 28 | ) 29 | } 30 | -------------------------------------------------------------------------------- /R/tm_g_kmplot.R: -------------------------------------------------------------------------------- 1 | #' ui_g_kmplot UI Function 2 | #' 3 | #' @description A shiny Module. 4 | #' 5 | #' @param id,input,output,session Internal parameters for {shiny}. 6 | #' 7 | #' @noRd 8 | #' 9 | #' @importFrom shiny NS tagList plotOutput 10 | ui_g_kmplot <- function(id, datasets) { 11 | ns <- NS(id) 12 | tagList( 13 | shinyWidgets::alert( 14 | tagList( 15 | tags$b("Important Information:"), 16 | tags$p("The analyses performed when utilizing subgroups or other subsets of the source data sets are considered ", tags$b("exploratory.")), 17 | tags$ul( 18 | tags$li("Treatment information variables from the", tags$b("ADTTE"), "data set are excluded from the variable list. Use the treatment variables present in the", tags$b("ADSL"), "set to perform treatment-related filters."), 19 | tags$li("In rare situations, applying filters with variables from both", tags$b("ADSL"), "and", tags$b("ADTTE"), "that overlap in content could result in an invalid data subset. When possible, select variables with distinct content.") 20 | ) 21 | ), 22 | status = "info", 23 | dismissible = TRUE 24 | ), 25 | h4("Figure 14-1"), 26 | h4("Time to Dermatologic Event by Treatment Group"), 27 | plotOutput(ns("plot"), height = "800px") 28 | ) 29 | } 30 | 31 | #' srv_g_kmplot Server Functions 32 | #' 33 | #' @noRd 34 | #' @importFrom shiny renderPlot 35 | #' @import ggplot2 36 | srv_g_kmplot <- function(input, output, session, datasets) { 37 | output$plot <- renderPlot({ 38 | adsl <- datasets$get_data("ADSL", filtered = TRUE) 39 | adtte <- datasets$get_data("ADTTE", filtered = TRUE) 40 | anl <<- adsl %>% 41 | dplyr::filter( 42 | SAFFL == "Y", 43 | STUDYID == "CDISCPILOT01" 44 | ) %>% 45 | dplyr::select(STUDYID, USUBJID, TRT01A) %>% 46 | dplyr::inner_join( 47 | filter( 48 | adtte, STUDYID == "CDISCPILOT01" 49 | ) %>% select(STUDYID, USUBJID, AVAL, CNSR, PARAM, PARAMCD), 50 | by = c("STUDYID", "USUBJID") 51 | ) %>% 52 | dplyr::mutate( 53 | TRT01A = factor(TRT01A, levels = c("Placebo", "Xanomeline Low Dose", "Xanomeline High Dose")), 54 | AVAL = AVAL/30.4167 55 | ) 56 | # detect the error 57 | shiny::validate( 58 | shiny::need(nrow(anl) > 5, "Not enough observations for this selection. Modify filters and try again.") 59 | ) 60 | 61 | ## ----------------------------------------------------------------------------------------------------------------------------------- 62 | # estimate survival 63 | surv_mod <- visR::estimate_KM(data = anl, strata = "TRT01A") 64 | 65 | # 66 | # # save plot 67 | ggplot2::theme_set(theme_bw()) 68 | 69 | KM <- visR::visr(surv_mod, 70 | y_label = "Survival Probability (%)", 71 | x_label = "Time (Months)", 72 | fun = "pct", 73 | legend_position = "bottom" ) %>% 74 | visR::add_CNSR() %>% 75 | visR::add_CI() 76 | 77 | KM <- KM + 78 | ggplot2::theme(axis.text = element_text(size = rel(1.3)), 79 | axis.title = element_text(size = rel(1.4)), 80 | legend.text = element_text(size = rel(1.3)), 81 | legend.title = element_text(size = rel(1.4))) + 82 | ggplot2::geom_hline(yintercept=0.5, linetype = "dashed") 83 | 84 | KM <- KM %>% 85 | add_risktable2(group = "statlist") 86 | 87 | title <- cowplot::ggdraw() + 88 | cowplot::draw_label( 89 | "KM plot for Time to First Dermatologic Event: Safety population\n", 90 | fontfamily = "sans", 91 | fontface = "bold", 92 | size=16 93 | ) 94 | 95 | caption <- cowplot::ggdraw() + 96 | cowplot::draw_label( 97 | paste( 98 | "The shaded areas are 95% CI of the survival probability for each group", 99 | "\n", 100 | paste0(Sys.time()) 101 | ), 102 | fontfamily = "sans", 103 | size=12 104 | ) 105 | 106 | KM <- cowplot::plot_grid( 107 | title, KM, caption, 108 | ncol = 1, 109 | rel_heights = c(0.1,0.8,0.1) 110 | ) 111 | KM 112 | }) 113 | } -------------------------------------------------------------------------------- /R/tm_i_usage.R: -------------------------------------------------------------------------------- 1 | #' ui_i_usage UI Function 2 | #' 3 | #' @description A shiny Module. 4 | #' 5 | #' @param id,input,output,session Internal parameters for {shiny}. 6 | #' 7 | #' @noRd 8 | #' 9 | #' @importFrom shiny NS tagList plotOutput tags fluidRow column tabsetPanel tabPanel imageOutput 10 | #' @importFrom reactable reactableOutput 11 | ui_i_usage <- function(id, datasets) { 12 | ns <- NS(id) 13 | tagList( 14 | fluidRow( 15 | column( 16 | width = 12, 17 | tags$h1("Application Guide"), 18 | tags$p("The Pilot 2 Shiny Application contains five distinct interfaces, each displaying a different analysis output as described in the App Information page."), 19 | reactableOutput(ns("pilot1_table")) 20 | ) 21 | ), 22 | tags$br(), 23 | fluidRow( 24 | column( 25 | width = 12, 26 | tags$h2("Dynamic Filters"), 27 | tags$p("The", tags$b("KM Plot for TTDE"), "module allows for filters to be applied based on variables in the", tags$b("ADSL"), "and", tags$b("ADTTE"), "data sets. Below is an example of performing subpopulation analysis for an age group within the module:"), 28 | tags$br(), 29 | tabsetPanel( 30 | type = "tabs", 31 | tabPanel( 32 | title = "Step 1", 33 | fluidRow( 34 | column( 35 | width = 4, 36 | imageOutput(ns("step1_image")) 37 | ), 38 | column( 39 | width = 8, 40 | tags$p("Within the", tags$b("Add Filter Variables"), "widget, click the box with the placeholder", tags$b("Select variables to filter")) 41 | ) 42 | ) 43 | ), 44 | tabPanel( 45 | title = "Step 2", 46 | column( 47 | width = 4, 48 | imageOutput(ns("step2_image")) 49 | ), 50 | column( 51 | width = 8, 52 | tags$p("Scroll up/down or use the search bar to find the variable for subpopulation. Click the desired variable, ", tags$b("AGEYR1"), "in this example") 53 | ) 54 | ), 55 | tabPanel( 56 | title = "Step 3", 57 | column( 58 | width = 4, 59 | imageOutput(ns("step3_image")) 60 | ), 61 | column( 62 | width = 8, 63 | tags$p("In the", tags$b("Active Filter Variables"), "widget, the selected variable with its available categories or levels will display,", tags$b("AGEYR1"), "in this example, is displayed with three categories. If the selected variable in the previous step is a continuous variable, then a slider will appear for selecting a range of values."), 64 | tags$br(), 65 | tags$p("Select the target subpopulation (e.g. >80) and the analysis output displayed on the left hand side will be updated in real-time according to the selection, which in this example is equivalent to performing a filter on the", tags$b("ADSL"), "data by AGEGR1 == '>80'") 66 | ) 67 | ) 68 | ) 69 | ) 70 | ) 71 | ) 72 | } 73 | 74 | #' @importFrom reactable reactable renderReactable colGroup colDef 75 | #' @importFrom shiny renderImage 76 | srv_i_usage <- function(input, output, session, datasets) { 77 | output$pilot1_table <- renderReactable({ 78 | # contents of table 79 | pilot1_table <- tibble::tribble( 80 | ~tab, ~output, 81 | "Demographic Table", "Table 14-2.01 Summary of Demographic and Baseline Characteristics", 82 | "KM Plot for TTDE", "Figure 14-1 Time to Dermatologic Event by Treatment Group", 83 | "Primary Table", "Table 14-3.01 Primary Endpoint Analysis: ADAS Cog(11) - Change from Baseline to Week 24 - LOCF", 84 | "Efficacy Table", "Table 14-3.02 Primary Endpoint Analysis: Glucose (mmol/L) - Summary at Week 20 - LOCF", 85 | "Visit Completion Table", "Not Applicable" 86 | ) 87 | 88 | reactable(pilot1_table) 89 | }) 90 | 91 | output$step1_image <- renderImage({ 92 | list( 93 | src = app_sys("app", "www", "app_screenshot2.png"), 94 | alt = "Filter Screenshot 1", 95 | width = "85%" 96 | ) 97 | }, deleteFile = FALSE) 98 | 99 | output$step2_image <- renderImage({ 100 | list( 101 | src = app_sys("app", "www", "app_screenshot3.png"), 102 | alt = "Filter Screenshot 2", 103 | width = "90%" 104 | ) 105 | }, deleteFile = FALSE) 106 | 107 | output$step3_image <- renderImage({ 108 | list( 109 | src = app_sys("app", "www", "app_screenshot4.png"), 110 | alt = "Filter Screenshot 3", 111 | width = "90%" 112 | ) 113 | }, deleteFile = FALSE) 114 | } -------------------------------------------------------------------------------- /R/tm_t_demographic.R: -------------------------------------------------------------------------------- 1 | #' ui_t_demographic UI Function 2 | #' 3 | #' @description A shiny Module. 4 | #' 5 | #' @param id,input,output,session Internal parameters for {shiny}. 6 | #' 7 | #' @noRd 8 | #' 9 | #' @importFrom shiny NS tagList uiOutput 10 | #' @importFrom stats median sd 11 | ui_t_demographic <- function(id, datasets) { 12 | ns <- NS(id) 13 | tagList( 14 | h4("Table 14-2.01"), 15 | h4("Summary of Demographic and Baseline Characteristics"), 16 | uiOutput(ns("table")) 17 | ) 18 | } 19 | 20 | #' srv_t_demographic Server Functions 21 | #' 22 | #' @noRd 23 | #' @importFrom shiny renderUI 24 | #' @import rtables 25 | srv_t_demographic <- function(input, output, session, datasets) { 26 | output$table <- renderUI({ 27 | ADSL_FILTERED <- datasets$get_data("ADSL", filtered = FALSE) 28 | vars <- c("AGE", "AGEGR1", "RACE", "HEIGHTBL", "WEIGHTBL", "BMIBL") 29 | labels <- datasets$get_varlabels("ADSL", vars) 30 | labels <- vapply(vars, function(x) ifelse(is.na(labels[[x]]), 31 | x, labels[[x]]), character(1)) 32 | labels["AGEGR1"] <- "Age group" 33 | labels["AGE"] <- "Age (year)" 34 | labels["RACE"] <- "Race" 35 | lyt <- basic_table(title = "", 36 | subtitles = character(), 37 | main_footer = paste("Program: tm_t_demographic.R", Sys.time()) 38 | ) %>% 39 | split_cols_by("TRT01P") %>% 40 | add_colcounts() %>% 41 | analyze(vars, function(x, ...) { 42 | if (is.numeric(x)) { 43 | in_rows( 44 | "Mean (SD)" = c(mean(x), sd(x)), 45 | "Median" = median(x), 46 | "Min - Max" = range(x), 47 | .formats = c("xx.xx (xx.xx)", "xx.xx", "xx.xx - xx.xx") 48 | ) 49 | } else if (is.factor(x) || is.character(x)) { 50 | in_rows(.list = list_wrap_x(table)(x)) 51 | } else { 52 | stop("type not supproted") 53 | } 54 | }, 55 | var_labels = labels) 56 | tbl <- build_table(lyt, ADSL_FILTERED) 57 | as_html(tbl) 58 | 59 | }) 60 | 61 | } -------------------------------------------------------------------------------- /R/tm_t_disposition.R: -------------------------------------------------------------------------------- 1 | #' ui_t_disposition UI Function 2 | #' 3 | #' @description A shiny Module. 4 | #' 5 | #' @param id,input,output,session Internal parameters for {shiny}. 6 | #' 7 | #' @noRd 8 | #' 9 | #' @importFrom shiny NS tagList uiOutput 10 | ui_t_disposition <- function(id, datasets) { 11 | ns <- NS(id) 12 | tagList( 13 | h4("Table 14-4.01"), 14 | h4("Visit Completion"), 15 | uiOutput(ns("table")), 16 | p("Table is based on participants within the ITT population") 17 | ) 18 | } 19 | 20 | #' srv_t_primary Server Functions 21 | #' 22 | #' @noRd 23 | #' @importFrom shiny renderUI 24 | #' @import Tplyr 25 | #' @import dplyr 26 | srv_t_disposition <- function(input, output, session, datasets) { 27 | output$table <- renderUI({ 28 | ADSL_FILTERED <- datasets$get_data("ADSL", filtered = FALSE) 29 | ADLB_FILTERED <- datasets$get_data("ADLB", filtered = FALSE) 30 | adsl <- ADSL_FILTERED 31 | adlbc <- ADLB_FILTERED 32 | 33 | # use adlbc data set to remain consistent with efficacy table input data 34 | visit_df <- adlbc %>% 35 | filter(PARAMCD == "GLUC") %>% 36 | filter(AVISITN != 98) %>% 37 | filter(!is.na(AVISITN)) %>% 38 | select(USUBJID, AVISITN) %>% 39 | distinct() %>% 40 | left_join( 41 | select(adsl, USUBJID, TRT01P), 42 | by = "USUBJID" 43 | ) 44 | 45 | # visit number and week lookup 46 | v_week_df <- tibble::tibble( 47 | AVISITN = c(0, 2, 4, 6, 8, 12, 16, 20, 24, 26, 99), 48 | VISIT = c("Baseline ", paste("Week", c(2, 4, 6, 8, 12, 16, 20, 24, 26)), "End of Treatment") 49 | )%>% 50 | mutate(VISIT = factor(VISIT, levels = c("Baseline ", paste("Week", c(2, 4, 6, 8, 12, 16, 20, 24, 26)), "End of Treatment"))) 51 | 52 | # build Tplyr table 53 | t_visit <- visit_df %>% 54 | left_join(v_week_df, by = "AVISITN") %>% 55 | tplyr_table(TRT01P) %>% 56 | set_pop_data(adsl) %>% 57 | set_pop_treat_var(TRT01P) %>% 58 | add_total_group() %>% 59 | add_layer( 60 | group_count(VISIT) %>% 61 | set_distinct_by(USUBJID) %>% 62 | set_format_strings( 63 | f_str('xx (xx%)', distinct_n, distinct_pct) 64 | ) 65 | ) 66 | 67 | b_t_visit <- t_visit %>% 68 | build() %>% 69 | dplyr::select(row_label1, var1_Placebo, `var1_Xanomeline High Dose`, `var1_Xanomeline Low Dose`, var1_Total) %>% 70 | add_column_headers( 71 | paste0("|Placebo
(N=**Placebo**)", 72 | "| Xanomeline High Dose
(N=**Xanomeline High Dose**) ", 73 | "| Xanomeline Low Dose
(N=**Xanomeline Low Dose**) ", 74 | "| Total
(N=**Total**) "), 75 | header_n(t_visit) 76 | ) 77 | 78 | ht <- huxtable::as_hux(b_t_visit, add_colnames = FALSE) %>% 79 | huxtable::set_bold(1, 1:ncol(b_t_visit), TRUE) %>% 80 | huxtable::set_align(1, 1:ncol(b_t_visit), 'center') %>% 81 | huxtable::set_valign(1, 1:ncol(b_t_visit), 'bottom') %>% 82 | huxtable::set_bottom_border(1, 1:ncol(b_t_visit), 1) %>% 83 | huxtable::set_width(0.9) %>% 84 | huxtable::set_escape_contents(FALSE) %>% 85 | huxtable::set_col_width(c(.5, 1/8, 1/8, 1/8, 1/8)) 86 | htmltools::HTML(huxtable::to_html(ht)) 87 | }) 88 | 89 | } 90 | -------------------------------------------------------------------------------- /R/tm_t_efficacy.R: -------------------------------------------------------------------------------- 1 | #' ui_t_efficacy UI Function 2 | #' 3 | #' @description A shiny Module. 4 | #' 5 | #' @param id,input,output,session Internal parameters for {shiny}. 6 | #' 7 | #' @noRd 8 | #' 9 | #' @importFrom shiny NS tagList fluidRow h4 h6 column fluidPage 10 | #' @importFrom graphics pairs 11 | #' @importFrom stats lm sd 12 | #' @import tippy 13 | ui_t_efficacy <- function(id, datasets) { 14 | ns <- NS(id) 15 | fluidPage( 16 | tags$br(), 17 | tags$br(), 18 | fluidRow( 19 | h4("Table 14-3.02"), 20 | h4("Primary Endpoint Analysis: Glucose (mmol/L) - Summary at Week 20 LOCF"), 21 | tags$br(),tags$br(), 22 | column( 23 | width=10, 24 | tippy::tippy( 25 | tags$div( 26 | align = "center", 27 | h4("ANCOVA of Change from Baseline at Week 20") 28 | ), 29 | tooltip = tooltip_text("Table is based on participants who have observable data at Baseline and Week 20", 16), 30 | allowHTML = TRUE 31 | ), 32 | reactable::reactableOutput(ns("tbl_efficacy_1")) 33 | ) 34 | ), 35 | 36 | tags$br(), 37 | tags$br(), 38 | tags$hr(), 39 | fluidRow( 40 | tippy::tippy( 41 | tags$div( 42 | align = "center", 43 | h4("Pairwise Comparison") 44 | ), 45 | tooltip = tooltip_text("Inference in this table is based on a Analysis of Covariance (ANCOVA) model with treatment and baseline value as covariates.", 16), 46 | allowHTML = TRUE 47 | ), 48 | tags$br(), 49 | tags$br(), 50 | column( 51 | width=10, 52 | reactable::reactableOutput(ns("tbl_efficacy_2")) 53 | ) 54 | ), 55 | tags$br(), 56 | tags$br(), 57 | tags$hr(), 58 | fluidRow( 59 | h6(tags$i("Abbreviations: CI=Confidence Interval; LS=Least Squares; SD=Standard Deviation")), 60 | h6(tags$p("Table is based on participants who had observable data at Baseline and Week 20")), 61 | h6(tags$p("Based on an Analysis of Covariance (ANCOVA) model with treatment and baseline value as covariates")) 62 | ) 63 | ) 64 | } 65 | 66 | #' srv_t_efficacy Server Functions 67 | #' 68 | #' @noRd 69 | #' @importFrom shiny reactive 70 | #' @importFrom reactable reactable renderReactable colGroup colDef 71 | #' @importFrom dplyr filter group_by summarise mutate select n filter 72 | srv_t_efficacy <- function(input, output, session, datasets) { 73 | efficacy_results <- reactive({ 74 | adsl <- datasets$get_data("ADSL", filtered = FALSE) 75 | 76 | itt <- adsl %>% 77 | filter(ITTFL == "Y") %>% 78 | select("STUDYID", "USUBJID") 79 | 80 | adlb <- datasets$get_data("ADLB", filtered = FALSE) 81 | 82 | # prepare labs data for pairwise comparison 83 | adlb1 <- adlb %>% 84 | right_join(itt, by = c("STUDYID", "USUBJID")) %>% 85 | filter(TRTPN %in% c(0, 81), PARAMCD == "GLUC", !is.na(AVISITN)) %>% 86 | mutate(TRTPN = ifelse(TRTPN == 0, 99, TRTPN)) 87 | 88 | gluc_lmfit <- adlb1 %>% 89 | filter(AVISITN == 20) %>% 90 | lm(CHG ~ BASE + TRTPN, data = .) 91 | 92 | t10 <- adlb1 %>% 93 | filter(AVISITN == 0) %>% 94 | group_by(TRTPN, TRTP) %>% 95 | summarise( 96 | N = n(), 97 | mean_bl = mean(BASE), 98 | sd_bl = sd(BASE) 99 | ) 100 | 101 | ## Raw summary statistics 102 | t11 <- adlb1 %>% 103 | filter(AVISITN == 20, !is.na(CHG), !is.na(BASE)) %>% 104 | group_by(TRTPN, TRTP) %>% 105 | summarise( 106 | N_20 = n(), 107 | mean_chg = mean(CHG), 108 | sd_chg = sd(CHG), 109 | mean = mean(AVAL), 110 | sd = sd(AVAL) 111 | ) 112 | 113 | ## Calculate LS mean 114 | t12 <- emmeans::emmeans(gluc_lmfit, "TRTPN") 115 | 116 | ## Merge and format data for reporting 117 | apr0ancova1 <- merge(t10, t11) %>% 118 | merge(t12) %>% 119 | mutate(emmean_sd = SE * sqrt(df)) %>% 120 | mutate( 121 | Trt = c("Xanomeline High Dose", "Placebo"), 122 | N1 = N, 123 | Mean1 = fmt_est(mean_bl, sd_bl), 124 | N2 = N_20, 125 | Mean2 = fmt_est(mean, sd), 126 | N3 = N_20, 127 | Mean3 = fmt_est(mean_chg, sd_chg), 128 | CI = fmt_ci(emmean, lower.CL, upper.CL) 129 | ) %>% 130 | select(Trt:CI) 131 | 132 | 133 | ## ----------------------------------------------------------------------------------------------------------------------------------- 134 | t2 <- data.frame(pairs(t12)) 135 | 136 | ## Treatment Comparison 137 | apr0ancova2 <- t2 %>% 138 | mutate( 139 | lower = estimate - 1.96 * SE, 140 | upper = estimate + 1.96 * SE 141 | ) %>% 142 | mutate( 143 | comp = "Study Drug vs. Placebo", 144 | mean = fmt_ci(estimate, lower, upper), 145 | p = fmt_pval(p.value) 146 | ) %>% 147 | select(comp:p) 148 | 149 | ## ----------------------------------------------------------------------------------------------------------------------------------- 150 | ### Calculate root mean square and save data in output folder 151 | apr0ancova3 <- data.frame(rmse = paste0( 152 | "Root Mean Squared Error of Change = ", 153 | formatC(sqrt(mean((gluc_lmfit$residuals)^2)), digits = 2, format = "f", flag = "0") 154 | )) 155 | list( 156 | apr0ancova1 = apr0ancova1, 157 | apr0ancova2 = apr0ancova2, 158 | apr0ancova3 = apr0ancova3 159 | ) 160 | }) 161 | output$tbl_efficacy_1 <- reactable::renderReactable({ 162 | efficacy_results <- efficacy_results() 163 | apr0ancova1 <- efficacy_results$apr0ancova1 164 | coln =c("Treatment", 165 | "N","Mean (SD)", 166 | "N","Mean (SD)", 167 | "N","Mean (SD)","LS Mean (95% CI)") 168 | colgr=c(1,2,2,3,3,4,4,4) 169 | colwidths <- c(rep(100, 7), 150) 170 | colgrn=c("","Baseline","Week 20","Change from Baseline") 171 | collist = purrr::map2(1:ncol(apr0ancova1), colwidths, ~{ 172 | colDef(name = coln[.x], minWidth = .y) 173 | }) 174 | names(collist) = names(apr0ancova1) 175 | reactable( 176 | apr0ancova1, 177 | columns = collist, 178 | columnGroups = list( 179 | colGroup(name = colgrn[2], columns = names(apr0ancova1)[colgr==2]), 180 | colGroup(name = colgrn[3], columns = names(apr0ancova1)[colgr==3]), 181 | colGroup(name = colgrn[4], columns = names(apr0ancova1)[colgr==4]) 182 | ) 183 | ) 184 | }) 185 | output$tbl_efficacy_2 <- reactable::renderReactable({ 186 | efficacy_results <- efficacy_results() 187 | apr0ancova2 <- efficacy_results$apr0ancova2 188 | apr0ancova3 <- efficacy_results$apr0ancova3 189 | coln =c("", 190 | "Difference in LS Mean (95% CI)", 191 | "p-Value") 192 | collist = lapply(1:ncol(apr0ancova2),function(xx){ 193 | if(xx>1){colDef(name=coln[xx]) 194 | }else{colDef(name=coln[xx],footer=apr0ancova3$rmse)} 195 | }) 196 | names(collist) = names(apr0ancova2) 197 | 198 | reactable( 199 | apr0ancova2, 200 | columns = collist, 201 | defaultColDef = colDef(footerStyle = list(fontStyle = "italic")) 202 | ) 203 | }) 204 | } -------------------------------------------------------------------------------- /R/tm_t_primary.R: -------------------------------------------------------------------------------- 1 | #' ui_t_primary UI Function 2 | #' 3 | #' @description A shiny Module. 4 | #' 5 | #' @param id,input,output,session Internal parameters for {shiny}. 6 | #' 7 | #' @noRd 8 | #' 9 | #' @importFrom shiny NS tagList uiOutput 10 | ui_t_primary <- function(id, datasets) { 11 | ns <- NS(id) 12 | tagList( 13 | h4("Table 14-3.01"), 14 | h4("Primary Endpoint Analysis: ADAS Cog(11) - Change from Baseline to Week 24 - LOCF"), 15 | uiOutput(ns("table")), 16 | p("Statistical model and comparison p-values removed when applying data filters. Refer to the application information for additional details."), 17 | p("[1] Based on Analysis of covariance (ANCOVA) model with treatment and site group as factors and baseline value as a covariate."), 18 | p("[2] Test for a non-zero coefficient for treatment (dose) as a continuous variable."), 19 | p("[3] Pairwise comparison with treatment as a categorical variable: p-values without adjustment for multiple comparisons.") 20 | ) 21 | } 22 | 23 | #' srv_t_primary Server Functions 24 | #' 25 | #' @noRd 26 | #' @importFrom shiny renderUI 27 | #' @import Tplyr 28 | srv_t_primary <- function(input, output, session, datasets) { 29 | output$table <- renderUI({ 30 | ADSL_FILTERED <- datasets$get_data("ADSL", filtered = FALSE) 31 | ADAS_FILTERED <- datasets$get_data("ADAS", filtered = FALSE) 32 | adas <- ADAS_FILTERED 33 | 34 | ## ----------------------------------------------------------------------------------------------------------------------------------- 35 | t <- tplyr_table(adas, TRTP) %>% 36 | set_pop_data(ADSL_FILTERED) %>% 37 | set_pop_treat_var(TRT01P) %>% 38 | set_pop_where(EFFFL == "Y" & ITTFL == "Y") %>% 39 | set_distinct_by(USUBJID) %>% 40 | set_desc_layer_formats( 41 | 'n' = f_str('xx', n), 42 | 'Mean (SD)' = f_str('xx.x (xx.xx)', mean, sd), 43 | 'Median (Min; Max)' = f_str('xx.x (xxx;xx)', median, min, max) 44 | ) %>% 45 | add_layer( 46 | group_desc(AVAL, where= AVISITN == 0, by = "Baseline") 47 | ) %>% 48 | add_layer( 49 | group_desc(AVAL, where= AVISITN == 24, by = "Week 24") 50 | ) %>% 51 | add_layer( 52 | group_desc(CHG, where= AVISITN == 24, by = "Change from Baseline") 53 | ) 54 | 55 | sum_data <- t %>% 56 | build() %>% 57 | nest_rowlabels() %>% 58 | dplyr::select(-starts_with('ord')) %>% 59 | add_column_headers( 60 | paste0("|Placebo
(N=**Placebo**)| Xanomeline High Dose
(N=**Xanomeline High Dose**) ", 61 | "| Xanomeline Low Dose
(N=**Xanomeline Low Dose**)"), 62 | header_n(t) 63 | ) 64 | 65 | 66 | ## ----------------------------------------------------------------------------------------------------------------------------------- 67 | model_portion <- efficacy_models(adas, var = 'CHG', wk = 24, show_pvalue = TRUE) 68 | 69 | 70 | ## ----------------------------------------------------------------------------------------------------------------------------------- 71 | final <- dplyr::bind_rows(sum_data, model_portion) 72 | 73 | ht <- huxtable::as_hux(final, add_colnames = FALSE) %>% 74 | huxtable::set_bold(1, 1:ncol(final), TRUE) %>% 75 | huxtable::set_align(1, 1:ncol(final), 'center') %>% 76 | huxtable::set_valign(1, 1:ncol(final), 'bottom') %>% 77 | huxtable::set_bottom_border(1, 1:ncol(final), 1) %>% 78 | huxtable::set_width(1) %>% 79 | huxtable::set_escape_contents(FALSE) %>% 80 | huxtable::set_col_width(c(.5, 1/6, 1/6, 1/6)) 81 | htmltools::HTML(huxtable::to_html(ht)) 82 | }) 83 | 84 | } 85 | -------------------------------------------------------------------------------- /R/utils-pipe.R: -------------------------------------------------------------------------------- 1 | #' Pipe operator 2 | #' 3 | #' See \code{magrittr::\link[magrittr:pipe]{\%>\%}} for details. 4 | #' 5 | #' @name %>% 6 | #' @rdname pipe 7 | #' @keywords internal 8 | #' @export 9 | #' @importFrom magrittr %>% 10 | #' @usage lhs \%>\% rhs 11 | #' @param lhs A value or the magrittr placeholder. 12 | #' @param rhs A function call using the magrittr semantics. 13 | #' @return The result of calling `rhs(lhs)`. 14 | NULL 15 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | --- 2 | output: 3 | html_document: default 4 | pdf_document: default 5 | --- 6 | 7 | 8 | [![R-CMD-check](https://github.com/RConsortium/submissions-pilot2/workflows/R-CMD-check/badge.svg)](https://rconsortium.github.io/submissions-pilot2/) 9 | 10 | 11 | ## Overview 12 | 13 | The objective of the R Consortium R submission Pilot 2 Project is to test the concept that a Shiny application created with the R-language can be successfully bundled into a submission package and transferred successfully to FDA reviewers. The application was built using the source data sets and analyses contained in the R submission Pilot 1 Project, with materials available on the [RConsortium/submissions-pilot1](https://github.com/RConsortium/submissions-pilot1) repository, All submission materials and communications from this pilot are publicly available, with the aim of providing a working example for future R language based FDA submissions. This is a FDA-industry collaboration through the non-profit organization R consortium. 14 | 15 | While the intent of the project is to enable execution of the Shiny application in a reviewer's local R environment, a deployed version of the application is available in open access through the Shinyapps.io service at [rconsortium.shinyapps.io/submissions-pilot2](https://rconsortium.shinyapps.io/submissions-pilot2/). 16 | 17 | The [working group website](https://rconsortium.github.io/submissions-wg/). 18 | 19 | The [RConsortium/submissions-pilot2](https://github.com/RConsortium/submissions-pilot2) demonstrates an approach to organize a Shiny application as an R package. 20 | 21 | The [RConsortium/submissions-pilot2-to-fda](https://github.com/RConsortium/submissions-pilot2-to-fda) 22 | repo demonstrates the eCTD submission package based on the [RConsortium/submissions-pilot2](https://github.com/RConsortium/submissions-pilot2) repo. 23 | 24 | ## Meeting Minutes 25 | 26 | [Repo wiki](https://github.com/RConsortium/submissions-pilot2/wiki) 27 | 28 | ## FDA response 29 | 30 | [2023/09/28] Pilot 2 (shiny) FDA response letter received! [link](https://github.com/RConsortium/submissions-wg/blob/0f1dc5c30985d413f75d196c2b6caa96231b26ee/_Documents/Summary_R_Pilot2_Submission%2027SEP2023.pdf) 31 | 32 | ## Installing `teal` : 33 | 34 | Follow the link [here](https://github.com/insightsengineering/depository#readme) 35 | 36 | ## Running application 37 | 38 | * Clone this repository to your local machine 39 | * Open the project within RStudio, and run `renv::restore()` if prompted to restore the `{renv}` package library 40 | * Open the `app.R` script and run the application within RStudio by clicking the Run App button 41 | -------------------------------------------------------------------------------- /_pkgdown.yml: -------------------------------------------------------------------------------- 1 | destination: docs 2 | template: 3 | package: pilot2 4 | -------------------------------------------------------------------------------- /app.R: -------------------------------------------------------------------------------- 1 | # Launch the ShinyApp (Do not remove this comment) 2 | # To deploy, run: rsconnect::deployApp() 3 | # Or use the blue button on top of this file 4 | 5 | pkgload::load_all(export_all = FALSE,helpers = FALSE,attach_testthat = FALSE) 6 | options( "golem.app.prod" = TRUE) 7 | pilot2wrappers::run_app() # add parameters here (if any) 8 | -------------------------------------------------------------------------------- /datasets/adam/adadas.xpt: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/RConsortium/submissions-pilot2/c90937d8527ac9a36a46bad76f056f3880a4249f/datasets/adam/adadas.xpt -------------------------------------------------------------------------------- /datasets/adam/adlbc.xpt: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/RConsortium/submissions-pilot2/c90937d8527ac9a36a46bad76f056f3880a4249f/datasets/adam/adlbc.xpt -------------------------------------------------------------------------------- /datasets/adam/adsl.xpt: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/RConsortium/submissions-pilot2/c90937d8527ac9a36a46bad76f056f3880a4249f/datasets/adam/adsl.xpt -------------------------------------------------------------------------------- /datasets/adam/adtte.xpt: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/RConsortium/submissions-pilot2/c90937d8527ac9a36a46bad76f056f3880a4249f/datasets/adam/adtte.xpt -------------------------------------------------------------------------------- /dev/01_start.R: -------------------------------------------------------------------------------- 1 | # Building a Prod-Ready, Robust Shiny Application. 2 | # 3 | # README: each step of the dev files is optional, and you don't have to 4 | # fill every dev scripts before getting started. 5 | # 01_start.R should be filled at start. 6 | # 02_dev.R should be used to keep track of your development during the project. 7 | # 03_deploy.R should be used once you need to deploy your app. 8 | # 9 | # 10 | ######################################## 11 | #### CURRENT FILE: ON START SCRIPT ##### 12 | ######################################## 13 | 14 | ## Fill the DESCRIPTION ---- 15 | ## Add meta data about your application 16 | ## 17 | ## /!\ Note: if you want to change the name of your app during development, 18 | ## either re-run this function, call golem::set_golem_name(), or don't forget 19 | ## to change the name in the app_sys() function in app_config.R /!\ 20 | ## 21 | golem::fill_desc( 22 | pkg_name = "pilot2wrappers", # The Name of the package containing the App 23 | pkg_title = "PKG_TITLE", # The Title of the package containing the App 24 | pkg_description = "PKG_DESC.", # The Description of the package containing the App 25 | author_first_name = "AUTHOR_FIRST", # Your First Name 26 | author_last_name = "AUTHOR_LAST", # Your Last Name 27 | author_email = "AUTHOR@MAIL.COM", # Your Email 28 | repo_url = NULL # The URL of the GitHub Repo (optional) 29 | ) 30 | 31 | ## Set {golem} options ---- 32 | golem::set_golem_options() 33 | 34 | ## Create Common Files ---- 35 | ## See ?usethis for more information 36 | usethis::use_mit_license( "Golem User" ) # You can set another license here 37 | usethis::use_readme_rmd( open = FALSE ) 38 | usethis::use_code_of_conduct() 39 | usethis::use_lifecycle_badge( "Experimental" ) 40 | usethis::use_news_md( open = FALSE ) 41 | 42 | ## Use git ---- 43 | usethis::use_git() 44 | 45 | ## Init Testing Infrastructure ---- 46 | ## Create a template for tests 47 | golem::use_recommended_tests() 48 | 49 | ## Use Recommended Packages ---- 50 | golem::use_recommended_deps() 51 | 52 | ## Favicon ---- 53 | # If you want to change the favicon (default is golem's one) 54 | golem::use_favicon() # path = "path/to/ico". Can be an online file. 55 | golem::remove_favicon() 56 | 57 | ## Add helper functions ---- 58 | golem::use_utils_ui() 59 | golem::use_utils_server() 60 | 61 | # You're now set! ---- 62 | 63 | # go to dev/02_dev.R 64 | rstudioapi::navigateToFile( "dev/02_dev.R" ) 65 | 66 | -------------------------------------------------------------------------------- /dev/02_dev.R: -------------------------------------------------------------------------------- 1 | # Building a Prod-Ready, Robust Shiny Application. 2 | # 3 | # README: each step of the dev files is optional, and you don't have to 4 | # fill every dev scripts before getting started. 5 | # 01_start.R should be filled at start. 6 | # 02_dev.R should be used to keep track of your development during the project. 7 | # 03_deploy.R should be used once you need to deploy your app. 8 | # 9 | # 10 | ################################### 11 | #### CURRENT FILE: DEV SCRIPT ##### 12 | ################################### 13 | 14 | # Engineering 15 | 16 | ## Dependencies ---- 17 | ## Add one line by package you want to add as dependency 18 | pkg_list <- c( 19 | "teal", 20 | "teal.data", 21 | "rtables", 22 | "haven", 23 | "dplyr", 24 | "Tplyr", 25 | "tidyr", 26 | "glue", 27 | "stringr", 28 | "huxtable", 29 | "ggplot2", 30 | "cowplot", 31 | "visR", 32 | "emmeans", 33 | "reactable", 34 | "tibble", 35 | "utils", 36 | "htmltools", 37 | "tippy" 38 | ) 39 | 40 | purrr::map(pkg_list, ~usethis::use_package(.x)) 41 | 42 | 43 | ## Add modules ---- 44 | ## Create a module infrastructure in R/ 45 | golem::add_module( name = "name_of_module1" ) # Name of the module 46 | golem::add_module( name = "name_of_module2" ) # Name of the module 47 | 48 | ## Add helper functions ---- 49 | ## Creates fct_* and utils_* 50 | golem::add_fct( "helpers" ) 51 | golem::add_utils( "helpers" ) 52 | 53 | ## External resources 54 | ## Creates .js and .css files at inst/app/www 55 | golem::add_js_file( "script" ) 56 | golem::add_js_handler( "handlers" ) 57 | golem::add_css_file( "custom" ) 58 | 59 | ## Add internal datasets ---- 60 | ## If you have data in your package 61 | usethis::use_data_raw( name = "my_dataset", open = FALSE ) 62 | 63 | ## Tests ---- 64 | ## Add one line by test you want to create 65 | usethis::use_test( "app" ) 66 | 67 | # Documentation 68 | 69 | ## Vignette ---- 70 | usethis::use_vignette("pilot2wrappers") 71 | devtools::build_vignettes() 72 | 73 | ## Code Coverage---- 74 | ## Set the code coverage service ("codecov" or "coveralls") 75 | usethis::use_coverage() 76 | 77 | # Create a summary readme for the testthat subdirectory 78 | covrpage::covrpage() 79 | 80 | ## CI ---- 81 | ## Use this part of the script if you need to set up a CI 82 | ## service for your application 83 | ## 84 | ## (You'll need GitHub there) 85 | usethis::use_github() 86 | 87 | # GitHub Actions 88 | usethis::use_github_action() 89 | # Chose one of the three 90 | # See https://usethis.r-lib.org/reference/use_github_action.html 91 | usethis::use_github_action_check_release() 92 | usethis::use_github_action_check_standard() 93 | usethis::use_github_action_check_full() 94 | # Add action for PR 95 | usethis::use_github_action_pr_commands() 96 | 97 | # Travis CI 98 | usethis::use_travis() 99 | usethis::use_travis_badge() 100 | 101 | # AppVeyor 102 | usethis::use_appveyor() 103 | usethis::use_appveyor_badge() 104 | 105 | # Circle CI 106 | usethis::use_circleci() 107 | usethis::use_circleci_badge() 108 | 109 | # Jenkins 110 | usethis::use_jenkins() 111 | 112 | # GitLab CI 113 | usethis::use_gitlab_ci() 114 | 115 | # You're now set! ---- 116 | # go to dev/03_deploy.R 117 | rstudioapi::navigateToFile("dev/03_deploy.R") 118 | 119 | -------------------------------------------------------------------------------- /dev/03_deploy.R: -------------------------------------------------------------------------------- 1 | # Building a Prod-Ready, Robust Shiny Application. 2 | # 3 | # README: each step of the dev files is optional, and you don't have to 4 | # fill every dev scripts before getting started. 5 | # 01_start.R should be filled at start. 6 | # 02_dev.R should be used to keep track of your development during the project. 7 | # 03_deploy.R should be used once you need to deploy your app. 8 | # 9 | # 10 | ###################################### 11 | #### CURRENT FILE: DEPLOY SCRIPT ##### 12 | ###################################### 13 | 14 | # Test your app 15 | 16 | ## Run checks ---- 17 | ## Check the package before sending to prod 18 | devtools::check() 19 | 20 | # Build 21 | ## Buld the package tarball and send to the renv cellar directory 22 | 23 | ## Linux version 24 | devtools::build(path = "renv/cellar") 25 | 26 | ## Windows version 27 | devtools::build(path = "renv/cellar", binary = TRUE) 28 | 29 | # Install to renv library 30 | renv::install(file.path(getwd(), "renv/cellar/pilot2wrappers_0.10.0.tar.gz")) 31 | 32 | # Deploy 33 | 34 | ## Local, CRAN or Package Manager ---- 35 | ## This will build a tar.gz that can be installed locally, 36 | ## sent to CRAN, or to a package manager 37 | devtools::build() 38 | 39 | ## RStudio ---- 40 | ## If you want to deploy on RStudio related platforms 41 | golem::add_shinyappsio_file() 42 | 43 | ## Docker ---- 44 | ## If you want to deploy via a generic Dockerfile 45 | #golem::add_dockerfile() 46 | 47 | -------------------------------------------------------------------------------- /dev/run_dev.R: -------------------------------------------------------------------------------- 1 | # Set options here 2 | options(golem.app.prod = FALSE) # TRUE = production mode, FALSE = development mode 3 | 4 | # Detach all loaded packages and clean your environment 5 | golem::detach_all_attached() 6 | # rm(list=ls(all.names = TRUE)) 7 | 8 | # Document and reload your package 9 | golem::document_and_reload() 10 | 11 | # Run the application 12 | run_app() 13 | -------------------------------------------------------------------------------- /inst/app/docs/about.md: -------------------------------------------------------------------------------- 1 | ## Introduction 2 | 3 | This application is intended for a pilot submission to the FDA composing of a Shiny application, as part of the [R Submissions Working Group](https://rconsortium.github.io/submissions-wg/) Pilot 2. The data sets and results displayed in the application originate from the [Pilot 1 project](https://rconsortium.github.io/submissions-wg/pilot-overall.html#pilot-1---common-analyses). Visit the **Usage Guide** for information on using the application. Below is a brief description of the application components: 4 | 5 | ### Table 14-2.01 Summary of Demographic and Baseline Characteristics 6 | 7 | In this interface, summary statistics associated with baseline clinical characteristics and other demographic factors is shown. 8 | 9 | ### Figure 14-1 Time to Dermatologic Event by Treatment Group 10 | 11 | A Kaplan-Meier (KM) plot of the Time to First Dermatologic Event (TTDE) with strata defined by treatment group is displayed along with an informative risk set table across time. 12 | 13 | ### Table 14-3.01 Primary Endpoint Analysis: ADAS Cog (11) - Change from Baseline to Week 24 - LOCF 14 | 15 | A summary table of the primary efficacy analysis is shown for each of the time points of assessment (baseline and week 24) comparing each treatment group. The primary efficacy variable (change from baseline in ADAS Cog (11)) was analyzed using an Analysis of Covariance (ANCOVA) model with treatment and baseline value as covariates, comparing Placebo to Xanomeline High Dose. 16 | 17 | ### Table 14-3.02 Primary Endpoint Analysis: Glucose (mmol/L) - Summary at Week 20 - LOCF 18 | 19 | A summary table of an additional efficacy analysis is shown for baseline and week 20. The efficacy variable (Glucose) was analzying using ANCOVA model with treatment and baseline value as covariates, comparing Placebo to Xanomeline High Dose. 20 | 21 | ### Table 14-4.01 Visit Completion 22 | 23 | A summary table of the number of patients remaining in the treatment period for each scheduled visit from baseline to week 24. 24 | -------------------------------------------------------------------------------- /inst/app/www/app_screenshot1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/RConsortium/submissions-pilot2/c90937d8527ac9a36a46bad76f056f3880a4249f/inst/app/www/app_screenshot1.png -------------------------------------------------------------------------------- /inst/app/www/app_screenshot2.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/RConsortium/submissions-pilot2/c90937d8527ac9a36a46bad76f056f3880a4249f/inst/app/www/app_screenshot2.png -------------------------------------------------------------------------------- /inst/app/www/app_screenshot3.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/RConsortium/submissions-pilot2/c90937d8527ac9a36a46bad76f056f3880a4249f/inst/app/www/app_screenshot3.png -------------------------------------------------------------------------------- /inst/app/www/app_screenshot4.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/RConsortium/submissions-pilot2/c90937d8527ac9a36a46bad76f056f3880a4249f/inst/app/www/app_screenshot4.png -------------------------------------------------------------------------------- /inst/app/www/favicon.ico: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/RConsortium/submissions-pilot2/c90937d8527ac9a36a46bad76f056f3880a4249f/inst/app/www/favicon.ico -------------------------------------------------------------------------------- /inst/golem-config.yml: -------------------------------------------------------------------------------- 1 | default: 2 | golem_name: pilot2wrappers 3 | golem_version: 0.10.0 4 | app_prod: no 5 | adam_path: "datasets/adam" 6 | production: 7 | app_prod: yes 8 | dev: 9 | golem_wd: !expr here::here() 10 | -------------------------------------------------------------------------------- /inst/pkgdown/assets/readme.txt: -------------------------------------------------------------------------------- 1 | do not delete. Paceholder for pkgdown -------------------------------------------------------------------------------- /inst/pkgdown/templates/readme.txt: -------------------------------------------------------------------------------- 1 | do not delete. Paceholder for pkgdown -------------------------------------------------------------------------------- /inst/startup.R: -------------------------------------------------------------------------------- 1 | # Project Level Setup 2 | R_version <- "4.2.0" # set up project R version 3 | snapshot <- "2022-09-01" # set up snapshot date 4 | teal_snapshot <- "2022-06-09" 5 | repos <- c( 6 | paste0("https://packagemanager.rstudio.com/cran/", snapshot), 7 | paste0("https://insightsengineering.github.io/depository/", teal_snapshot) # set up repository based on snapshot 8 | ) 9 | 10 | home <- normalizePath(".") # set up home directory 11 | while(! "DESCRIPTION" %in% list.files(home)){ 12 | home <- dirname(home) 13 | } 14 | 15 | # A&R folder path (Do not edit information below) 16 | path <- list(home = "") 17 | 18 | path <- lapply(path, function(x) file.path(home, x)) 19 | 20 | # Define repo URL for project specific package installation 21 | options(repos = repos) 22 | 23 | # Check R Version 24 | if(paste(R.version$major, R.version$minor, sep = ".") != R_version & interactive()){ 25 | stop("The current R version is not the same with the current project in ", R_version) 26 | } 27 | 28 | # Repository 29 | message("Current project R package repository:") 30 | message(paste0(" ", getOption("repos"))) 31 | message(" ") 32 | 33 | # Display R Session Status 34 | #message("R packages were installed from repo: ", options('repo'), "\n") 35 | message("Below R package path are searching in order to find installed R pacakges in this R session:", "\n", 36 | paste(paste0(" ", .libPaths()), collapse = "\n")) 37 | message("\n") 38 | 39 | message("The project home directory is ", home) 40 | message("\n") 41 | 42 | rm(home, R_version) 43 | -------------------------------------------------------------------------------- /man/efficacy_models.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/eff_models.R 3 | \name{efficacy_models} 4 | \alias{efficacy_models} 5 | \title{ANCOVA Model data processing necessary for Table 14-3.01} 6 | \usage{ 7 | efficacy_models(data, var = NULL, wk = NULL, show_pvalue = TRUE) 8 | } 9 | \arguments{ 10 | \item{data}{Source dataset (filtered by flags)} 11 | 12 | \item{var}{Variable on which model should be run} 13 | 14 | \item{wk}{Visit to be modeled} 15 | 16 | \item{show_pvalue}{Indicator to display p-values in table} 17 | } 18 | \value{ 19 | Formatted dataframe 20 | } 21 | \description{ 22 | This function handles the necessary data processing to handle the CDISC pilot 23 | primary endpoint analysis. The original source can be found 24 | \href{https://github.com/atorus-research/CDISC_pilot_replication/blob/3c8e9e3798c02be8d93bd8e8944d1e0d3f6519e2/programs/funcs.R#L401}{here} 25 | } 26 | -------------------------------------------------------------------------------- /man/filter_active.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/helpers.R 3 | \name{filter_active} 4 | \alias{filter_active} 5 | \title{check if a filter is active in a teal module} 6 | \usage{ 7 | filter_active(datasets) 8 | } 9 | \arguments{ 10 | \item{datasets}{instance of teal filtered datasets class} 11 | } 12 | \value{ 13 | boolean, TRUE if a filter is applied, FALSE otherwise 14 | } 15 | \description{ 16 | check if a filter is active in a teal module 17 | } 18 | -------------------------------------------------------------------------------- /man/fmt_ci.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/fmt.R 3 | \name{fmt_ci} 4 | \alias{fmt_ci} 5 | \title{Format confidence interval} 6 | \usage{ 7 | fmt_ci(.est, .lower, .upper, digits = 2, width = digits + 3) 8 | } 9 | \arguments{ 10 | \item{.est}{an estimator.} 11 | 12 | \item{.lower}{lower confidence interval bound of an estimator.} 13 | 14 | \item{.upper}{upper confidence interval bound of an estimator.} 15 | 16 | \item{digits}{number of digits for \code{.est}, \code{.lower}, and \code{.upper}.} 17 | 18 | \item{width}{the total field width.} 19 | } 20 | \description{ 21 | Format confidence interval 22 | } 23 | \examples{ 24 | fmt_ci(1, -0.25, 1.32) 25 | } 26 | -------------------------------------------------------------------------------- /man/fmt_est.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/fmt.R 3 | \name{fmt_est} 4 | \alias{fmt_est} 5 | \title{Format point estimator} 6 | \usage{ 7 | fmt_est(.mean, .sd, digits = c(1, 2)) 8 | } 9 | \arguments{ 10 | \item{.mean}{mean of an estimator.} 11 | 12 | \item{.sd}{sd of an estimator.} 13 | 14 | \item{digits}{number of digits for \code{.mean} and \code{.sd}.} 15 | } 16 | \description{ 17 | Format point estimator 18 | } 19 | \examples{ 20 | fmt_est(1.25, 0.5) 21 | } 22 | -------------------------------------------------------------------------------- /man/fmt_num.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/fmt.R 3 | \name{fmt_num} 4 | \alias{fmt_num} 5 | \title{Format numeric value} 6 | \usage{ 7 | fmt_num(x, digits, width = digits + 4) 8 | } 9 | \arguments{ 10 | \item{x}{an atomic numerical or character object, possibly 11 | \code{\link[base]{complex}} only for \code{prettyNum()}, typically a 12 | vector of real numbers. Any class is discarded, with a warning.} 13 | 14 | \item{digits}{the desired number of digits after the decimal 15 | point (\code{format = "f"}) or \emph{significant} digits 16 | (\code{format = "g"}, \code{= "e"} or \code{= "fg"}). 17 | 18 | Default: 2 for integer, 4 for real numbers. If less than 0, 19 | the C default of 6 digits is used. If specified as more than 50, 50 20 | will be used with a warning unless \code{format = "f"} where it is 21 | limited to typically 324. (Not more than 15--21 digits need be 22 | accurate, depending on the OS and compiler used. This limit is 23 | just a precaution against segfaults in the underlying C runtime.) 24 | } 25 | 26 | \item{width}{the total field width; if both \code{digits} and 27 | \code{width} are unspecified, \code{width} defaults to 1, 28 | otherwise to \code{digits + 1}. \code{width = 0} will use 29 | \code{width = digits}, \code{width < 0} means left 30 | justify the number in this field (equivalent to \code{flag = "-"}). 31 | If necessary, the result will have more characters than 32 | \code{width}. For character data this is interpreted in characters 33 | (not bytes nor display width). 34 | } 35 | } 36 | \description{ 37 | Format numeric value 38 | } 39 | \examples{ 40 | fmt_num(1.25, digits = 1) 41 | } 42 | -------------------------------------------------------------------------------- /man/fmt_pval.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/fmt.R 3 | \name{fmt_pval} 4 | \alias{fmt_pval} 5 | \title{Format p-Value} 6 | \usage{ 7 | fmt_pval(.p, digits = 3) 8 | } 9 | \arguments{ 10 | \item{.p}{a p-value.} 11 | 12 | \item{digits}{number of digits for \code{.est}, \code{.lower}, and \code{.upper}.} 13 | } 14 | \description{ 15 | Format p-Value 16 | } 17 | \examples{ 18 | fmt_pval(0.2) 19 | } 20 | -------------------------------------------------------------------------------- /man/nest_rowlabels.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/Tplyr_helpers.R 3 | \name{nest_rowlabels} 4 | \alias{nest_rowlabels} 5 | \title{Nest Row Labels in a Tplyr table} 6 | \usage{ 7 | nest_rowlabels(.dat) 8 | } 9 | \arguments{ 10 | \item{.dat}{Input data set - should come from a built Tplyr table.} 11 | } 12 | \value{ 13 | data.frame with row labels nested 14 | } 15 | \description{ 16 | This is a (high ungeneralized) helper function. Current function assumes that 17 | row_label1 groups row_label2, and turns row_label1 into a stub over its 18 | related groups of row_label2. 19 | } 20 | -------------------------------------------------------------------------------- /man/num_fmt.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/helpers.R 3 | \name{num_fmt} 4 | \alias{num_fmt} 5 | \title{Number formatter} 6 | \usage{ 7 | num_fmt(var, digits = 0, size = 10, int_len = 3) 8 | } 9 | \arguments{ 10 | \item{var}{Variable to format} 11 | 12 | \item{digits}{Desired number of decimal places} 13 | 14 | \item{size}{String size} 15 | 16 | \item{int_len}{Space allotted for integer side of the decimal} 17 | } 18 | \value{ 19 | Formatted string 20 | } 21 | \description{ 22 | Format numbers for presentation, with proper rounding of data 23 | } 24 | -------------------------------------------------------------------------------- /man/pad_row.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/helpers.R 3 | \name{pad_row} 4 | \alias{pad_row} 5 | \title{Add a padding row below data} 6 | \usage{ 7 | pad_row(.data, n = 1) 8 | } 9 | \arguments{ 10 | \item{.data}{Data to pad} 11 | 12 | \item{n}{Number of rows to pad} 13 | } 14 | \value{ 15 | Dataframe with extra blank rows 16 | } 17 | \description{ 18 | Add a padding row below data 19 | } 20 | -------------------------------------------------------------------------------- /man/pilot2wrappers-package.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/package.R 3 | \docType{package} 4 | \name{pilot2wrappers-package} 5 | \alias{pilot2wrappers} 6 | \alias{pilot2wrappers-package} 7 | \title{pilot2wrappers: R Consortium R Submission Pilot 2} 8 | \description{ 9 | Shiny application used within the R Consortium R Submissions Working Group Pilot submissions. 10 | } 11 | \author{ 12 | \strong{Maintainer}: Eric Nantz \email{theRcast@gmail.com} 13 | 14 | Authors: 15 | \itemize{ 16 | \item Yilong Zhang 17 | \item Heng Wang 18 | \item Gregory Chen 19 | \item Eli Miller 20 | \item Ning Leng 21 | } 22 | 23 | Other contributors: 24 | \itemize{ 25 | \item copyright [copyright holder] 26 | } 27 | 28 | } 29 | \keyword{internal} 30 | -------------------------------------------------------------------------------- /man/pipe.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/utils-pipe.R 3 | \name{\%>\%} 4 | \alias{\%>\%} 5 | \title{Pipe operator} 6 | \usage{ 7 | lhs \%>\% rhs 8 | } 9 | \arguments{ 10 | \item{lhs}{A value or the magrittr placeholder.} 11 | 12 | \item{rhs}{A function call using the magrittr semantics.} 13 | } 14 | \value{ 15 | The result of calling \code{rhs(lhs)}. 16 | } 17 | \description{ 18 | See \code{magrittr::\link[magrittr:pipe]{\%>\%}} for details. 19 | } 20 | \keyword{internal} 21 | -------------------------------------------------------------------------------- /man/run_app.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/run_app.R 3 | \name{run_app} 4 | \alias{run_app} 5 | \title{Run the Shiny Application} 6 | \usage{ 7 | run_app( 8 | onStart = NULL, 9 | options = list(), 10 | enableBookmarking = NULL, 11 | uiPattern = "/", 12 | ... 13 | ) 14 | } 15 | \arguments{ 16 | \item{onStart}{A function that will be called before the app is actually run. 17 | This is only needed for \code{shinyAppObj}, since in the \code{shinyAppDir} 18 | case, a \code{global.R} file can be used for this purpose.} 19 | 20 | \item{options}{Named options that should be passed to the \code{runApp} call 21 | (these can be any of the following: "port", "launch.browser", "host", "quiet", 22 | "display.mode" and "test.mode"). You can also specify \code{width} and 23 | \code{height} parameters which provide a hint to the embedding environment 24 | about the ideal height/width for the app.} 25 | 26 | \item{enableBookmarking}{Can be one of \code{"url"}, \code{"server"}, or 27 | \code{"disable"}. The default value, \code{NULL}, will respect the setting from 28 | any previous calls to \code{\link[shiny:enableBookmarking]{enableBookmarking()}}. See \code{\link[shiny:enableBookmarking]{enableBookmarking()}} 29 | for more information on bookmarking your app.} 30 | 31 | \item{uiPattern}{A regular expression that will be applied to each \code{GET} 32 | request to determine whether the \code{ui} should be used to handle the 33 | request. Note that the entire request path must match the regular 34 | expression in order for the match to be considered successful.} 35 | 36 | \item{...}{arguments to pass to golem_opts. 37 | See \code{?golem::get_golem_options} for more details.} 38 | } 39 | \description{ 40 | Run the Shiny Application 41 | } 42 | -------------------------------------------------------------------------------- /man/set_data_path.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/helpers.R 3 | \name{set_data_path} 4 | \alias{set_data_path} 5 | \title{update data file configuration setting} 6 | \usage{ 7 | set_data_path(path) 8 | } 9 | \arguments{ 10 | \item{path}{path to directory containing data files 11 | used within the Shiny application} 12 | } 13 | \value{ 14 | Used for side effects 15 | } 16 | \description{ 17 | update data file configuration setting 18 | } 19 | -------------------------------------------------------------------------------- /man/tooltip_text.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/helpers.R 3 | \name{tooltip_text} 4 | \alias{tooltip_text} 5 | \title{style a tooltip produced by the tippy package} 6 | \usage{ 7 | tooltip_text(text, font_size = 16) 8 | } 9 | \arguments{ 10 | \item{text}{String for text in tooltip} 11 | 12 | \item{font_size}{Font size (in pixels)} 13 | } 14 | \value{ 15 | HTML with font size applied 16 | } 17 | \description{ 18 | style a tooltip produced by the tippy package 19 | } 20 | -------------------------------------------------------------------------------- /pkgdown/extra.css: -------------------------------------------------------------------------------- 1 | /* navbar background */ 2 | .bg-light, .navbar-light { 3 | background-color: #00857c !important; 4 | } 5 | 6 | /* navbar version number */ 7 | .nav-text.text-muted { 8 | color: #d9e7e6 !important; 9 | } 10 | 11 | /* navbar link status */ 12 | .navbar-light .navbar-nav .nav-item>.nav-link:hover { 13 | background: #005c55; 14 | } 15 | 16 | .navbar-light .navbar-nav .nav-item.active>.nav-link:hover { 17 | color: #fff; 18 | } 19 | 20 | /* footer */ 21 | footer { 22 | padding-top: 1rem; 23 | padding-bottom: 1rem; 24 | } -------------------------------------------------------------------------------- /renv/.gitignore: -------------------------------------------------------------------------------- 1 | # cellar/ 2 | library/ 3 | local/ 4 | lock/ 5 | python/ 6 | staging/ 7 | -------------------------------------------------------------------------------- /renv/activate.R: -------------------------------------------------------------------------------- 1 | 2 | local({ 3 | 4 | # the requested version of renv 5 | version <- "0.15.2" 6 | 7 | # the project directory 8 | project <- getwd() 9 | 10 | # figure out whether the autoloader is enabled 11 | enabled <- local({ 12 | 13 | # first, check config option 14 | override <- getOption("renv.config.autoloader.enabled") 15 | if (!is.null(override)) 16 | return(override) 17 | 18 | # next, check environment variables 19 | # TODO: prefer using the configuration one in the future 20 | envvars <- c( 21 | "RENV_CONFIG_AUTOLOADER_ENABLED", 22 | "RENV_AUTOLOADER_ENABLED", 23 | "RENV_ACTIVATE_PROJECT" 24 | ) 25 | 26 | for (envvar in envvars) { 27 | envval <- Sys.getenv(envvar, unset = NA) 28 | if (!is.na(envval)) 29 | return(tolower(envval) %in% c("true", "t", "1")) 30 | } 31 | 32 | # enable by default 33 | TRUE 34 | 35 | }) 36 | 37 | if (!enabled) 38 | return(FALSE) 39 | 40 | # avoid recursion 41 | if (identical(getOption("renv.autoloader.running"), TRUE)) { 42 | warning("ignoring recursive attempt to run renv autoloader") 43 | return(invisible(TRUE)) 44 | } 45 | 46 | # signal that we're loading renv during R startup 47 | options(renv.autoloader.running = TRUE) 48 | on.exit(options(renv.autoloader.running = NULL), add = TRUE) 49 | 50 | # signal that we've consented to use renv 51 | options(renv.consent = TRUE) 52 | 53 | # load the 'utils' package eagerly -- this ensures that renv shims, which 54 | # mask 'utils' packages, will come first on the search path 55 | library(utils, lib.loc = .Library) 56 | 57 | # check to see if renv has already been loaded 58 | if ("renv" %in% loadedNamespaces()) { 59 | 60 | # if renv has already been loaded, and it's the requested version of renv, 61 | # nothing to do 62 | spec <- .getNamespaceInfo(.getNamespace("renv"), "spec") 63 | if (identical(spec[["version"]], version)) 64 | return(invisible(TRUE)) 65 | 66 | # otherwise, unload and attempt to load the correct version of renv 67 | unloadNamespace("renv") 68 | 69 | } 70 | 71 | # load bootstrap tools 72 | `%||%` <- function(x, y) { 73 | if (is.environment(x) || length(x)) x else y 74 | } 75 | 76 | bootstrap <- function(version, library) { 77 | 78 | # attempt to download renv 79 | tarball <- tryCatch(renv_bootstrap_download(version), error = identity) 80 | if (inherits(tarball, "error")) 81 | stop("failed to download renv ", version) 82 | 83 | # now attempt to install 84 | status <- tryCatch(renv_bootstrap_install(version, tarball, library), error = identity) 85 | if (inherits(status, "error")) 86 | stop("failed to install renv ", version) 87 | 88 | } 89 | 90 | renv_bootstrap_tests_running <- function() { 91 | getOption("renv.tests.running", default = FALSE) 92 | } 93 | 94 | renv_bootstrap_repos <- function() { 95 | 96 | # check for repos override 97 | repos <- Sys.getenv("RENV_CONFIG_REPOS_OVERRIDE", unset = NA) 98 | if (!is.na(repos)) 99 | return(repos) 100 | 101 | # check for lockfile repositories 102 | repos <- tryCatch(renv_bootstrap_repos_lockfile(), error = identity) 103 | if (!inherits(repos, "error") && length(repos)) 104 | return(repos) 105 | 106 | # if we're testing, re-use the test repositories 107 | if (renv_bootstrap_tests_running()) 108 | return(getOption("renv.tests.repos")) 109 | 110 | # retrieve current repos 111 | repos <- getOption("repos") 112 | 113 | # ensure @CRAN@ entries are resolved 114 | repos[repos == "@CRAN@"] <- getOption( 115 | "renv.repos.cran", 116 | "https://cloud.r-project.org" 117 | ) 118 | 119 | # add in renv.bootstrap.repos if set 120 | default <- c(FALLBACK = "https://cloud.r-project.org") 121 | extra <- getOption("renv.bootstrap.repos", default = default) 122 | repos <- c(repos, extra) 123 | 124 | # remove duplicates that might've snuck in 125 | dupes <- duplicated(repos) | duplicated(names(repos)) 126 | repos[!dupes] 127 | 128 | } 129 | 130 | renv_bootstrap_repos_lockfile <- function() { 131 | 132 | lockpath <- Sys.getenv("RENV_PATHS_LOCKFILE", unset = "renv.lock") 133 | if (!file.exists(lockpath)) 134 | return(NULL) 135 | 136 | lockfile <- tryCatch(renv_json_read(lockpath), error = identity) 137 | if (inherits(lockfile, "error")) { 138 | warning(lockfile) 139 | return(NULL) 140 | } 141 | 142 | repos <- lockfile$R$Repositories 143 | if (length(repos) == 0) 144 | return(NULL) 145 | 146 | keys <- vapply(repos, `[[`, "Name", FUN.VALUE = character(1)) 147 | vals <- vapply(repos, `[[`, "URL", FUN.VALUE = character(1)) 148 | names(vals) <- keys 149 | 150 | return(vals) 151 | 152 | } 153 | 154 | renv_bootstrap_download <- function(version) { 155 | 156 | # if the renv version number has 4 components, assume it must 157 | # be retrieved via github 158 | nv <- numeric_version(version) 159 | components <- unclass(nv)[[1]] 160 | 161 | methods <- if (length(components) == 4L) { 162 | list( 163 | renv_bootstrap_download_github 164 | ) 165 | } else { 166 | list( 167 | renv_bootstrap_download_cran_latest, 168 | renv_bootstrap_download_cran_archive 169 | ) 170 | } 171 | 172 | for (method in methods) { 173 | path <- tryCatch(method(version), error = identity) 174 | if (is.character(path) && file.exists(path)) 175 | return(path) 176 | } 177 | 178 | stop("failed to download renv ", version) 179 | 180 | } 181 | 182 | renv_bootstrap_download_impl <- function(url, destfile) { 183 | 184 | mode <- "wb" 185 | 186 | # https://bugs.r-project.org/bugzilla/show_bug.cgi?id=17715 187 | fixup <- 188 | Sys.info()[["sysname"]] == "Windows" && 189 | substring(url, 1L, 5L) == "file:" 190 | 191 | if (fixup) 192 | mode <- "w+b" 193 | 194 | utils::download.file( 195 | url = url, 196 | destfile = destfile, 197 | mode = mode, 198 | quiet = TRUE 199 | ) 200 | 201 | } 202 | 203 | renv_bootstrap_download_cran_latest <- function(version) { 204 | 205 | spec <- renv_bootstrap_download_cran_latest_find(version) 206 | 207 | message("* Downloading renv ", version, " ... ", appendLF = FALSE) 208 | 209 | type <- spec$type 210 | repos <- spec$repos 211 | 212 | info <- tryCatch( 213 | utils::download.packages( 214 | pkgs = "renv", 215 | destdir = tempdir(), 216 | repos = repos, 217 | type = type, 218 | quiet = TRUE 219 | ), 220 | condition = identity 221 | ) 222 | 223 | if (inherits(info, "condition")) { 224 | message("FAILED") 225 | return(FALSE) 226 | } 227 | 228 | # report success and return 229 | message("OK (downloaded ", type, ")") 230 | info[1, 2] 231 | 232 | } 233 | 234 | renv_bootstrap_download_cran_latest_find <- function(version) { 235 | 236 | # check whether binaries are supported on this system 237 | binary <- 238 | getOption("renv.bootstrap.binary", default = TRUE) && 239 | !identical(.Platform$pkgType, "source") && 240 | !identical(getOption("pkgType"), "source") && 241 | Sys.info()[["sysname"]] %in% c("Darwin", "Windows") 242 | 243 | types <- c(if (binary) "binary", "source") 244 | 245 | # iterate over types + repositories 246 | for (type in types) { 247 | for (repos in renv_bootstrap_repos()) { 248 | 249 | # retrieve package database 250 | db <- tryCatch( 251 | as.data.frame( 252 | utils::available.packages(type = type, repos = repos), 253 | stringsAsFactors = FALSE 254 | ), 255 | error = identity 256 | ) 257 | 258 | if (inherits(db, "error")) 259 | next 260 | 261 | # check for compatible entry 262 | entry <- db[db$Package %in% "renv" & db$Version %in% version, ] 263 | if (nrow(entry) == 0) 264 | next 265 | 266 | # found it; return spec to caller 267 | spec <- list(entry = entry, type = type, repos = repos) 268 | return(spec) 269 | 270 | } 271 | } 272 | 273 | # if we got here, we failed to find renv 274 | fmt <- "renv %s is not available from your declared package repositories" 275 | stop(sprintf(fmt, version)) 276 | 277 | } 278 | 279 | renv_bootstrap_download_cran_archive <- function(version) { 280 | 281 | name <- sprintf("renv_%s.tar.gz", version) 282 | repos <- renv_bootstrap_repos() 283 | urls <- file.path(repos, "src/contrib/Archive/renv", name) 284 | destfile <- file.path(tempdir(), name) 285 | 286 | message("* Downloading renv ", version, " ... ", appendLF = FALSE) 287 | 288 | for (url in urls) { 289 | 290 | status <- tryCatch( 291 | renv_bootstrap_download_impl(url, destfile), 292 | condition = identity 293 | ) 294 | 295 | if (identical(status, 0L)) { 296 | message("OK") 297 | return(destfile) 298 | } 299 | 300 | } 301 | 302 | message("FAILED") 303 | return(FALSE) 304 | 305 | } 306 | 307 | renv_bootstrap_download_github <- function(version) { 308 | 309 | enabled <- Sys.getenv("RENV_BOOTSTRAP_FROM_GITHUB", unset = "TRUE") 310 | if (!identical(enabled, "TRUE")) 311 | return(FALSE) 312 | 313 | # prepare download options 314 | pat <- Sys.getenv("GITHUB_PAT") 315 | if (nzchar(Sys.which("curl")) && nzchar(pat)) { 316 | fmt <- "--location --fail --header \"Authorization: token %s\"" 317 | extra <- sprintf(fmt, pat) 318 | saved <- options("download.file.method", "download.file.extra") 319 | options(download.file.method = "curl", download.file.extra = extra) 320 | on.exit(do.call(base::options, saved), add = TRUE) 321 | } else if (nzchar(Sys.which("wget")) && nzchar(pat)) { 322 | fmt <- "--header=\"Authorization: token %s\"" 323 | extra <- sprintf(fmt, pat) 324 | saved <- options("download.file.method", "download.file.extra") 325 | options(download.file.method = "wget", download.file.extra = extra) 326 | on.exit(do.call(base::options, saved), add = TRUE) 327 | } 328 | 329 | message("* Downloading renv ", version, " from GitHub ... ", appendLF = FALSE) 330 | 331 | url <- file.path("https://api.github.com/repos/rstudio/renv/tarball", version) 332 | name <- sprintf("renv_%s.tar.gz", version) 333 | destfile <- file.path(tempdir(), name) 334 | 335 | status <- tryCatch( 336 | renv_bootstrap_download_impl(url, destfile), 337 | condition = identity 338 | ) 339 | 340 | if (!identical(status, 0L)) { 341 | message("FAILED") 342 | return(FALSE) 343 | } 344 | 345 | message("OK") 346 | return(destfile) 347 | 348 | } 349 | 350 | renv_bootstrap_install <- function(version, tarball, library) { 351 | 352 | # attempt to install it into project library 353 | message("* Installing renv ", version, " ... ", appendLF = FALSE) 354 | dir.create(library, showWarnings = FALSE, recursive = TRUE) 355 | 356 | # invoke using system2 so we can capture and report output 357 | bin <- R.home("bin") 358 | exe <- if (Sys.info()[["sysname"]] == "Windows") "R.exe" else "R" 359 | r <- file.path(bin, exe) 360 | args <- c("--vanilla", "CMD", "INSTALL", "--no-multiarch", "-l", shQuote(library), shQuote(tarball)) 361 | output <- system2(r, args, stdout = TRUE, stderr = TRUE) 362 | message("Done!") 363 | 364 | # check for successful install 365 | status <- attr(output, "status") 366 | if (is.numeric(status) && !identical(status, 0L)) { 367 | header <- "Error installing renv:" 368 | lines <- paste(rep.int("=", nchar(header)), collapse = "") 369 | text <- c(header, lines, output) 370 | writeLines(text, con = stderr()) 371 | } 372 | 373 | status 374 | 375 | } 376 | 377 | renv_bootstrap_platform_prefix <- function() { 378 | 379 | # construct version prefix 380 | version <- paste(R.version$major, R.version$minor, sep = ".") 381 | prefix <- paste("R", numeric_version(version)[1, 1:2], sep = "-") 382 | 383 | # include SVN revision for development versions of R 384 | # (to avoid sharing platform-specific artefacts with released versions of R) 385 | devel <- 386 | identical(R.version[["status"]], "Under development (unstable)") || 387 | identical(R.version[["nickname"]], "Unsuffered Consequences") 388 | 389 | if (devel) 390 | prefix <- paste(prefix, R.version[["svn rev"]], sep = "-r") 391 | 392 | # build list of path components 393 | components <- c(prefix, R.version$platform) 394 | 395 | # include prefix if provided by user 396 | prefix <- renv_bootstrap_platform_prefix_impl() 397 | if (!is.na(prefix) && nzchar(prefix)) 398 | components <- c(prefix, components) 399 | 400 | # build prefix 401 | paste(components, collapse = "/") 402 | 403 | } 404 | 405 | renv_bootstrap_platform_prefix_impl <- function() { 406 | 407 | # if an explicit prefix has been supplied, use it 408 | prefix <- Sys.getenv("RENV_PATHS_PREFIX", unset = NA) 409 | if (!is.na(prefix)) 410 | return(prefix) 411 | 412 | # if the user has requested an automatic prefix, generate it 413 | auto <- Sys.getenv("RENV_PATHS_PREFIX_AUTO", unset = NA) 414 | if (auto %in% c("TRUE", "True", "true", "1")) 415 | return(renv_bootstrap_platform_prefix_auto()) 416 | 417 | # empty string on failure 418 | "" 419 | 420 | } 421 | 422 | renv_bootstrap_platform_prefix_auto <- function() { 423 | 424 | prefix <- tryCatch(renv_bootstrap_platform_os(), error = identity) 425 | if (inherits(prefix, "error") || prefix %in% "unknown") { 426 | 427 | msg <- paste( 428 | "failed to infer current operating system", 429 | "please file a bug report at https://github.com/rstudio/renv/issues", 430 | sep = "; " 431 | ) 432 | 433 | warning(msg) 434 | 435 | } 436 | 437 | prefix 438 | 439 | } 440 | 441 | renv_bootstrap_platform_os <- function() { 442 | 443 | sysinfo <- Sys.info() 444 | sysname <- sysinfo[["sysname"]] 445 | 446 | # handle Windows + macOS up front 447 | if (sysname == "Windows") 448 | return("windows") 449 | else if (sysname == "Darwin") 450 | return("macos") 451 | 452 | # check for os-release files 453 | for (file in c("/etc/os-release", "/usr/lib/os-release")) 454 | if (file.exists(file)) 455 | return(renv_bootstrap_platform_os_via_os_release(file, sysinfo)) 456 | 457 | # check for redhat-release files 458 | if (file.exists("/etc/redhat-release")) 459 | return(renv_bootstrap_platform_os_via_redhat_release()) 460 | 461 | "unknown" 462 | 463 | } 464 | 465 | renv_bootstrap_platform_os_via_os_release <- function(file, sysinfo) { 466 | 467 | # read /etc/os-release 468 | release <- utils::read.table( 469 | file = file, 470 | sep = "=", 471 | quote = c("\"", "'"), 472 | col.names = c("Key", "Value"), 473 | comment.char = "#", 474 | stringsAsFactors = FALSE 475 | ) 476 | 477 | vars <- as.list(release$Value) 478 | names(vars) <- release$Key 479 | 480 | # get os name 481 | os <- tolower(sysinfo[["sysname"]]) 482 | 483 | # read id 484 | id <- "unknown" 485 | for (field in c("ID", "ID_LIKE")) { 486 | if (field %in% names(vars) && nzchar(vars[[field]])) { 487 | id <- vars[[field]] 488 | break 489 | } 490 | } 491 | 492 | # read version 493 | version <- "unknown" 494 | for (field in c("UBUNTU_CODENAME", "VERSION_CODENAME", "VERSION_ID", "BUILD_ID")) { 495 | if (field %in% names(vars) && nzchar(vars[[field]])) { 496 | version <- vars[[field]] 497 | break 498 | } 499 | } 500 | 501 | # join together 502 | paste(c(os, id, version), collapse = "-") 503 | 504 | } 505 | 506 | renv_bootstrap_platform_os_via_redhat_release <- function() { 507 | 508 | # read /etc/redhat-release 509 | contents <- readLines("/etc/redhat-release", warn = FALSE) 510 | 511 | # infer id 512 | id <- if (grepl("centos", contents, ignore.case = TRUE)) 513 | "centos" 514 | else if (grepl("redhat", contents, ignore.case = TRUE)) 515 | "redhat" 516 | else 517 | "unknown" 518 | 519 | # try to find a version component (very hacky) 520 | version <- "unknown" 521 | 522 | parts <- strsplit(contents, "[[:space:]]")[[1L]] 523 | for (part in parts) { 524 | 525 | nv <- tryCatch(numeric_version(part), error = identity) 526 | if (inherits(nv, "error")) 527 | next 528 | 529 | version <- nv[1, 1] 530 | break 531 | 532 | } 533 | 534 | paste(c("linux", id, version), collapse = "-") 535 | 536 | } 537 | 538 | renv_bootstrap_library_root_name <- function(project) { 539 | 540 | # use project name as-is if requested 541 | asis <- Sys.getenv("RENV_PATHS_LIBRARY_ROOT_ASIS", unset = "FALSE") 542 | if (asis) 543 | return(basename(project)) 544 | 545 | # otherwise, disambiguate based on project's path 546 | id <- substring(renv_bootstrap_hash_text(project), 1L, 8L) 547 | paste(basename(project), id, sep = "-") 548 | 549 | } 550 | 551 | renv_bootstrap_library_root <- function(project) { 552 | 553 | prefix <- renv_bootstrap_profile_prefix() 554 | 555 | path <- Sys.getenv("RENV_PATHS_LIBRARY", unset = NA) 556 | if (!is.na(path)) 557 | return(paste(c(path, prefix), collapse = "/")) 558 | 559 | path <- renv_bootstrap_library_root_impl(project) 560 | if (!is.null(path)) { 561 | name <- renv_bootstrap_library_root_name(project) 562 | return(paste(c(path, prefix, name), collapse = "/")) 563 | } 564 | 565 | renv_bootstrap_paths_renv("library", project = project) 566 | 567 | } 568 | 569 | renv_bootstrap_library_root_impl <- function(project) { 570 | 571 | root <- Sys.getenv("RENV_PATHS_LIBRARY_ROOT", unset = NA) 572 | if (!is.na(root)) 573 | return(root) 574 | 575 | type <- renv_bootstrap_project_type(project) 576 | if (identical(type, "package")) { 577 | userdir <- renv_bootstrap_user_dir() 578 | return(file.path(userdir, "library")) 579 | } 580 | 581 | } 582 | 583 | renv_bootstrap_validate_version <- function(version) { 584 | 585 | loadedversion <- utils::packageDescription("renv", fields = "Version") 586 | if (version == loadedversion) 587 | return(TRUE) 588 | 589 | # assume four-component versions are from GitHub; three-component 590 | # versions are from CRAN 591 | components <- strsplit(loadedversion, "[.-]")[[1]] 592 | remote <- if (length(components) == 4L) 593 | paste("rstudio/renv", loadedversion, sep = "@") 594 | else 595 | paste("renv", loadedversion, sep = "@") 596 | 597 | fmt <- paste( 598 | "renv %1$s was loaded from project library, but this project is configured to use renv %2$s.", 599 | "Use `renv::record(\"%3$s\")` to record renv %1$s in the lockfile.", 600 | "Use `renv::restore(packages = \"renv\")` to install renv %2$s into the project library.", 601 | sep = "\n" 602 | ) 603 | 604 | msg <- sprintf(fmt, loadedversion, version, remote) 605 | warning(msg, call. = FALSE) 606 | 607 | FALSE 608 | 609 | } 610 | 611 | renv_bootstrap_hash_text <- function(text) { 612 | 613 | hashfile <- tempfile("renv-hash-") 614 | on.exit(unlink(hashfile), add = TRUE) 615 | 616 | writeLines(text, con = hashfile) 617 | tools::md5sum(hashfile) 618 | 619 | } 620 | 621 | renv_bootstrap_load <- function(project, libpath, version) { 622 | 623 | # try to load renv from the project library 624 | if (!requireNamespace("renv", lib.loc = libpath, quietly = TRUE)) 625 | return(FALSE) 626 | 627 | # warn if the version of renv loaded does not match 628 | renv_bootstrap_validate_version(version) 629 | 630 | # load the project 631 | renv::load(project) 632 | 633 | TRUE 634 | 635 | } 636 | 637 | renv_bootstrap_profile_load <- function(project) { 638 | 639 | # if RENV_PROFILE is already set, just use that 640 | profile <- Sys.getenv("RENV_PROFILE", unset = NA) 641 | if (!is.na(profile) && nzchar(profile)) 642 | return(profile) 643 | 644 | # check for a profile file (nothing to do if it doesn't exist) 645 | path <- renv_bootstrap_paths_renv("profile", profile = FALSE) 646 | if (!file.exists(path)) 647 | return(NULL) 648 | 649 | # read the profile, and set it if it exists 650 | contents <- readLines(path, warn = FALSE) 651 | if (length(contents) == 0L) 652 | return(NULL) 653 | 654 | # set RENV_PROFILE 655 | profile <- contents[[1L]] 656 | if (!profile %in% c("", "default")) 657 | Sys.setenv(RENV_PROFILE = profile) 658 | 659 | profile 660 | 661 | } 662 | 663 | renv_bootstrap_profile_prefix <- function() { 664 | profile <- renv_bootstrap_profile_get() 665 | if (!is.null(profile)) 666 | return(file.path("profiles", profile, "renv")) 667 | } 668 | 669 | renv_bootstrap_profile_get <- function() { 670 | profile <- Sys.getenv("RENV_PROFILE", unset = "") 671 | renv_bootstrap_profile_normalize(profile) 672 | } 673 | 674 | renv_bootstrap_profile_set <- function(profile) { 675 | profile <- renv_bootstrap_profile_normalize(profile) 676 | if (is.null(profile)) 677 | Sys.unsetenv("RENV_PROFILE") 678 | else 679 | Sys.setenv(RENV_PROFILE = profile) 680 | } 681 | 682 | renv_bootstrap_profile_normalize <- function(profile) { 683 | 684 | if (is.null(profile) || profile %in% c("", "default")) 685 | return(NULL) 686 | 687 | profile 688 | 689 | } 690 | 691 | renv_bootstrap_path_absolute <- function(path) { 692 | 693 | substr(path, 1L, 1L) %in% c("~", "/", "\\") || ( 694 | substr(path, 1L, 1L) %in% c(letters, LETTERS) && 695 | substr(path, 2L, 3L) %in% c(":/", ":\\") 696 | ) 697 | 698 | } 699 | 700 | renv_bootstrap_paths_renv <- function(..., profile = TRUE, project = NULL) { 701 | renv <- Sys.getenv("RENV_PATHS_RENV", unset = "renv") 702 | root <- if (renv_bootstrap_path_absolute(renv)) NULL else project 703 | prefix <- if (profile) renv_bootstrap_profile_prefix() 704 | components <- c(root, renv, prefix, ...) 705 | paste(components, collapse = "/") 706 | } 707 | 708 | renv_bootstrap_project_type <- function(path) { 709 | 710 | descpath <- file.path(path, "DESCRIPTION") 711 | if (!file.exists(descpath)) 712 | return("unknown") 713 | 714 | desc <- tryCatch( 715 | read.dcf(descpath, all = TRUE), 716 | error = identity 717 | ) 718 | 719 | if (inherits(desc, "error")) 720 | return("unknown") 721 | 722 | type <- desc$Type 723 | if (!is.null(type)) 724 | return(tolower(type)) 725 | 726 | package <- desc$Package 727 | if (!is.null(package)) 728 | return("package") 729 | 730 | "unknown" 731 | 732 | } 733 | 734 | renv_bootstrap_user_dir <- function(path) { 735 | dir <- renv_bootstrap_user_dir_impl(path) 736 | chartr("\\", "/", dir) 737 | } 738 | 739 | renv_bootstrap_user_dir_impl <- function(path) { 740 | 741 | # use R_user_dir if available 742 | tools <- asNamespace("tools") 743 | if (is.function(tools$R_user_dir)) 744 | return(tools$R_user_dir("renv", "cache")) 745 | 746 | # try using our own backfill for older versions of R 747 | envvars <- c("R_USER_CACHE_DIR", "XDG_CACHE_HOME") 748 | for (envvar in envvars) { 749 | root <- Sys.getenv(envvar, unset = NA) 750 | if (!is.na(root)) { 751 | path <- file.path(root, "R/renv") 752 | return(path) 753 | } 754 | } 755 | 756 | # use platform-specific default fallbacks 757 | if (Sys.info()[["sysname"]] == "Windows") 758 | file.path(Sys.getenv("LOCALAPPDATA"), "R/cache/R/renv") 759 | else if (Sys.info()[["sysname"]] == "Darwin") 760 | "~/Library/Caches/org.R-project.R/R/renv" 761 | else 762 | "~/.cache/R/renv" 763 | 764 | } 765 | 766 | renv_json_read <- function(file = NULL, text = NULL) { 767 | 768 | text <- paste(text %||% read(file), collapse = "\n") 769 | 770 | # find strings in the JSON 771 | pattern <- '["](?:(?:\\\\.)|(?:[^"\\\\]))*?["]' 772 | locs <- gregexpr(pattern, text)[[1]] 773 | 774 | # if any are found, replace them with placeholders 775 | replaced <- text 776 | strings <- character() 777 | replacements <- character() 778 | 779 | if (!identical(c(locs), -1L)) { 780 | 781 | # get the string values 782 | starts <- locs 783 | ends <- locs + attr(locs, "match.length") - 1L 784 | strings <- substring(text, starts, ends) 785 | 786 | # only keep those requiring escaping 787 | strings <- grep("[[\\]{}:]", strings, perl = TRUE, value = TRUE) 788 | 789 | # compute replacements 790 | replacements <- sprintf('"\032%i\032"', seq_along(strings)) 791 | 792 | # replace the strings 793 | mapply(function(string, replacement) { 794 | replaced <<- sub(string, replacement, replaced, fixed = TRUE) 795 | }, strings, replacements) 796 | 797 | } 798 | 799 | # transform the JSON into something the R parser understands 800 | transformed <- replaced 801 | transformed <- gsub("[[{]", "list(", transformed) 802 | transformed <- gsub("[]}]", ")", transformed) 803 | transformed <- gsub(":", "=", transformed, fixed = TRUE) 804 | text <- paste(transformed, collapse = "\n") 805 | 806 | # parse it 807 | json <- parse(text = text, keep.source = FALSE, srcfile = NULL)[[1L]] 808 | 809 | # construct map between source strings, replaced strings 810 | map <- as.character(parse(text = strings)) 811 | names(map) <- as.character(parse(text = replacements)) 812 | 813 | # convert to list 814 | map <- as.list(map) 815 | 816 | # remap strings in object 817 | remapped <- renv_json_remap(json, map) 818 | 819 | # evaluate 820 | eval(remapped, envir = baseenv()) 821 | 822 | } 823 | 824 | renv_json_remap <- function(json, map) { 825 | 826 | # fix names 827 | if (!is.null(names(json))) { 828 | lhs <- match(names(json), names(map), nomatch = 0L) 829 | rhs <- match(names(map), names(json), nomatch = 0L) 830 | names(json)[rhs] <- map[lhs] 831 | } 832 | 833 | # fix values 834 | if (is.character(json)) 835 | return(map[[json]] %||% json) 836 | 837 | # handle true, false, null 838 | if (is.name(json)) { 839 | text <- as.character(json) 840 | if (text == "true") 841 | return(TRUE) 842 | else if (text == "false") 843 | return(FALSE) 844 | else if (text == "null") 845 | return(NULL) 846 | } 847 | 848 | # recurse 849 | if (is.recursive(json)) { 850 | for (i in seq_along(json)) { 851 | json[i] <- list(renv_json_remap(json[[i]], map)) 852 | } 853 | } 854 | 855 | json 856 | 857 | } 858 | 859 | # load the renv profile, if any 860 | renv_bootstrap_profile_load(project) 861 | 862 | # construct path to library root 863 | root <- renv_bootstrap_library_root(project) 864 | 865 | # construct library prefix for platform 866 | prefix <- renv_bootstrap_platform_prefix() 867 | 868 | # construct full libpath 869 | libpath <- file.path(root, prefix) 870 | 871 | # attempt to load 872 | if (renv_bootstrap_load(project, libpath, version)) 873 | return(TRUE) 874 | 875 | # load failed; inform user we're about to bootstrap 876 | prefix <- paste("# Bootstrapping renv", version) 877 | postfix <- paste(rep.int("-", 77L - nchar(prefix)), collapse = "") 878 | header <- paste(prefix, postfix) 879 | message(header) 880 | 881 | # perform bootstrap 882 | bootstrap(version, libpath) 883 | 884 | # exit early if we're just testing bootstrap 885 | if (!is.na(Sys.getenv("RENV_BOOTSTRAP_INSTALL_ONLY", unset = NA))) 886 | return(TRUE) 887 | 888 | # try again to load 889 | if (requireNamespace("renv", lib.loc = libpath, quietly = TRUE)) { 890 | message("* Successfully installed and loaded renv ", version, ".") 891 | return(renv::load()) 892 | } 893 | 894 | # failed to download or load renv; warn the user 895 | msg <- c( 896 | "Failed to find an renv installation: the project will not be loaded.", 897 | "Use `renv::activate()` to re-initialize the project." 898 | ) 899 | 900 | warning(paste(msg, collapse = "\n"), call. = FALSE) 901 | 902 | }) 903 | -------------------------------------------------------------------------------- /renv/cellar/pilot2wrappers_0.10.0.tar.gz: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/RConsortium/submissions-pilot2/c90937d8527ac9a36a46bad76f056f3880a4249f/renv/cellar/pilot2wrappers_0.10.0.tar.gz -------------------------------------------------------------------------------- /renv/settings.dcf: -------------------------------------------------------------------------------- 1 | bioconductor.version: 2 | external.libraries: 3 | ignored.packages: 4 | package.dependency.fields: Imports, Depends, LinkingTo 5 | r.version: 6 | snapshot.type: implicit 7 | use.cache: TRUE 8 | vcs.ignore.cellar: FALSE 9 | vcs.ignore.library: TRUE 10 | vcs.ignore.local: TRUE 11 | -------------------------------------------------------------------------------- /submissions-pilot2.Rproj: -------------------------------------------------------------------------------- 1 | Version: 1.0 2 | 3 | RestoreWorkspace: Default 4 | SaveWorkspace: Default 5 | AlwaysSaveHistory: Default 6 | 7 | EnableCodeIndexing: Yes 8 | UseSpacesForTab: Yes 9 | NumSpacesForTab: 2 10 | Encoding: UTF-8 11 | 12 | RnwWeave: Sweave 13 | LaTeX: pdfLaTeX 14 | 15 | BuildType: Package 16 | PackageUseDevtools: Yes 17 | PackageInstallArgs: --no-multiarch --with-keep.source 18 | -------------------------------------------------------------------------------- /vignettes/.gitignore: -------------------------------------------------------------------------------- 1 | *.html 2 | *.R 3 | -------------------------------------------------------------------------------- /vignettes/R Consortium R Submission Pilot 2 Cover Letter.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/RConsortium/submissions-pilot2/c90937d8527ac9a36a46bad76f056f3880a4249f/vignettes/R Consortium R Submission Pilot 2 Cover Letter.pdf -------------------------------------------------------------------------------- /vignettes/adrg-prepare.Rmd: -------------------------------------------------------------------------------- 1 | --- 2 | title: "Shiny App Submission Program Preparation" 3 | output: 4 | html_document: 5 | df_print: paged 6 | toc: yes 7 | toc_depth: '2' 8 | toc_float: true 9 | resource_files: 10 | - pdf/*.pdf 11 | --- 12 | 13 | ```{r setup, message=FALSE} 14 | knitr::opts_chunk$set(echo = TRUE) 15 | 16 | library(dplyr) 17 | library(pkglite) 18 | library(purrr) 19 | ``` 20 | 21 | 22 | ```{r, message = FALSE} 23 | # Initiate start-up file 24 | source(file.path(rprojroot::find_root("DESCRIPTION"), "inst/startup.R")) 25 | ``` 26 | # Introduction 27 | 28 | This document summarizes the preparation and installation instructions for the R Consortium Submission Pilot 2 Shiny application. Here is a brief description of the procedures: 29 | 30 | * The application files are assembled into a customized text file using the [`{pkglite}`](https://merck.github.io/pkglite/) R package, with the intent of using this text file to submit the application through the FDA's submission portal based on the FDA's [Electronic Common Technical Document](https://www.fda.gov/drugs/electronic-regulatory-submission-and-review/electronic-common-technical-document-ectd) (eCTD) format. 31 | * Deploy the application locally by unpacking the app source code from the aforementioned text file. Since the Shiny application is created as an R package using the [`{golem}`](https://thinkr-open.github.io/golem/) package, the application can be easily run with a single function call. 32 | 33 | ## Application Dependencies and Environment 34 | 35 | The Shiny application in this pilot was created within R version 4.2.0, and the [`{renv}`](https://rstudio.github.io/renv/index.html) package was used to manage the application dependencies to maintain a reproducible environment. All packages and their associated versions are listed in the table below. 36 | 37 | ```{r, eval = TRUE} 38 | pkg <- desc::desc_get_deps() %>% 39 | filter(type == "Imports") %>% 40 | pull(package) 41 | 42 | # custom code to obtain package title and version 43 | pkg_desc <- tibble::tibble(Package = pkg) %>% 44 | mutate(Title = purrr::map_chr(Package, ~utils::packageDescription(.x, fields = "Title"))) %>% 45 | mutate(Version = purrr::map_chr(Package, ~utils::packageDescription(.x, fields = "Version"))) %>% 46 | arrange(Package) 47 | 48 | pkg_desc 49 | ``` 50 | 51 | ## Pack Shiny Application 52 | 53 | The code below assembles the application's code and supporting files into a custom text file using `{pkglite}` and saved into `ectd/r1pk1.txt`. Please note that the size of this text file is approximately 37 megabytes due to the included data sets within the application. 54 | 55 | ```{r} 56 | # specification for app.R file 57 | app_spec <- file_spec( 58 | ".", 59 | pattern = "\\.R$", 60 | format = "text", 61 | recursive = FALSE 62 | ) 63 | 64 | app_source_spec <- file_spec( 65 | "R", 66 | pattern = "\\.R", 67 | format = "text", 68 | recursive = FALSE 69 | ) 70 | 71 | renv_spec <- file_spec( 72 | ".", 73 | pattern = "\\.lock", 74 | format = "text", 75 | recursive = FALSE 76 | ) 77 | 78 | renv_spec2 <- file_spec( 79 | "renv", 80 | pattern = "\\.R$", 81 | format = "text", 82 | recursive = FALSE 83 | ) 84 | 85 | renv_spec3 <- file_spec( 86 | "renv/cellar", 87 | pattern = "\\.tar.gz|\\.zip", 88 | format = "binary", 89 | recursive = TRUE 90 | ) 91 | 92 | golem_spec <- file_spec( 93 | "dev", 94 | pattern = "^run", 95 | format = "text", 96 | recursive = FALSE 97 | ) 98 | 99 | file_ectd2 <- file_spec( 100 | ".", 101 | pattern = "^DESCRIPTION$|^NAMESPACE$|^README$|^README\\.md$|^NEWS$|^NEWS\\.md$|^LICENSE$|\\.Rbuildignore$|\\.Rprofile$|\\.Renviron$", 102 | format = "text", 103 | recursive = FALSE, 104 | ignore_case = FALSE, 105 | all_files = TRUE 106 | ) 107 | 108 | path$home %>% 109 | collate( 110 | file_ectd2, 111 | file_auto("inst"), 112 | app_spec, 113 | app_source_spec, 114 | renv_spec, 115 | renv_spec2, 116 | renv_spec3, 117 | golem_spec 118 | ) %>% 119 | pack(output = file.path(rprojroot::find_root("DESCRIPTION"), "vignettes/ectd/r1pkg.txt")) 120 | ``` 121 | 122 | ## Application Installation (Dry run) 123 | 124 | To unpack the application source code and supporting files from the custom `ectd/r1pkg.txt` bundle and run the Shiny application, perform the following steps in your preferred R development environment, such as RStudio or a R console session: 125 | 126 | 1. Ensure that the working directory is set to the same location as the downloaded `r1pkg.txt` file, and run the following code: `pkglite::unpack(input = "r0pkg.txt", install = FALSE)`. You should see a series of messages indicating the application files being written to a subdirectory called `pilot2wrappers`. 127 | 1. Launch a new R session in the `pilot2wrappers` subdirectory. 128 | 1. Ensure that the package library is restored with `{renv}` by running the following code: `renv::restore()`. After confirmation, the packages used by the application will be downloaded and installed in a project-specific library. 129 | 1. To run the application, you have the following choices. If you are using RStudio to view the application, open the `app.R` file and click the Run App button at the top of the file window. If you are using an R console, run the following code: `golem:::run_dev()`. 130 | -------------------------------------------------------------------------------- /vignettes/adrg-quarto.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/RConsortium/submissions-pilot2/c90937d8527ac9a36a46bad76f056f3880a4249f/vignettes/adrg-quarto.pdf -------------------------------------------------------------------------------- /vignettes/cover-letter.Rmd: -------------------------------------------------------------------------------- 1 | --- 2 | title: "R Consortium R Submission Pilot 2 Cover Letter" 3 | author: "Eric Nantz" 4 | output: 5 | pagedown::html_letter: 6 | self_contained: true 7 | links-to-footnotes: true 8 | paged-footnotes: true 9 | # uncomment this line to produce HTML and PDF in RStudio: 10 | #knit: pagedown::chrome_print 11 | --- 12 | 13 | ```{css, echo=FALSE} 14 | body { 15 | font-family: Palatino, "Palatino Linotype", "Palatino LT STD", Georgia, 'Source Han Serif', 'Songti SC', serif; 16 | line-height: 1.2em; 17 | } 18 | 19 | .date { 20 | margin-top: 1em; 21 | } 22 | 23 | @page { 24 | size: letter; 25 | margin: 3cm 2cm; 26 | 27 | @top-left { 28 | content: element(header-logo); 29 | } 30 | @bottom-right { 31 | content: counter(page); 32 | } 33 | } 34 | ``` 35 | 36 | ![The R consortium logo](rconsortium.png){.logo} 37 | 38 | Food and Drug Administration 39 | Center for Drug Evaluation and Research 5901-B Ammendale Road 40 | Beltsville, MD 20705-1266 41 | 42 | ::: date 43 | `r format(Sys.time(), "%b %e, %Y")` 44 | ::: 45 | 46 | Dear Sir/Madam: 47 | 48 | This letter serves as an introduction to the R Consortium R submission Pilot 2. The objective of the R Consortium R submission Pilot 2 Project is to test the concept that a Shiny application created with the R-language can be successfully bundled into a submission package and transferred to FDA reviewers. All submission materials and communications from this pilot will be shared publicly, with the aim of providing a working example for future R language based FDA submissions which include Shiny applications. This is an FDA-industry collaboration through the non-profit organization R Consortium. 49 | 50 | The R Consortium R submission Pilot 2 submission package follows the eCTD folder structure and contains the following module 5 deliverables: 51 | 52 | - A cover letter 53 | - SAS transport files (xpt) from CDISC ADaM/SDTM submission pilot CDISCPILOT01 54 | - One proprietary R package "pilot2wrappers" which enables execution of the Shiny application 55 | - An Analysis Data Reviewer's Guide (ADRG) 56 | 57 | In this pilot, we aimed to provide a working example of a Shiny application created with R contained within a submission in eCTD format to the pharmaceutical industry in compliance with the FDA Electronic Submissions Gateway requirements. Based on the submission package, FDA Staff can review and reproduce submitted R codes. The aforementioned ADRG contains a comprehensive description of the Shiny applicaiton components as well as specific instructions for executing the Shiny application on a local R environment. More specifically, we expect the FDA Staff to 58 | 59 | - Receive electronic submission packages in eCTD format 60 | - Install and load open source R packages used as dependencies of the included Shiny application 61 | - Reconstruct and load the submitted Shiny application contained in the "pilot2wrappers" R package 62 | - Share potential improvements to the submission deliverables and processes via a written communication 63 | 64 | All data, code, material and communications from this pilot will be shared publicly. 65 | 66 | Different open-source packages were used to create the Shiny application. Evaluating FDA’s acceptance of system/software validation evidence is not in the scope of this pilot. 67 | 68 | On behalf of the R Consortium R Submission Working Group, we hope the pilot 2 project can establish a working example to guide the industry for future submission of Shiny applications created with the R language. 69 | 70 | Kind regards, 71 | 72 | The R Consortium R Submission Pilot 2 Project Team 73 | -------------------------------------------------------------------------------- /vignettes/cover-letter_files/paged-0.18/css/default.css: -------------------------------------------------------------------------------- 1 | :root { 2 | --background: whitesmoke; 3 | --pagedjs-width: 6in; 4 | --pagedjs-height: 9in; 5 | --color-paper: white; 6 | --color-mbox: rgba(0, 0, 0, 0.2); 7 | --running-title-width: 2.5in; 8 | --screen-pages-spacing: 5mm; 9 | } 10 | 11 | html { 12 | line-height: 1.3; 13 | } 14 | 15 | /* generated content */ 16 | a[href^="http"]:not([class="uri"])::after { 17 | content: " (" attr(href) ")"; 18 | font-size: 90%; 19 | hyphens: none; 20 | word-break: break-all; 21 | } 22 | .references a[href^=http]:not([class=uri])::after { 23 | content: none; 24 | } 25 | .main a[href^="#"]:not([class^="footnote-"]):not([href*=":"])::after { 26 | content: " (page " target-counter(attr(href), page) ")"; 27 | } 28 | .main a.front-matter-ref[href^="#"]:not([class^="footnote-"]):not([href*=":"])::after { 29 | content: " (page " target-counter(attr(href), page, lower-roman) ")"; 30 | } 31 | /* do not include page references in code blocks */ 32 | .sourceCode a[href^="#"]:not([class^="footnote-"]):not([href*=":"])::after, 33 | .sourceCode a.front-matter-ref[href^="#"]:not([class^="footnote-"]):not([href*=":"])::after { 34 | content: unset; 35 | } 36 | 37 | /* TOC, LOT, LOF */ 38 | .toc ul, .lot ul, .lof ul { 39 | list-style: none; 40 | padding-left: 0; 41 | overflow-x: hidden; 42 | } 43 | .toc li li { 44 | padding-left: 1em; 45 | } 46 | .toc a, .lot a, .lof a { 47 | text-decoration: none; 48 | background: white; 49 | padding-right: .33em; 50 | } 51 | .toc a::after, .lot a::after, .lof a::after { 52 | /* content: leader(dotted) target-counter(attr(href), page); */ 53 | content: target-counter(attr(href), page); 54 | float: right; 55 | background: white; 56 | } 57 | .toc a.front-matter-ref::after, .lot a.front-matter-ref::after, .lof a.front-matter-ref::after { 58 | /* content: leader(dotted) target-counter(attr(href), page, lower-roman); */ 59 | content: target-counter(attr(href), page, lower-roman); 60 | } 61 | .toc .leaders::before, .lot .leaders::before, .lof .leaders::before { 62 | float: left; 63 | width: 0; 64 | white-space: nowrap; 65 | content: ". . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . "; 66 | } 67 | 68 | /* Chapter name */ 69 | .chapter > h1 > .header-section-number::before, .chapter-ref > .toc-section-number::before { 70 | content: var(--chapter-name-before, "Chapter "); 71 | } 72 | .chapter > h1 > .header-section-number::after, .chapter-ref > .toc-section-number::after { 73 | content: var(--chapter-name-after, ""); 74 | } 75 | 76 | /* misc elements */ 77 | .subtitle span { 78 | font-size: .9em; 79 | } 80 | img { 81 | max-width: 100%; 82 | } 83 | pre { 84 | padding: 1em; 85 | white-space: pre-wrap; 86 | } 87 | pre[class] { 88 | background: #f9f9f9; 89 | } 90 | abbr { 91 | text-decoration: none; 92 | } 93 | 94 | @media screen { 95 | div.sourceCode { 96 | overflow: visible !important; 97 | } 98 | a.sourceLine::before { 99 | text-decoration: unset !important; 100 | } 101 | } 102 | pre.numberSource a.sourceLine { 103 | left: 0 !important; 104 | text-indent: -5em 105 | } 106 | pre.numberSource { 107 | margin-left: 0 !important; 108 | } 109 | table { 110 | margin: auto; 111 | border-top: 1px solid #666; 112 | border-bottom: 1px solid #666; 113 | } 114 | table thead th { 115 | border-bottom: 1px solid #ddd; 116 | } 117 | thead, tfoot, tr:nth-child(even) { 118 | background: #eee; 119 | } 120 | /* knitr::kables styling, see https://github.com/rstudio/pagedown/issues/214 */ 121 | .kable_wrapper > tbody > tr > td { 122 | vertical-align: top; 123 | } 124 | .footnotes { 125 | font-size: 90%; 126 | } 127 | .footnotes hr::before { 128 | content: "Footnotes:"; 129 | } 130 | .footnotes hr { 131 | border: none; 132 | } 133 | .footnote-break { 134 | width: 1in; 135 | } 136 | body { 137 | hyphens: auto; 138 | } 139 | code { 140 | hyphens: none; 141 | } 142 | 143 | /* two pages in a row if possible on screen */ 144 | @media screen { 145 | body { 146 | background-color: var(--background); 147 | margin: var(--screen-pages-spacing) auto 0 auto; 148 | } 149 | .pagedjs_pages { 150 | display: flex; 151 | max-width: calc(var(--pagedjs-width) * 2); 152 | flex: 0; 153 | flex-wrap: wrap; 154 | margin: 0 auto; 155 | } 156 | .pagedjs_page { 157 | background-color: var(--color-paper); 158 | box-shadow: 0 0 0 1px var(--color-mbox); 159 | flex-shrink: 0; 160 | flex-grow: 0; 161 | margin: auto auto var(--screen-pages-spacing) auto; 162 | } 163 | } 164 | 165 | /* when a row can hold two pages, start first page on the right */ 166 | @media screen and (min-width: 12.32in) { 167 | .pagedjs_page { 168 | margin: auto 0 var(--screen-pages-spacing) 0; 169 | } 170 | .pagedjs_first_page { 171 | margin-left: var(--pagedjs-width); 172 | } 173 | } 174 | 175 | /* use a fixed width body for mobiles */ 176 | @media screen and (max-width:1180px) { 177 | body { 178 | width: calc(var(--pagedjs-width) + 2 * var(--screen-pages-spacing)); 179 | } 180 | } 181 | -------------------------------------------------------------------------------- /vignettes/cover-letter_files/paged-0.18/css/letter.css: -------------------------------------------------------------------------------- 1 | body { 2 | font-family: Palatino, "Palatino Linotype", "Palatino LT STD", Georgia, 'Source Han Serif', 'Songti SC', serif; 3 | line-height: 1.5em; 4 | } 5 | 6 | .title-page { 7 | display: none; 8 | } 9 | 10 | .from, .date { 11 | text-align: right; 12 | } 13 | .from p { 14 | text-align: left; 15 | display: inline-block; 16 | } 17 | 18 | .logo { 19 | position: running(header-logo); 20 | height: 1cm; 21 | } 22 | 23 | .date { 24 | margin-top: 4em; 25 | } 26 | 27 | @page { 28 | size: letter; 29 | margin: 4cm 3cm; 30 | 31 | @top-left { 32 | content: element(header-logo); 33 | } 34 | @bottom-right { 35 | content: counter(page); 36 | } 37 | } 38 | 39 | @media screen and (min-width: 12.32in) { 40 | .pagedjs_page, .pagedjs_first_page { 41 | margin: auto auto 5mm auto; 42 | } 43 | } 44 | -------------------------------------------------------------------------------- /vignettes/cover-letter_files/paged-0.18/js/config.js: -------------------------------------------------------------------------------- 1 | // Configuration script for paged.js 2 | 3 | (function() { 4 | // Retrieve previous config object if defined 5 | window.PagedConfig = window.PagedConfig || {}; 6 | const {before: beforePaged, after: afterPaged} = window.PagedConfig; 7 | 8 | // utils 9 | const insertCSS = text => { 10 | let style = document.createElement('style'); 11 | style.type = 'text/css'; 12 | style.appendChild(document.createTextNode(text)); 13 | document.head.appendChild(style); 14 | }; 15 | 16 | // Util function for front and back covers images 17 | const insertCSSForCover = type => { 18 | const links = document.querySelectorAll('link[id^=' + type + ']'); 19 | if (!links.length) return; 20 | const re = new RegExp(type + '-\\d+'); 21 | let text = ':root {--' + type + ': var(--' + type + '-1);'; 22 | for (const link of links) { 23 | text += '--' + re.exec(link.id)[0] + ': url("' + link.href + '");'; 24 | } 25 | text += '}'; 26 | insertCSS(text); 27 | }; 28 | 29 | const insertPageBreaksCSS = () => { 30 | insertCSS(` 31 | .page-break-after {break-after: page;} 32 | .page-break-before {break-before: page;} 33 | `); 34 | }; 35 | 36 | window.PagedConfig.before = async () => { 37 | // Front and back covers support 38 | let frontCover = document.querySelector('.front-cover'); 39 | let backCover = document.querySelector('.back-cover'); 40 | if (frontCover) document.body.prepend(frontCover); 41 | if (backCover) document.body.append(backCover); 42 | insertCSSForCover('front-cover'); 43 | insertCSSForCover('back-cover'); 44 | insertPageBreaksCSS(); 45 | 46 | if (beforePaged) await beforePaged(); 47 | }; 48 | 49 | // from https://stackoverflow.com/q/21647928 50 | const toUTF16BE = x => { 51 | let res = ''; 52 | for (i=0; i < x.length; i++) { 53 | let hex = x.charCodeAt(i).toString(16); 54 | hex = ('000' + hex).slice(-4); 55 | res += hex 56 | } 57 | res = 'feff' + res ; 58 | return res; 59 | } 60 | 61 | const findPage = el => { 62 | while (el.parentElement) { 63 | el = el.parentElement; 64 | if (el.getAttribute('data-page-number')) { 65 | return parseInt(el.getAttribute('data-page-number')); 66 | } 67 | } 68 | return null; 69 | }; 70 | 71 | const tocEntriesInfos = ul => { 72 | let result = []; // where we store the results 73 | // if there is no element, return an empty array 74 | if (!ul) { 75 | return result; 76 | } 77 | const tocEntries = ul.children; // tocEntries are 'li' elements 78 | 79 | for (const li of tocEntries) { 80 | // Since parts entries in TOC have no anchor, 81 | // do not use them in the PDF outline. 82 | if (li.classList.contains('part')) { 83 | continue; 84 | } 85 | 86 | // get the title and encode it in UTF16BE (pdfmark is encoded in UTF16BE with BOM) 87 | const title = toUTF16BE(li.querySelector('a').textContent); 88 | 89 | // get the page number 90 | const href = li.querySelector('a').getAttribute('href'); 91 | const el = document.getElementById(href.substring(1)); 92 | const page = findPage(el); 93 | 94 | // get the children 95 | children = tocEntriesInfos(li.querySelector('ul')); 96 | 97 | result.push({ 98 | title: title, 99 | page: page, 100 | children: children 101 | }); 102 | } 103 | 104 | return result; 105 | }; 106 | window.PagedConfig.after = (flow) => { 107 | // force redraw, see https://github.com/rstudio/pagedown/issues/35#issuecomment-475905361 108 | // and https://stackoverflow.com/a/24753578/6500804 109 | document.body.style.display = 'none'; 110 | document.body.offsetHeight; 111 | document.body.style.display = ''; 112 | 113 | // run previous PagedConfig.after function if defined 114 | if (afterPaged) afterPaged(flow); 115 | 116 | // pagedownListener is a binding added by the chrome_print function 117 | // this binding exists only when chrome_print opens the html file 118 | if (window.pagedownListener) { 119 | // the html file is opened for printing 120 | // call the binding to signal to the R session that Paged.js has finished 121 | const tocList = flow.source.querySelector('.toc > ul'); 122 | const tocInfos = tocEntriesInfos(tocList); 123 | pagedownListener(JSON.stringify({ 124 | pagedjs: true, 125 | pages: flow.total, 126 | elapsedtime: flow.performance, 127 | tocInfos: tocInfos 128 | })); 129 | return; 130 | } 131 | if (sessionStorage.getItem('pagedown-scroll')) { 132 | // scroll to the last position before the page is reloaded 133 | window.scrollTo(0, sessionStorage.getItem('pagedown-scroll')); 134 | return; 135 | } 136 | if (window.location.hash) { 137 | const id = decodeURIComponent(window.location.hash).replace(/^#/, ''); 138 | document.getElementById(id).scrollIntoView({behavior: 'smooth'}); 139 | } 140 | }; 141 | })(); 142 | -------------------------------------------------------------------------------- /vignettes/cover-letter_files/paged-0.18/js/hooks.js: -------------------------------------------------------------------------------- 1 | // Hooks for paged.js 2 | { 3 | // Utils 4 | let pandocMeta, pandocMetaToString; 5 | { 6 | let el = document.getElementById('pandoc-meta'); 7 | pandocMeta = el ? JSON.parse(el.firstChild.data) : {}; 8 | } 9 | 10 | pandocMetaToString = meta => { 11 | let el = document.createElement('div'); 12 | el.innerHTML = meta; 13 | return el.innerText; 14 | }; 15 | 16 | let isString = value => { 17 | return typeof value === 'string' || value instanceof String; 18 | }; 19 | 20 | let isArray = value => { 21 | return value && typeof value === 'object' && value.constructor === Array; 22 | }; 23 | 24 | // This hook is an attempt to fix https://github.com/rstudio/pagedown/issues/131 25 | // Sometimes, the {break-after: avoid;} declaration applied on headers 26 | // lead to duplicated headers. I hate this bug. 27 | // This is linked to the way the HTML source is written 28 | // When we have the \n character like this:
\n

...

29 | // the header may be duplicated. 30 | // But, if we have

...

without any \n, the problem disappear 31 | // I think this handler can fix most of cases 32 | // Obviously, we cannot suppress all the \n in the HTML document 33 | // because carriage returns are important in
 elements.
 34 |   // Tested with Chrome 76.0.3809.100/Windows
 35 |   Paged.registerHandlers(class extends Paged.Handler {
 36 |     constructor(chunker, polisher, caller) {
 37 |       super(chunker, polisher, caller);
 38 |       this.carriageReturn = String.fromCharCode(10);
 39 |     }
 40 | 
 41 |     checkNode(node) {
 42 |       if (!node) return;
 43 |       if (node.nodeType !== 3) return;
 44 |       if (node.textContent === this.carriageReturn) {
 45 |         node.remove();
 46 |       }
 47 |     }
 48 | 
 49 |     afterParsed(parsed) {
 50 |       let template = document.querySelector('template').content;
 51 |       const breakAfterAvoidElements = template.querySelectorAll('[data-break-after="avoid"], [data-break-before="avoid"]');
 52 |       for (let el of breakAfterAvoidElements) {
 53 |         this.checkNode(el.previousSibling);
 54 |         this.checkNode(el.nextSibling);
 55 |       }
 56 |     }
 57 |   });
 58 | 
 59 |   // This hook creates a list of abbreviations
 60 |   // Note: we also could implement this feature using a Pandoc filter
 61 |   Paged.registerHandlers(class extends Paged.Handler {
 62 |     constructor(chunker, polisher, caller) {
 63 |       super(chunker, polisher, caller);
 64 |     }
 65 |     beforeParsed(content) {
 66 |       // Find the abbreviation nodes
 67 |       const abbrNodeList = content.querySelectorAll('abbr');
 68 | 
 69 |       // Return early if there is no abbreviation
 70 |       if (abbrNodeList.length === 0) return;
 71 | 
 72 |       // Store unique values of abbreviations, see https://github.com/rstudio/pagedown/issues/218
 73 |       let abbreviations = [];
 74 |       for (const {title, innerHTML} of abbrNodeList.values()) {
 75 |         if (abbreviations.find(el => el.title === title && el.innerHTML === innerHTML)) {
 76 |           continue;
 77 |         }
 78 |         abbreviations.push({title: title, innerHTML: innerHTML});
 79 |       }
 80 | 
 81 |       const loaTitle = pandocMeta['loa-title'] ? pandocMetaToString(pandocMeta['loa-title']) : 'List of Abbreviations';
 82 |       const loaId = 'LOA';
 83 |       const tocList = content.querySelector('.toc ul');
 84 |       let listOfAbbreviations = document.createElement('div');
 85 |       let descriptionList = document.createElement('dl');
 86 |       content.appendChild(listOfAbbreviations);
 87 |       listOfAbbreviations.id = loaId;
 88 |       listOfAbbreviations.classList.add('section', 'front-matter', 'level1', 'loa');
 89 |       listOfAbbreviations.innerHTML = '

' + loaTitle + '

'; 90 | listOfAbbreviations.appendChild(descriptionList); 91 | for(let abbr of abbreviations) { 92 | if(!abbr.title) continue; 93 | let term = document.createElement('dt'); 94 | let definition = document.createElement('dd'); 95 | descriptionList.appendChild(term); 96 | descriptionList.appendChild(definition); 97 | term.innerHTML = abbr.innerHTML; 98 | definition.innerText = abbr.title; 99 | } 100 | if (tocList) { 101 | const loaTOCItem = document.createElement('li'); 102 | loaTOCItem.innerHTML = '' + loaTitle + ''; 103 | tocList.appendChild(loaTOCItem); 104 | } 105 | } 106 | }); 107 | 108 | // This hook moves the sections of class front-matter in the div.front-matter-container 109 | Paged.registerHandlers(class extends Paged.Handler { 110 | constructor(chunker, polisher, caller) { 111 | super(chunker, polisher, caller); 112 | } 113 | 114 | beforeParsed(content) { 115 | const frontMatter = content.querySelector('.front-matter-container'); 116 | if (!frontMatter) return; 117 | 118 | // move front matter sections in the front matter container 119 | const frontMatterSections = content.querySelectorAll('.level1.front-matter'); 120 | for (const section of frontMatterSections) { 121 | frontMatter.appendChild(section); 122 | } 123 | 124 | // add the class front-matter-ref to any element 125 | // referring to an entry in the front matter 126 | const anchors = content.querySelectorAll('a[href^="#"]:not([href*=":"])'); 127 | for (const a of anchors) { 128 | const ref = a.getAttribute('href').replace(/^#/, ''); 129 | const element = content.getElementById(ref); 130 | if (frontMatter.contains(element)) a.classList.add('front-matter-ref'); 131 | } 132 | 133 | // update the toc, lof and lot for front matter sections 134 | const frontMatterSectionsLinks = content.querySelectorAll('.toc .front-matter-ref, .lof .front-matter-ref, .lot .front-matter-ref'); 135 | for (let i = frontMatterSectionsLinks.length - 1; i >= 0; i--) { 136 | const listItem = frontMatterSectionsLinks[i].parentNode; 137 | const list = listItem.parentNode; 138 | list.insertBefore(listItem, list.firstChild); 139 | } 140 | } 141 | }); 142 | 143 | // This hook expands the links in the lists of figures and tables 144 | Paged.registerHandlers(class extends Paged.Handler { 145 | constructor(chunker, polisher, caller) { 146 | super(chunker, polisher, caller); 147 | } 148 | 149 | beforeParsed(content) { 150 | const items = content.querySelectorAll('.lof li, .lot li'); 151 | for (const item of items) { 152 | const anchor = item.firstChild; 153 | anchor.innerText = item.innerText; 154 | item.innerText = ''; 155 | item.append(anchor); 156 | } 157 | } 158 | }); 159 | 160 | // This hook adds spans for leading symbols 161 | Paged.registerHandlers(class extends Paged.Handler { 162 | constructor(chunker, polisher, caller) { 163 | super(chunker, polisher, caller); 164 | } 165 | 166 | beforeParsed(content) { 167 | const anchors = content.querySelectorAll('.toc a, .lof a, .lot a'); 168 | for (const a of anchors) { 169 | a.innerHTML = a.innerHTML + ''; 170 | } 171 | } 172 | }); 173 | 174 | // This hook appends short titles spans 175 | Paged.registerHandlers(class extends Paged.Handler { 176 | constructor(chunker, polisher, caller) { 177 | super(chunker, polisher, caller); 178 | } 179 | 180 | beforeParsed(content) { 181 | /* A factory returning a function that appends short titles spans. 182 | The text content of these spans are reused for running titles (see default.css). 183 | Argument: level - An integer between 1 and 6. 184 | */ 185 | function appendShortTitleSpans(level) { 186 | return () => { 187 | const divs = Array.from(content.querySelectorAll('.level' + level)); 188 | 189 | function addSpan(div) { 190 | const mainHeader = div.getElementsByTagName('h' + level)[0]; 191 | if (!mainHeader) return; 192 | const mainTitle = mainHeader.textContent; 193 | const spanSectionNumber = mainHeader.getElementsByClassName('header-section-number')[0]; 194 | const mainNumber = !!spanSectionNumber ? spanSectionNumber.textContent : ''; 195 | const runningTitle = 'shortTitle' in div.dataset ? mainNumber + ' ' + div.dataset.shortTitle : mainTitle; 196 | const span = document.createElement('span'); 197 | span.className = 'shorttitle' + level; 198 | span.innerText = runningTitle; 199 | span.style.display = "none"; 200 | mainHeader.appendChild(span); 201 | if (level == 1 && div.querySelector('.level2') === null) { 202 | let span2 = document.createElement('span'); 203 | span2.className = 'shorttitle2'; 204 | span2.innerText = ' '; 205 | span2.style.display = "none"; 206 | span.insertAdjacentElement('afterend', span2); 207 | } 208 | } 209 | 210 | for (const div of divs) { 211 | addSpan(div); 212 | } 213 | }; 214 | } 215 | 216 | appendShortTitleSpans(1)(); 217 | appendShortTitleSpans(2)(); 218 | } 219 | }); 220 | 221 | // Footnotes support 222 | Paged.registerHandlers(class extends Paged.Handler { 223 | constructor(chunker, polisher, caller) { 224 | super(chunker, polisher, caller); 225 | 226 | this.splittedParagraphRefs = []; 227 | } 228 | 229 | beforeParsed(content) { 230 | // remove footnotes in toc, lof, lot 231 | // see https://github.com/rstudio/pagedown/issues/54 232 | let removeThese = content.querySelectorAll('.toc .footnote, .lof .footnote, .lot .footnote'); 233 | for (const el of removeThese) { 234 | el.remove(); 235 | } 236 | 237 | let footnotes = content.querySelectorAll('.footnote'); 238 | 239 | for (let footnote of footnotes) { 240 | let parentElement = footnote.parentElement; 241 | let footnoteCall = document.createElement('a'); 242 | let footnoteNumber = footnote.dataset.pagedownFootnoteNumber; 243 | 244 | footnoteCall.className = 'footnote-ref'; // same class as Pandoc 245 | footnoteCall.setAttribute('id', 'fnref' + footnoteNumber); // same notation as Pandoc 246 | footnoteCall.setAttribute('href', '#' + footnote.id); 247 | footnoteCall.innerHTML = '' + footnoteNumber +''; 248 | parentElement.insertBefore(footnoteCall, footnote); 249 | 250 | // Here comes a hack. Fortunately, it works with Chrome and FF. 251 | let handler = document.createElement('p'); 252 | handler.className = 'footnoteHandler'; 253 | parentElement.insertBefore(handler, footnote); 254 | handler.appendChild(footnote); 255 | handler.style.display = 'inline-block'; 256 | handler.style.width = '100%'; 257 | handler.style.float = 'right'; 258 | handler.style.pageBreakInside = 'avoid'; 259 | } 260 | } 261 | 262 | afterPageLayout(pageFragment, page, breakToken) { 263 | function hasItemParent(node) { 264 | if (node.parentElement === null) { 265 | return false; 266 | } else { 267 | if (node.parentElement.tagName === 'LI') { 268 | return true; 269 | } else { 270 | return hasItemParent(node.parentElement); 271 | } 272 | } 273 | } 274 | // If a li item is broken, we store the reference of the p child element 275 | // see https://github.com/rstudio/pagedown/issues/23#issue-376548000 276 | if (breakToken !== undefined) { 277 | if (breakToken.node.nodeName === "#text" && hasItemParent(breakToken.node)) { 278 | this.splittedParagraphRefs.push(breakToken.node.parentElement.dataset.ref); 279 | } 280 | } 281 | } 282 | 283 | afterRendered(pages) { 284 | for (let page of pages) { 285 | const footnotes = page.element.querySelectorAll('.footnote'); 286 | if (footnotes.length === 0) { 287 | continue; 288 | } 289 | 290 | const pageContent = page.element.querySelector('.pagedjs_page_content'); 291 | let hr = document.createElement('hr'); 292 | let footnoteArea = document.createElement('div'); 293 | 294 | pageContent.style.display = 'flex'; 295 | pageContent.style.flexDirection = 'column'; 296 | 297 | hr.className = 'footnote-break'; 298 | hr.style.marginTop = 'auto'; 299 | hr.style.marginBottom = 0; 300 | hr.style.marginLeft = 0; 301 | hr.style.marginRight = 'auto'; 302 | pageContent.appendChild(hr); 303 | 304 | footnoteArea.className = 'footnote-area'; 305 | pageContent.appendChild(footnoteArea); 306 | 307 | for (let footnote of footnotes) { 308 | let handler = footnote.parentElement; 309 | 310 | footnoteArea.appendChild(footnote); 311 | handler.parentNode.removeChild(handler); 312 | 313 | footnote.innerHTML = '' + footnote.dataset.pagedownFootnoteNumber + '' + footnote.innerHTML; 314 | footnote.style.fontSize = 'x-small'; 315 | footnote.style.marginTop = 0; 316 | footnote.style.marginBottom = 0; 317 | footnote.style.paddingTop = 0; 318 | footnote.style.paddingBottom = 0; 319 | footnote.style.display = 'block'; 320 | } 321 | } 322 | 323 | for (let ref of this.splittedParagraphRefs) { 324 | let paragraphFirstPage = document.querySelector('[data-split-to="' + ref + '"]'); 325 | // We test whether the paragraph is empty 326 | // see https://github.com/rstudio/pagedown/issues/23#issue-376548000 327 | if (paragraphFirstPage.innerText === "") { 328 | paragraphFirstPage.parentElement.style.display = "none"; 329 | let paragraphSecondPage = document.querySelector('[data-split-from="' + ref + '"]'); 330 | paragraphSecondPage.parentElement.style.setProperty('list-style', 'inherit', 'important'); 331 | } 332 | } 333 | } 334 | }); 335 | 336 | // Support for "Chapter " label on section with class `.chapter` 337 | Paged.registerHandlers(class extends Paged.Handler { 338 | constructor(chunker, polisher, caller) { 339 | super(chunker, polisher, caller); 340 | 341 | this.options = pandocMeta['chapter_name']; 342 | 343 | let styles; 344 | if (isString(this.options)) { 345 | this.options = pandocMetaToString(this.options); 346 | styles = ` 347 | :root { 348 | --chapter-name-before: "${this.options}"; 349 | } 350 | `; 351 | } 352 | if (isArray(this.options)) { 353 | this.options = this.options.map(pandocMetaToString); 354 | styles = ` 355 | :root { 356 | --chapter-name-before: "${this.options[0]}"; 357 | --chapter-name-after: "${this.options[1]}"; 358 | } 359 | `; 360 | } 361 | if (styles) polisher.insert(styles); 362 | } 363 | 364 | beforeParsed(content) { 365 | const tocAnchors = content.querySelectorAll('.toc a[href^="#"]:not([href*=":"]'); 366 | for (const anchor of tocAnchors) { 367 | const ref = anchor.getAttribute('href').replace(/^#/, ''); 368 | const element = content.getElementById(ref); 369 | if (element.classList.contains('chapter')) { 370 | anchor.classList.add('chapter-ref'); 371 | } 372 | } 373 | } 374 | }); 375 | 376 | // Main text line numbering, 377 | // see https://github.com/rstudio/pagedown/issues/115 378 | // Original idea: Julien Taquet, thanks! 379 | Paged.registerHandlers(class extends Paged.Handler { 380 | constructor(chunker, polisher, caller) { 381 | super(chunker, polisher, caller); 382 | 383 | // get the number-lines option from Pandoc metavariables 384 | this.options = pandocMeta['number-lines']; 385 | // quit early if the "number-lines" option is false or missing 386 | if (!this.options) return; 387 | // retrieve the selector if provided, otherwise use the default selector 388 | this.selector = this.options.selector ? pandocMetaToString(this.options.selector) : '.level1:not(.front-matter) h1, .level1 h2, .level1 h3, .level1 p'; 389 | 390 | const styles = ` 391 | :root { 392 | --line-numbers-padding-right: 10px; 393 | --line-numbers-font-size: 8pt; 394 | } 395 | .pagedown-linenumbers-container { 396 | position: absolute; 397 | margin-top: var(--pagedjs-margin-top); 398 | right: calc(var(--pagedjs-width) - var(--pagedjs-margin-left)); 399 | } 400 | .maintextlinenumbers { 401 | position: absolute; 402 | right: 0; 403 | text-align: right; 404 | padding-right: var(--line-numbers-padding-right); 405 | font-size: var(--line-numbers-font-size); 406 | } 407 | `; 408 | polisher.insert(styles); 409 | 410 | this.resetLinesCounter(); 411 | } 412 | 413 | appendLineNumbersContainer(page) { 414 | const pagebox = page.element.querySelector('.pagedjs_pagebox'); 415 | const lineNumbersContainer = document.createElement('div'); 416 | lineNumbersContainer.classList.add('pagedown-linenumbers-container'); 417 | 418 | return pagebox.appendChild(lineNumbersContainer); 419 | } 420 | 421 | lineHeight(element) { 422 | // If the document stylesheet does not define a value for line-height, 423 | // Blink returns "normal". Therefore, parseInt may return NaN. 424 | return parseInt(getComputedStyle(element).lineHeight); 425 | } 426 | 427 | innerHeight(element) { 428 | let outerHeight = element.getBoundingClientRect().height; 429 | let {borderTopWidth, 430 | borderBottomWidth, 431 | paddingTop, 432 | paddingBottom} = getComputedStyle(element); 433 | 434 | borderTopWidth = parseFloat(borderTopWidth); 435 | borderBottomWidth = parseFloat(borderBottomWidth); 436 | paddingTop = parseFloat(paddingTop); 437 | paddingBottom = parseFloat(paddingBottom); 438 | 439 | return Math.round(outerHeight - borderTopWidth - borderBottomWidth - paddingTop - paddingBottom); 440 | } 441 | 442 | arrayOfInt(from, length) { 443 | // adapted from https://stackoverflow.com/a/50234108/6500804 444 | return Array.from(Array(length).keys(), n => n + from); 445 | } 446 | 447 | incrementLinesCounter(value) { 448 | this.linesCounter = this.linesCounter + value; 449 | } 450 | 451 | resetLinesCounter() { 452 | this.linesCounter = 0; 453 | } 454 | 455 | isDisplayMath(element) { 456 | const nodes = element.childNodes; 457 | if (nodes.length != 1) return false; 458 | return (nodes[0].nodeName === 'SPAN') && (nodes[0].classList.value === 'math display'); 459 | } 460 | 461 | afterRendered(pages) { 462 | if (!this.options) return; 463 | 464 | for (let page of pages) { 465 | const lineNumbersContainer = this.appendLineNumbersContainer(page); 466 | const pageAreaY = page.area.getBoundingClientRect().y; 467 | let elementsToNumber = page.area.querySelectorAll(this.selector); 468 | 469 | for (let element of elementsToNumber) { 470 | // Do not add line numbers for display math environment 471 | if (this.isDisplayMath(element)) continue; 472 | 473 | // Try to retrieve line height 474 | const lineHeight = this.lineHeight(element); 475 | // Test against lineHeight method returns NaN 476 | if (!lineHeight) { 477 | console.warn('Failed to compute line height value on "' + page.id + '".'); 478 | continue; 479 | } 480 | 481 | const innerHeight = this.innerHeight(element); 482 | 483 | // Number of lines estimation 484 | // There is no built-in method to detect the number of lines in a block. 485 | // The main caveat is that an actual line height can differ from 486 | // the line-height CSS property. 487 | // Mixed fonts, subscripts, superscripts, inline math... can increase 488 | // the actual line height. 489 | // Here, we divide the inner height of the block by the line-height 490 | // computed property and round to the floor to take into account that 491 | // sometimes the actual line height is greater than its property value. 492 | // This is far from perfect and can be easily broken especially by 493 | // inline math. 494 | const nLines = Math.floor(innerHeight / lineHeight); 495 | 496 | // do not add line numbers for void paragraphs 497 | if (nLines <= 0) continue; 498 | 499 | const linenumbers = document.createElement('div'); 500 | lineNumbersContainer.appendChild(linenumbers); 501 | linenumbers.classList.add('maintextlinenumbers'); 502 | 503 | const elementY = element.getBoundingClientRect().y; 504 | linenumbers.style.top = (elementY - pageAreaY) + 'px'; 505 | 506 | const cs = getComputedStyle(element); 507 | const paddingTop = parseFloat(cs.paddingTop) + parseFloat(cs.borderTopWidth); 508 | linenumbers.style.paddingTop = paddingTop + 'px'; 509 | 510 | linenumbers.style.lineHeight = cs.lineHeight; 511 | 512 | linenumbers.innerHTML = this.arrayOfInt(this.linesCounter + 1, nLines) 513 | .reduce((t, v) => t + '
' + v); 514 | this.incrementLinesCounter(nLines); 515 | } 516 | 517 | if (this.options['reset-page']) { 518 | this.resetLinesCounter(); 519 | } 520 | } 521 | } 522 | }); 523 | 524 | // Clean links to avoid impossible line breaking of long urls in a justified text 525 | // Author: Julien Taquet (Paged.js core team) 526 | // see https://github.com/spyrales/gouvdown/issues/37 527 | Paged.registerHandlers(class extends Paged.Handler { 528 | constructor(chunker, polisher, caller) { 529 | super(chunker, polisher, caller); 530 | } 531 | beforeParsed(content) { 532 | // add wbr to / in links 533 | const links = content.querySelectorAll('a[href^="http"], a[href^="www"]'); 534 | links.forEach(link => { 535 | // Rerun to avoid large spaces. 536 | // Break after a colon or a double slash (//) 537 | // or before a single slash (/), a tilde (~), a period, a comma, a hyphen, 538 | // an underline (_), a question mark, a number sign, or a percent symbol. 539 | const content = link.textContent; 540 | if (!(link.childElementCount === 0 && content.match(/^http|^www/))) return; 541 | let printableUrl = content.replace(/\/\//g, "//\u003Cwbr\u003E"); 542 | printableUrl = printableUrl.replace(/\,/g, ",\u003Cwbr\u003E"); 543 | // put wbr around everything. 544 | printableUrl = printableUrl.replace( 545 | /(\/|\~|\-|\.|\,|\_|\?|\#|\%)/g, 546 | "\u003Cwbr\u003E$1" 547 | ); 548 | // turn hyphen in non breaking hyphen 549 | printableUrl = printableUrl.replace(/\-/g, "\u003Cwbr\u003E‑"); 550 | link.setAttribute("data-print-url", printableUrl); 551 | link.innerHTML = printableUrl; 552 | }); 553 | } 554 | }); 555 | 556 | // Repeat table headers on multiple pages 557 | // Authors: Julien Taquet, Lucas Maciuga and Tafael Caixeta, see https://gitlab.coko.foundation/pagedjs/pagedjs/-/issues/84 558 | // TODO: remove this hook when Paged.js integrates this feature 559 | Paged.registerHandlers(class RepeatingTableHeadersHandler extends Paged.Handler { 560 | 561 | constructor(chunker, polisher, caller) { 562 | super(chunker, polisher, caller); 563 | this.splitTablesRefs = []; 564 | } 565 | 566 | afterPageLayout(pageElement, page, breakToken, chunker) { 567 | this.chunker = chunker; 568 | this.splitTablesRefs = []; 569 | 570 | if (breakToken) { 571 | const node = breakToken.node; 572 | const tables = this.findAllAncestors(node, "table"); 573 | if (node.tagName === "TABLE") { 574 | tables.push(node); 575 | } 576 | 577 | if (tables.length > 0) { 578 | this.splitTablesRefs = tables.map(t => t.dataset.ref); 579 | 580 | //checks if split inside thead and if so, set breakToken to next sibling element 581 | let thead = node.tagName === "THEAD" ? node : this.findFirstAncestor(node, "thead"); 582 | if (thead) { 583 | let lastTheadNode = thead.hasChildNodes() ? thead.lastChild : thead; 584 | breakToken.node = this.nodeAfter(lastTheadNode, chunker.source); 585 | } 586 | 587 | this.hideEmptyTables(pageElement, node); 588 | } 589 | } 590 | } 591 | 592 | hideEmptyTables(pageElement, breakTokenNode) { 593 | this.splitTablesRefs.forEach(ref => { 594 | let table = pageElement.querySelector("[data-ref='" + ref + "']"); 595 | if (table) { 596 | let sourceBody = table.querySelector("tbody > tr"); 597 | if (!sourceBody || this.refEquals(sourceBody.firstElementChild, breakTokenNode)) { 598 | table.style.visibility = "hidden"; 599 | table.style.position = "absolute"; 600 | let lineSpacer = table.nextSibling; 601 | if (lineSpacer) { 602 | lineSpacer.style.visibility = "hidden"; 603 | lineSpacer.style.position = "absolute"; 604 | } 605 | } 606 | } 607 | }); 608 | } 609 | 610 | refEquals(a, b) { 611 | return a && a.dataset && b && b.dataset && a.dataset.ref === b.dataset.ref; 612 | } 613 | 614 | findFirstAncestor(element, selector) { 615 | while (element.parentNode && element.parentNode.nodeType === 1) { 616 | if (element.parentNode.matches(selector)) { 617 | return element.parentNode; 618 | } 619 | element = element.parentNode; 620 | } 621 | return null; 622 | } 623 | 624 | findAllAncestors(element, selector) { 625 | const ancestors = []; 626 | while (element.parentNode && element.parentNode.nodeType === 1) { 627 | if (element.parentNode.matches(selector)) { 628 | ancestors.unshift(element.parentNode); 629 | } 630 | element = element.parentNode; 631 | } 632 | return ancestors; 633 | } 634 | 635 | // The addition of repeating Table Headers is done here because this hook is triggered before overflow handling 636 | layout(rendered, layout) { 637 | this.splitTablesRefs.forEach(ref => { 638 | const renderedTable = rendered.querySelector("[data-ref='" + ref + "']"); 639 | if (renderedTable && renderedTable.hasAttribute("data-split-from")) { 640 | // this event can be triggered multiple times 641 | // added a flag repeated-headers to control when table headers already repeated in current page. 642 | if (!renderedTable.getAttribute("repeated-headers")) { 643 | const sourceTable = this.chunker.source.querySelector("[data-ref='" + ref + "']"); 644 | this.repeatColgroup(sourceTable, renderedTable); 645 | this.repeatTHead(sourceTable, renderedTable); 646 | renderedTable.setAttribute("repeated-headers", true); 647 | } 648 | } 649 | }); 650 | } 651 | 652 | repeatColgroup(sourceTable, renderedTable) { 653 | let colgroup = sourceTable.querySelectorAll("colgroup"); 654 | let firstChild = renderedTable.firstChild; 655 | colgroup.forEach((colgroup) => { 656 | let clonedColgroup = colgroup.cloneNode(true); 657 | renderedTable.insertBefore(clonedColgroup, firstChild); 658 | }); 659 | } 660 | 661 | repeatTHead(sourceTable, renderedTable) { 662 | let thead = sourceTable.querySelector("thead"); 663 | if (thead) { 664 | let clonedThead = thead.cloneNode(true); 665 | renderedTable.insertBefore(clonedThead, renderedTable.firstChild); 666 | } 667 | } 668 | 669 | // the functions below are from pagedjs utils/dom.js 670 | nodeAfter(node, limiter) { 671 | if (limiter && node === limiter) { 672 | return; 673 | } 674 | let significantNode = this.nextSignificantNode(node); 675 | if (significantNode) { 676 | return significantNode; 677 | } 678 | if (node.parentNode) { 679 | while ((node = node.parentNode)) { 680 | if (limiter && node === limiter) { 681 | return; 682 | } 683 | significantNode = this.nextSignificantNode(node); 684 | if (significantNode) { 685 | return significantNode; 686 | } 687 | } 688 | } 689 | } 690 | 691 | nextSignificantNode(sib) { 692 | while ((sib = sib.nextSibling)) { 693 | if (!this.isIgnorable(sib)) return sib; 694 | } 695 | return null; 696 | } 697 | 698 | isIgnorable(node) { 699 | return (node.nodeType === 8) || // A comment node 700 | ((node.nodeType === 3) && this.isAllWhitespace(node)); // a text node, all whitespace 701 | } 702 | 703 | isAllWhitespace(node) { 704 | return !(/[^\t\n\r ]/.test(node.textContent)); 705 | } 706 | }); 707 | 708 | } 709 | -------------------------------------------------------------------------------- /vignettes/figures/app_screenshot1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/RConsortium/submissions-pilot2/c90937d8527ac9a36a46bad76f056f3880a4249f/vignettes/figures/app_screenshot1.png -------------------------------------------------------------------------------- /vignettes/figures/app_screenshot2.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/RConsortium/submissions-pilot2/c90937d8527ac9a36a46bad76f056f3880a4249f/vignettes/figures/app_screenshot2.png -------------------------------------------------------------------------------- /vignettes/figures/app_screenshot3.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/RConsortium/submissions-pilot2/c90937d8527ac9a36a46bad76f056f3880a4249f/vignettes/figures/app_screenshot3.png -------------------------------------------------------------------------------- /vignettes/figures/app_screenshot4.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/RConsortium/submissions-pilot2/c90937d8527ac9a36a46bad76f056f3880a4249f/vignettes/figures/app_screenshot4.png -------------------------------------------------------------------------------- /vignettes/figures/data_dependencies.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/RConsortium/submissions-pilot2/c90937d8527ac9a36a46bad76f056f3880a4249f/vignettes/figures/data_dependencies.png -------------------------------------------------------------------------------- /vignettes/figures/study_design.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/RConsortium/submissions-pilot2/c90937d8527ac9a36a46bad76f056f3880a4249f/vignettes/figures/study_design.png -------------------------------------------------------------------------------- /vignettes/letter_custom.css: -------------------------------------------------------------------------------- 1 | body { 2 | font-family: Palatino, "Palatino Linotype", "Palatino LT STD", Georgia, 'Source Han Serif', 'Songti SC', serif; 3 | line-height: 1.5em; 4 | } 5 | 6 | .title-page { 7 | display: none; 8 | } 9 | 10 | .from, .date { 11 | text-align: right; 12 | } 13 | .from p { 14 | text-align: left; 15 | display: inline-block; 16 | } 17 | 18 | .logo { 19 | position: running(header-logo); 20 | height: 1cm; 21 | } 22 | 23 | .date { 24 | margin-top: 4em; 25 | } 26 | 27 | @page { 28 | size: letter; 29 | margin: 4cm 3cm; 30 | 31 | @top-left { 32 | content: element(header-logo); 33 | } 34 | @bottom-right { 35 | content: counter(page); 36 | } 37 | } 38 | 39 | @media screen and (min-width: 12.32in) { 40 | .pagedjs_page, .pagedjs_first_page { 41 | margin: auto auto 5mm auto; 42 | } 43 | } 44 | -------------------------------------------------------------------------------- /vignettes/rconsortium.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/RConsortium/submissions-pilot2/c90937d8527ac9a36a46bad76f056f3880a4249f/vignettes/rconsortium.png --------------------------------------------------------------------------------