diff --git a/.Rbuildignore b/.Rbuildignore index 6a2ceaa..601ce96 100644 --- a/.Rbuildignore +++ b/.Rbuildignore @@ -5,3 +5,7 @@ ^CODE_OF_CONDUCT\.md$ ^README\.Rmd$ ^app\.R$ +^R/surv_utils\.R$ +^R/km_plot\.R$ +^LICENSE\.md$ +^.github$ diff --git a/DESCRIPTION b/DESCRIPTION index 18c6406..a3d17dd 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -23,7 +23,6 @@ Imports: flextable (>= 0.9.2), forcats (>= 0.5.1), ggplot2 (>= 3.4.3), - ggsurvfit, glue, golem (>= 0.4.1), htmltools (>= 0.5.6), @@ -35,7 +34,6 @@ Imports: shinyjs (>= 2.1.0), shinyWidgets (>= 0.7.6), stringr (>= 1.5.0), - survival, tibble (>= 3.2.1), tidyr (>= 1.3.1) Suggests: @@ -44,6 +42,7 @@ Suggests: config, cowplot, epitools, + ggsurvfit, ftExtra, ggstance, haven, diff --git a/LICENSE b/LICENSE deleted file mode 100644 index 261eeb9..0000000 --- a/LICENSE +++ /dev/null @@ -1,201 +0,0 @@ - Apache License - Version 2.0, January 2004 - http://www.apache.org/licenses/ - - TERMS AND CONDITIONS FOR USE, REPRODUCTION, AND DISTRIBUTION - - 1. Definitions. - - "License" shall mean the terms and conditions for use, reproduction, - and distribution as defined by Sections 1 through 9 of this document. - - "Licensor" shall mean the copyright owner or entity authorized by - the copyright owner that is granting the License. - - "Legal Entity" shall mean the union of the acting entity and all - other entities that control, are controlled by, or are under common - control with that entity. For the purposes of this definition, - "control" means (i) the power, direct or indirect, to cause the - direction or management of such entity, whether by contract or - otherwise, or (ii) ownership of fifty percent (50%) or more of the - outstanding shares, or (iii) beneficial ownership of such entity. - - "You" (or "Your") shall mean an individual or Legal Entity - exercising permissions granted by this License. - - "Source" form shall mean the preferred form for making modifications, - including but not limited to software source code, documentation - source, and configuration files. - - "Object" form shall mean any form resulting from mechanical - transformation or translation of a Source form, including but - not limited to compiled object code, generated documentation, - and conversions to other media types. - - "Work" shall mean the work of authorship, whether in Source or - Object form, made available under the License, as indicated by a - copyright notice that is included in or attached to the work - (an example is provided in the Appendix below). - - "Derivative Works" shall mean any work, whether in Source or Object - form, that is based on (or derived from) the Work and for which the - editorial revisions, annotations, elaborations, or other modifications - represent, as a whole, an original work of authorship. For the purposes - of this License, Derivative Works shall not include works that remain - separable from, or merely link (or bind by name) to the interfaces of, - the Work and Derivative Works thereof. - - "Contribution" shall mean any work of authorship, including - the original version of the Work and any modifications or additions - to that Work or Derivative Works thereof, that is intentionally - submitted to Licensor for inclusion in the Work by the copyright owner - or by an individual or Legal Entity authorized to submit on behalf of - the copyright owner. For the purposes of this definition, "submitted" - means any form of electronic, verbal, or written communication sent - to the Licensor or its representatives, including but not limited to - communication on electronic mailing lists, source code control systems, - and issue tracking systems that are managed by, or on behalf of, the - Licensor for the purpose of discussing and improving the Work, but - excluding communication that is conspicuously marked or otherwise - designated in writing by the copyright owner as "Not a Contribution." - - "Contributor" shall mean Licensor and any individual or Legal Entity - on behalf of whom a Contribution has been received by Licensor and - subsequently incorporated within the Work. - - 2. Grant of Copyright License. Subject to the terms and conditions of - this License, each Contributor hereby grants to You a perpetual, - worldwide, non-exclusive, no-charge, royalty-free, irrevocable - copyright license to reproduce, prepare Derivative Works of, - publicly display, publicly perform, sublicense, and distribute the - Work and such Derivative Works in Source or Object form. - - 3. Grant of Patent License. Subject to the terms and conditions of - this License, each Contributor hereby grants to You a perpetual, - worldwide, non-exclusive, no-charge, royalty-free, irrevocable - (except as stated in this section) patent license to make, have made, - use, offer to sell, sell, import, and otherwise transfer the Work, - where such license applies only to those patent claims licensable - by such Contributor that are necessarily infringed by their - Contribution(s) alone or by combination of their Contribution(s) - with the Work to which such Contribution(s) was submitted. If You - institute patent litigation against any entity (including a - cross-claim or counterclaim in a lawsuit) alleging that the Work - or a Contribution incorporated within the Work constitutes direct - or contributory patent infringement, then any patent licenses - granted to You under this License for that Work shall terminate - as of the date such litigation is filed. - - 4. Redistribution. You may reproduce and distribute copies of the - Work or Derivative Works thereof in any medium, with or without - modifications, and in Source or Object form, provided that You - meet the following conditions: - - (a) You must give any other recipients of the Work or - Derivative Works a copy of this License; and - - (b) You must cause any modified files to carry prominent notices - stating that You changed the files; and - - (c) You must retain, in the Source form of any Derivative Works - that You distribute, all copyright, patent, trademark, and - attribution notices from the Source form of the Work, - excluding those notices that do not pertain to any part of - the Derivative Works; and - - (d) If the Work includes a "NOTICE" text file as part of its - distribution, then any Derivative Works that You distribute must - include a readable copy of the attribution notices contained - within such NOTICE file, excluding those notices that do not - pertain to any part of the Derivative Works, in at least one - of the following places: within a NOTICE text file distributed - as part of the Derivative Works; within the Source form or - documentation, if provided along with the Derivative Works; or, - within a display generated by the Derivative Works, if and - wherever such third-party notices normally appear. The contents - of the NOTICE file are for informational purposes only and - do not modify the License. You may add Your own attribution - notices within Derivative Works that You distribute, alongside - or as an addendum to the NOTICE text from the Work, provided - that such additional attribution notices cannot be construed - as modifying the License. - - You may add Your own copyright statement to Your modifications and - may provide additional or different license terms and conditions - for use, reproduction, or distribution of Your modifications, or - for any such Derivative Works as a whole, provided Your use, - reproduction, and distribution of the Work otherwise complies with - the conditions stated in this License. - - 5. Submission of Contributions. Unless You explicitly state otherwise, - any Contribution intentionally submitted for inclusion in the Work - by You to the Licensor shall be under the terms and conditions of - this License, without any additional terms or conditions. - Notwithstanding the above, nothing herein shall supersede or modify - the terms of any separate license agreement you may have executed - with Licensor regarding such Contributions. - - 6. Trademarks. This License does not grant permission to use the trade - names, trademarks, service marks, or product names of the Licensor, - except as required for reasonable and customary use in describing the - origin of the Work and reproducing the content of the NOTICE file. - - 7. Disclaimer of Warranty. Unless required by applicable law or - agreed to in writing, Licensor provides the Work (and each - Contributor provides its Contributions) on an "AS IS" BASIS, - WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or - implied, including, without limitation, any warranties or conditions - of TITLE, NON-INFRINGEMENT, MERCHANTABILITY, or FITNESS FOR A - PARTICULAR PURPOSE. You are solely responsible for determining the - appropriateness of using or redistributing the Work and assume any - risks associated with Your exercise of permissions under this License. - - 8. Limitation of Liability. In no event and under no legal theory, - whether in tort (including negligence), contract, or otherwise, - unless required by applicable law (such as deliberate and grossly - negligent acts) or agreed to in writing, shall any Contributor be - liable to You for damages, including any direct, indirect, special, - incidental, or consequential damages of any character arising as a - result of this License or out of the use or inability to use the - Work (including but not limited to damages for loss of goodwill, - work stoppage, computer failure or malfunction, or any and all - other commercial damages or losses), even if such Contributor - has been advised of the possibility of such damages. - - 9. Accepting Warranty or Additional Liability. While redistributing - the Work or Derivative Works thereof, You may choose to offer, - and charge a fee for, acceptance of support, warranty, indemnity, - or other liability obligations and/or rights consistent with this - License. However, in accepting such obligations, You may act only - on Your own behalf and on Your sole responsibility, not on behalf - of any other Contributor, and only if You agree to indemnify, - defend, and hold each Contributor harmless for any liability - incurred by, or claims asserted against, such Contributor by reason - of your accepting any such warranty or additional liability. - - END OF TERMS AND CONDITIONS - - APPENDIX: How to apply the Apache License to your work. - - To apply the Apache License to your work, attach the following - boilerplate notice, with the fields enclosed by brackets "[]" - replaced with your own identifying information. (Don't include - the brackets!) The text should be enclosed in the appropriate - comment syntax for the file format. We also recommend that a - file or class name and description of purpose be included on the - same "printed page" as the copyright notice for easier - identification within third-party archives. - - Copyright [yyyy] [name of copyright owner] - - Licensed under the Apache License, Version 2.0 (the "License"); - you may not use this file except in compliance with the License. - You may obtain a copy of the License at - - http://www.apache.org/licenses/LICENSE-2.0 - - Unless required by applicable law or agreed to in writing, software - distributed under the License is distributed on an "AS IS" BASIS, - WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. - See the License for the specific language governing permissions and - limitations under the License. diff --git a/LICENSE.md b/LICENSE.md new file mode 100644 index 0000000..b62a9b5 --- /dev/null +++ b/LICENSE.md @@ -0,0 +1,194 @@ +Apache License +============== + +_Version 2.0, January 2004_ +_<>_ + +### Terms and Conditions for use, reproduction, and distribution + +#### 1. Definitions + +“License” shall mean the terms and conditions for use, reproduction, and +distribution as defined by Sections 1 through 9 of this document. + +“Licensor” shall mean the copyright owner or entity authorized by the copyright +owner that is granting the License. + +“Legal Entity” shall mean the union of the acting entity and all other entities +that control, are controlled by, or are under common control with that entity. +For the purposes of this definition, “control” means **(i)** the power, direct or +indirect, to cause the direction or management of such entity, whether by +contract or otherwise, or **(ii)** ownership of fifty percent (50%) or more of the +outstanding shares, or **(iii)** beneficial ownership of such entity. + +“You” (or “Your”) shall mean an individual or Legal Entity exercising +permissions granted by this License. + +“Source” form shall mean the preferred form for making modifications, including +but not limited to software source code, documentation source, and configuration +files. + +“Object” form shall mean any form resulting from mechanical transformation or +translation of a Source form, including but not limited to compiled object code, +generated documentation, and conversions to other media types. + +“Work” shall mean the work of authorship, whether in Source or Object form, made +available under the License, as indicated by a copyright notice that is included +in or attached to the work (an example is provided in the Appendix below). + +“Derivative Works” shall mean any work, whether in Source or Object form, that +is based on (or derived from) the Work and for which the editorial revisions, +annotations, elaborations, or other modifications represent, as a whole, an +original work of authorship. For the purposes of this License, Derivative Works +shall not include works that remain separable from, or merely link (or bind by +name) to the interfaces of, the Work and Derivative Works thereof. + +“Contribution” shall mean any work of authorship, including the original version +of the Work and any modifications or additions to that Work or Derivative Works +thereof, that is intentionally submitted to Licensor for inclusion in the Work +by the copyright owner or by an individual or Legal Entity authorized to submit +on behalf of the copyright owner. For the purposes of this definition, +“submitted” means any form of electronic, verbal, or written communication sent +to the Licensor or its representatives, including but not limited to +communication on electronic mailing lists, source code control systems, and +issue tracking systems that are managed by, or on behalf of, the Licensor for +the purpose of discussing and improving the Work, but excluding communication +that is conspicuously marked or otherwise designated in writing by the copyright +owner as “Not a Contribution.” + +“Contributor” shall mean Licensor and any individual or Legal Entity on behalf +of whom a Contribution has been received by Licensor and subsequently +incorporated within the Work. + +#### 2. Grant of Copyright License + +Subject to the terms and conditions of this License, each Contributor hereby +grants to You a perpetual, worldwide, non-exclusive, no-charge, royalty-free, +irrevocable copyright license to reproduce, prepare Derivative Works of, +publicly display, publicly perform, sublicense, and distribute the Work and such +Derivative Works in Source or Object form. + +#### 3. Grant of Patent License + +Subject to the terms and conditions of this License, each Contributor hereby +grants to You a perpetual, worldwide, non-exclusive, no-charge, royalty-free, +irrevocable (except as stated in this section) patent license to make, have +made, use, offer to sell, sell, import, and otherwise transfer the Work, where +such license applies only to those patent claims licensable by such Contributor +that are necessarily infringed by their Contribution(s) alone or by combination +of their Contribution(s) with the Work to which such Contribution(s) was +submitted. If You institute patent litigation against any entity (including a +cross-claim or counterclaim in a lawsuit) alleging that the Work or a +Contribution incorporated within the Work constitutes direct or contributory +patent infringement, then any patent licenses granted to You under this License +for that Work shall terminate as of the date such litigation is filed. + +#### 4. Redistribution + +You may reproduce and distribute copies of the Work or Derivative Works thereof +in any medium, with or without modifications, and in Source or Object form, +provided that You meet the following conditions: + +* **(a)** You must give any other recipients of the Work or Derivative Works a copy of +this License; and +* **(b)** You must cause any modified files to carry prominent notices stating that You +changed the files; and +* **(c)** You must retain, in the Source form of any Derivative Works that You distribute, +all copyright, patent, trademark, and attribution notices from the Source form +of the Work, excluding those notices that do not pertain to any part of the +Derivative Works; and +* **(d)** If the Work includes a “NOTICE” text file as part of its distribution, then any +Derivative Works that You distribute must include a readable copy of the +attribution notices contained within such NOTICE file, excluding those notices +that do not pertain to any part of the Derivative Works, in at least one of the +following places: within a NOTICE text file distributed as part of the +Derivative Works; within the Source form or documentation, if provided along +with the Derivative Works; or, within a display generated by the Derivative +Works, if and wherever such third-party notices normally appear. The contents of +the NOTICE file are for informational purposes only and do not modify the +License. You may add Your own attribution notices within Derivative Works that +You distribute, alongside or as an addendum to the NOTICE text from the Work, +provided that such additional attribution notices cannot be construed as +modifying the License. + +You may add Your own copyright statement to Your modifications and may provide +additional or different license terms and conditions for use, reproduction, or +distribution of Your modifications, or for any such Derivative Works as a whole, +provided Your use, reproduction, and distribution of the Work otherwise complies +with the conditions stated in this License. + +#### 5. Submission of Contributions + +Unless You explicitly state otherwise, any Contribution intentionally submitted +for inclusion in the Work by You to the Licensor shall be under the terms and +conditions of this License, without any additional terms or conditions. +Notwithstanding the above, nothing herein shall supersede or modify the terms of +any separate license agreement you may have executed with Licensor regarding +such Contributions. + +#### 6. Trademarks + +This License does not grant permission to use the trade names, trademarks, +service marks, or product names of the Licensor, except as required for +reasonable and customary use in describing the origin of the Work and +reproducing the content of the NOTICE file. + +#### 7. Disclaimer of Warranty + +Unless required by applicable law or agreed to in writing, Licensor provides the +Work (and each Contributor provides its Contributions) on an “AS IS” BASIS, +WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied, +including, without limitation, any warranties or conditions of TITLE, +NON-INFRINGEMENT, MERCHANTABILITY, or FITNESS FOR A PARTICULAR PURPOSE. You are +solely responsible for determining the appropriateness of using or +redistributing the Work and assume any risks associated with Your exercise of +permissions under this License. + +#### 8. Limitation of Liability + +In no event and under no legal theory, whether in tort (including negligence), +contract, or otherwise, unless required by applicable law (such as deliberate +and grossly negligent acts) or agreed to in writing, shall any Contributor be +liable to You for damages, including any direct, indirect, special, incidental, +or consequential damages of any character arising as a result of this License or +out of the use or inability to use the Work (including but not limited to +damages for loss of goodwill, work stoppage, computer failure or malfunction, or +any and all other commercial damages or losses), even if such Contributor has +been advised of the possibility of such damages. + +#### 9. Accepting Warranty or Additional Liability + +While redistributing the Work or Derivative Works thereof, You may choose to +offer, and charge a fee for, acceptance of support, warranty, indemnity, or +other liability obligations and/or rights consistent with this License. However, +in accepting such obligations, You may act only on Your own behalf and on Your +sole responsibility, not on behalf of any other Contributor, and only if You +agree to indemnify, defend, and hold each Contributor harmless for any liability +incurred by, or claims asserted against, such Contributor by reason of your +accepting any such warranty or additional liability. + +_END OF TERMS AND CONDITIONS_ + +### APPENDIX: How to apply the Apache License to your work + +To apply the Apache License to your work, attach the following boilerplate +notice, with the fields enclosed by brackets `[]` replaced with your own +identifying information. (Don't include the brackets!) The text should be +enclosed in the appropriate comment syntax for the file format. We also +recommend that a file or class name and description of purpose be included on +the same “printed page” as the copyright notice for easier identification within +third-party archives. + + Copyright [yyyy] [name of copyright owner] + + Licensed under the Apache License, Version 2.0 (the "License"); + you may not use this file except in compliance with the License. + You may obtain a copy of the License at + + http://www.apache.org/licenses/LICENSE-2.0 + + Unless required by applicable law or agreed to in writing, software + distributed under the License is distributed on an "AS IS" BASIS, + WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. + See the License for the specific language governing permissions and + limitations under the License. diff --git a/NAMESPACE b/NAMESPACE index c34ee1b..c5e1d31 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -1,5 +1,6 @@ # Generated by roxygen2: do not edit by hand +export(adae_risk_summary) export(adsl_merge) export(adsl_summary) export(ae_forest_plot) @@ -15,6 +16,7 @@ export(dataset_vignette) export(display_bign_head) export(edish_plot) export(empty_plot) +export(empty_tbl) export(event_analysis_plot) export(forest_display) export(forest_plot_base) @@ -22,7 +24,6 @@ export(forest_plot_scatter) export(g_seriescol) export(g_seriessym) export(interval_plot) -export(km_plot) export(lab_abnormality_summary) export(line_plot) export(mcatstat) @@ -37,9 +38,6 @@ export(plotly_legend) export(process_edish_data) export(process_event_analysis) export(process_tornado_data) -export(process_vx_bar_plot) -export(process_vx_box_data) -export(process_vx_scatter_data) export(reverselog_trans) export(risk_stat) export(riskdiff_wald) @@ -52,23 +50,23 @@ export(split_data_by_var) export(split_section_headers) export(str_to_vec) export(summary_functions) -export(surv_pre_processor) +export(summary_row_cat) export(tbl_display) export(tbl_processor) +export(tbl_risk_labels) export(tbl_to_plot) export(theme_cleany) export(theme_std) export(tornado_plot) export(var_start) -export(vx_box_plot) import(dplyr) import(flextable) import(ggplot2) -import(ggsurvfit) import(htmltools) import(scales) import(shiny) import(shinyWidgets) +import(stringr) import(tools) importFrom(DT,addRow) importFrom(DT,colReorder) @@ -123,7 +121,6 @@ importFrom(plotly,ggplotly) importFrom(plotly,layout) importFrom(plotly,subplot) importFrom(purrr,compact) -importFrom(purrr,discard) importFrom(purrr,every) importFrom(purrr,flatten) importFrom(purrr,keep) @@ -198,30 +195,6 @@ importFrom(stats,quantile) importFrom(stats,reorder) importFrom(stats,sd) importFrom(stats,setNames) -importFrom(stringr,str_c) -importFrom(stringr,str_detect) -importFrom(stringr,str_extract) -importFrom(stringr,str_glue) -importFrom(stringr,str_length) -importFrom(stringr,str_locate) -importFrom(stringr,str_match) -importFrom(stringr,str_remove) -importFrom(stringr,str_remove_all) -importFrom(stringr,str_replace) -importFrom(stringr,str_replace_all) -importFrom(stringr,str_split) -importFrom(stringr,str_squish) -importFrom(stringr,str_sub) -importFrom(stringr,str_subset) -importFrom(stringr,str_to_lower) -importFrom(stringr,str_to_title) -importFrom(stringr,str_to_upper) -importFrom(stringr,str_trim) -importFrom(stringr,str_wrap) -importFrom(survival,Surv) -importFrom(survival,cox.zph) -importFrom(survival,coxph) -importFrom(survival,survfit) importFrom(tidyr,drop_na) importFrom(tidyr,pivot_longer) importFrom(tidyr,pivot_wider) diff --git a/R/adae_risk_summary.R b/R/adae_risk_summary.R index 81ccf62..4a2f085 100644 --- a/R/adae_risk_summary.R +++ b/R/adae_risk_summary.R @@ -11,13 +11,19 @@ # WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. # See the License for the specific language governing permissions and # limitations under the License. +# #' ADAE Summary with Risk Statistics #' #' @inheritParams risk_stat #' @param hterm High Level Adverse Event term variable, used for analysis #' @param lterm Low Level Adverse Event term variable, used for analysis +#' @param risklabels List containing labels for table with elements: risk, riskci, p, low, up, lowup +#' @param sum_row To show summary/any term row or not. 'Y'/'N' +#' @param sum_row_label Label for Summary Row to be displayed, if Y. +#' @param sigdec_cat Number of decimal places for % displayed in output #' -#' @return List of summarized data frames for Adverse Events based on high and lower term. +#' @return Data frame to be displayed with risk/counts of higher and lower AE terms +#' @export #' #' @examples #' data(adae) @@ -50,7 +56,7 @@ #' trtgrp = "Xanomeline Low Dose", #' statistics = "Risk Ratio", #' alpha = 0.05, -#' cutoff = 5, +#' cutoff_where = "PCT > 5", #' sort_opt = "Ascending", #' sort_var = "Count" #' ) @@ -67,11 +73,19 @@ adae_risk_summary <- function(datain, ctrlgrp, trtgrp, statistics = "Risk Ratio", + riskdiff_pct = "N", alpha = 0.05, - cutoff = 5, + cutoff_where = NA, sort_opt = "Ascending", - sort_var = "Count") { - stopifnot("Input data is empty" = nrow(datain) > 0) + sort_var = "Count", + sum_row = "N", + sum_row_label = "Participants with Any AE", + risklabels = tbl_risk_labels(statistics), + sigdec_cat = 1, + pctsyn = "Y") { + if (nrow(datain) < 1) { + return(datain) + } stopifnot(length(ctrlgrp) == 1) stopifnot("Invalid Control Group" = ctrlgrp %in% unique(datain[["TRTVAR"]])) stopifnot( @@ -80,18 +94,56 @@ adae_risk_summary <- function(datain, ) stopifnot( "Invalid Risk Statistics; specify any one of `Risk Ratio` or `Risk Difference`" = - statistics %in% c("Risk Ratio", "Risk Difference") + tolower(statistics) %in% c("risk ratio", "risk difference") ) stopifnot( "`byvar` in `mentry()` cannot be `NA` or ''" = - identical(var_start(datain, "BYVAR"), "BYVAR1") + "BYVAR1" %in% var_start(datain, "BYVAR") ) - stopifnot( - "`byvar` in `mentry()` should be identical to `hterm` in `adae_summary()" = - identical(unique(datain[["BYVAR1"]]), unique(datain[[hterm]])) + # Get low term and apply cutoff + ae_lsumm <- risk_stat( + datain = datain, + a_subset = a_subset, + summary_by = summary_by, + eventvar = lterm, + ctrlgrp = ctrlgrp, + trtgrp = trtgrp, + statistics = statistics, + alpha = alpha, + cutoff_where = cutoff_where, + sort_opt = sort_opt, + sort_var = sort_var, + riskdiff_pct = riskdiff_pct, + hoveryn = "N", + sigdec = sigdec_cat, + pctsyn = pctsyn ) - - ae_summ <- map(c(hterm, lterm), \(term) { + if (nrow(ae_lsumm) == 0 || ncol(ae_lsumm) == 1) { + return(ae_lsumm) + } else { + ae_lsumm <- ae_lsumm |> + mutate(DPTVAR = lterm, CN = "C") + } + # Apply if CUTOFF exists + if (!is.na(cutoff_where) && str_detect(cutoff_where, "PCT|FREQ")) { + datain <- datain |> + left_join(select(ae_lsumm, all_of(c("BYVAR1", "CUTFL")), {{ lterm }} := "DPTVAL"), + by = c("BYVAR1", lterm) + ) + a_subset <- paste(na.omit(c(a_subset, "CUTFL == 'Y'")), collapse = "&") + } + # If ANy AE row: + if (sum_row == "Y") { + h_terms <- c(hterm, "TIER") + } else { + h_terms <- hterm + } + ae_hsumm <- map(h_terms, \(term) { + if (term == "TIER") { + datain <- datain |> + select(-starts_with("BYVAR")) |> + mutate(TIER = sum_row_label) + } risk_stat( datain = datain, a_subset = a_subset, @@ -101,23 +153,43 @@ adae_risk_summary <- function(datain, trtgrp = trtgrp, statistics = statistics, alpha = alpha, - cutoff = cutoff, sort_opt = sort_opt, - sort_var = sort_var + sort_var = sort_var, + riskdiff_pct = riskdiff_pct, + hoveryn = "N", + sigdec = sigdec_cat, + pctsyn = pctsyn ) |> mutate(DPTVAR = term, CN = "C") }) |> - set_names(c("hterm_summ", "lterm_summ")) + set_names(h_terms) ## retrun empty flextable - if (nrow(ae_summ[["hterm_summ"]]) < 1) { - return(data.frame("Note" = "No data available under these conditions")) + if (nrow(ae_hsumm[[1]]) < 1) { + return(data.frame()) } - - ae_summ |> + list(ae_hsumm[[1]], ae_lsumm) |> post_occ_tier( riskyn = "Y", ctrlgrp = ctrlgrp, - statistics = statistics - ) + risklabels = risklabels, + sum_row = ae_hsumm[["TIER"]] + ) |> + mutate(DPTVAR = "TIER") +} + +#' Labels for AE risk table +#' +#' @param statistic Required Statistic: Risk Ratio or Risk Difference +#' @return list of labels +#' @export +tbl_risk_labels <- function(statistic) { + list( + riskci = paste(statistic, "(CI)"), + p = "P-value", + risk = statistic, + low = "Lower Limit", + up = "Upper Limit", + lowup = "(Lower-Upper)" + ) } diff --git a/R/adsl_r001.R b/R/adsl_summary.R similarity index 73% rename from R/adsl_r001.R rename to R/adsl_summary.R index a4de465..3b8dacc 100644 --- a/R/adsl_r001.R +++ b/R/adsl_summary.R @@ -18,16 +18,13 @@ #' @param vars Names of `adsl` variables to display (Add `"-S"` to numeric variables), #' tilde-separated #' @param stat_vars Statistics to display in table for numeric vars, tilde-separated. -#' @param pctdisp Denominator to calculate percentages by. -#' Values: `"TRT", "VAR", "COL", "SUBGRP", "SGRPN", "CAT", "NONE", "NO", "DPTVAR"`. -#' @param total_catyn To return a 'Total' row for categorical analysis in `vars`. Values: `"Y"/"N"` -#' @param total_catlabel Label for total category row. eg- "All"/"Total" -#' @param miss_catyn To include empty/blank values as `miss_catlabel` in categories of -#' `dptvar` variable or not. Values: `"Y"/"N"` -#' @param miss_catlabel Label for missing values #' @param a_subset Analysis Subset condition; tilde-separated for each variable in `vars`. #' @param denom_subset Subset condition to be applied to dataset for calculating denominator, #' tilde-separated for categorical variables within `vars`. +#' @param sigdec_stat Number of base decimal places to retain in output of summary statistic. +#' Applies to mean, min, max, sd etc +#' @param sigdec_cat Number of decimal places for % displayed in output +#' @inheritParams mcatstat #' #' @details #' \itemize{ @@ -36,7 +33,7 @@ #' eg. for `"AGEGR1/AGEGR1N~AGE-S~SEX/SEXN~BMIBL-S"`, `AGEGR1` and `SEX` will be analysed by #' category and `AGE` and `BMIBL` as summary statistics. #' \item Argument `stat_vars` should contain names of statistic to apply to all summary analysis -#' variables. +#' variables. `sigdec` applies only to statistical analysis of numeric variables (-S) #' \item Arguments `pctdisp`, `total_catyn`, `miss_catyn`, `miss_catlabel` apply to all variables #' under categorical analyses. #' \item `a_subset` should tilde-separated subset conditions, corresponding to each variable in @@ -76,8 +73,25 @@ #' adsl_sum |> #' display_bign_head(mentry_data = mentry_df) |> #' tbl_processor( +#' statlabel = "N~Range~Meansd~Median~Q1Q3", +#' dptlabel = "Age Group~_NONE_~Sex~Race", +#' addrowvar = "DPTVAR" +#' ) |> +#' tbl_display() |> +#' flextable::autofit() +#' +#' # Same variable with 2 unique subset conditions +#' adsl_sum <- mentry_df |> +#' adsl_summary( +#' vars = "AGEGR1~AGE-S~SEX~SEX~RACE", +#' a_subset = "AGE<65~AGE>80~SEX=='F'~SEX=='M'~NA" +#' ) +#' +#' adsl_sum |> +#' display_bign_head(mentry_data = mentry_df) |> +#' tbl_processor( #' statlabel = "N~Range~Meansd~Median~IQR", -#' dptlabel = "Age Group~NONE~Sex~Race", +#' dptlabel = "Age Group~_NONE_~Sex1~Sex2~Race", #' addrowvar = "DPTVAR" #' ) |> #' tbl_display() |> @@ -159,13 +173,13 @@ #' adsl_vs |> #' adsl_summary( #' vars = "SEX~AGE-S~AGEGR1~RACE~ETHNIC~HEIGHT-S~WEIGHT-S~BMI-S", -#' stat_vars = "medianrange~meansd" +#' stat_vars = "median(minmax)~mean(sd)" #' ) |> #' display_bign_head(adsl_vs) |> #' tbl_processor( #' dptlabel = "Sex, n(%)~Age (Years)~Age Category (Years), n(%)~Race, n(%)~Ethnicity, #' n(%)~Height (cm)~Weight (kg)~BMI (kg/m2)", -#' statlabel = "Median (Range)~Mean (SD)", +#' statlabel = "Median (Min, Max)~Mean (SD)", #' addrowvars = "DPTVAR" #' ) |> #' tbl_display() |> @@ -174,63 +188,77 @@ #' adsl_summary <- function(datain, vars, - stat_vars = "N~Range~Meansd~Median~IQR", + stat_vars = "n~minmaxc~mean(sd)~median~q1q3", pctdisp = "TRT", total_catyn = "N", total_catlabel = "Total", miss_catyn = "N", miss_catlabel = "Missing", + pctsyn = "Y", + sigdec_stat = 2, + sigdec_cat = 2, a_subset = NA_character_, - denom_subset = NA_character_) { - stopifnot(nrow(datain) > 0) + denom_subset = NA_character_, + sparseyn = "N", + sparsebyvalyn = "N") { + if (nrow(datain) == 0) { + return(datain) + } vars <- split_var_types(toupper(str_to_vec(vars))) stat_vars <- str_to_vec(stat_vars) # mapping `a_subset` to all variables, `denom_subset` to only categorical variables map_df <- map_var_subsets( - list(vars[["all_vars"]], vars[["cat_vars"]]), + vars[["all_vars"]], list(a_subset, denom_subset) ) + cat_df <- map_df |> + filter(!.data$vars %in% .env$vars[["num_vars"]]) + num_df <- map_df |> + filter(.data$vars %in% .env$vars[["num_vars"]]) # analysis for categorical variables - datacat <- map(vars[["cat_vars"]], \(x) { - if (!str_to_vec(x, "/")[1] %in% names(datain)) { - cat_df <- data.frame() + datacat <- map(seq_along(cat_df$vars), \(x) { + if (!str_to_vec(cat_df$vars[x], "/")[1] %in% names(datain)) { + cat_sums <- data.frame() } else { - vars_df <- map_df |> - filter(.data$vars == x) - cat_df <- mcatstat( + cat_sums <- mcatstat( datain = datain, - a_subset = vars_df[["subset1"]], - denom_subset = vars_df[["subset2"]], - dptvar = x, + a_subset = cat_df[["subset1"]][x], + denom_subset = cat_df[["subset2"]][x], + dptvar = cat_df[["vars"]][x], uniqid = "USUBJID", pctdisp = pctdisp, total_catyn = total_catyn, miss_catyn = miss_catyn, miss_catlabel = miss_catlabel, - dptvarn = which(vars[["all_vars"]] == x) + dptvarn = cat_df[["ord"]][x], + sigdec = sigdec_cat, + pctsyn = pctsyn, + sparseyn = sparseyn, + sparsebyvalyn = sparsebyvalyn, + return_zero = "Y" ) } - cat_df + cat_sums }) |> bind_rows() |> - select(-any_of(c("XVAR", "FREQ", "PCT"))) + select(-any_of(c("XVAR", "FREQ", "PCT", "CPCT"))) # analysis for numeric variables if (length(vars[["num_vars"]]) > 0) { datasums <- map( - vars[["num_vars"]], + seq_along(num_df$vars), \(x) { - if (!x %in% names(datain)) { + if (!num_df[["vars"]][x] %in% names(datain)) { df <- data.frame() } else { - vars_df <- map_df |> - filter(.data$vars == x) df <- msumstat( datain = datain, - a_subset = vars_df[["subset1"]], - dptvar = x, + a_subset = num_df[["subset1"]][x], + dptvar = num_df[["vars"]][x], statvar = stat_vars, - dptvarn = which(vars[["all_vars"]] == x) + dptvarn = num_df[["ord"]][x], + sigdec = sigdec_stat, + sparsebyvalyn = sparsebyvalyn )[["tsum"]] } df @@ -255,7 +283,7 @@ split_var_types <- function(vars) { list( num_vars = str_replace_all(num_vars, "-S", ""), - cat_vars = setdiff(vars, num_vars), + cat_vars = vars[!vars %in% num_vars], all_vars = str_replace_all(vars, "-S", "") ) } @@ -269,10 +297,9 @@ split_var_types <- function(vars) { #' @noRd #' map_var_subsets <- function(varlist, subsetlist) { - map(seq_along(varlist), \(i) { - vars <- varlist[[i]] - var_len <- length(vars) - subset <- str_replace_all(str_to_vec(subsetlist[[i]]), "NA", NA_character_) + sub <- map(seq_along(subsetlist), \(i) { + var_len <- length(varlist) + subset <- dplyr::na_if(str_to_vec(subsetlist[[i]]), "NA") # repeat subset for all variables if only one subset is given if (length(subset) == 1) { subset <- rep(subset, var_len) @@ -281,7 +308,8 @@ map_var_subsets <- function(varlist, subsetlist) { "Number of subsets should be 1 or equal to number of corresponding variables" = var_len == length(subset) ) - bind_cols(vars = vars, !!paste0("subset", i) := subset) - }) |> - reduce(left_join, by = "vars") + bind_cols(!!paste0("subset", i) := subset) |> + mutate(ord = row_number()) + }) + bind_cols(vars = varlist, reduce(sub, left_join, by = "ord")) } diff --git a/R/ae_forestplot.R b/R/ae_forestplot.R index 4386792..8cf2c52 100644 --- a/R/ae_forestplot.R +++ b/R/ae_forestplot.R @@ -90,7 +90,7 @@ #' trtgrp = "Xanomeline High Dose", #' statistics = "Risk Ratio", #' alpha = 0.05, -#' cutoff = 5, +#' cutoff_where = "FREQ >5", #' sort_opt = "Ascending", #' sort_var = "Count" #' ) |> @@ -134,7 +134,10 @@ ae_forest_plot <- interactive = "N") { # Common processing for all plots: datain <- datain |> - filter(!is.nan(.data[["RISK"]]), !is.infinite(.data[["RISK"]])) + group_by(across(all_of(c("DPTVAL", "TRTPAIR")))) |> + filter(!any(.data[["FREQ"]] == 0)) |> + ungroup() |> + mutate(key = dplyr::row_number()) # Check risk data exists: stopifnot("Input ae_forest_plot data is empty" = nrow(datain) != 0) # If axis position not added, default it: diff --git a/R/ae_pre_processor.R b/R/ae_pre_processor.R index 6f69404..79858d6 100644 --- a/R/ae_pre_processor.R +++ b/R/ae_pre_processor.R @@ -21,9 +21,19 @@ #' Permissible Values: "ANY", "ANY EVENT", "TREATMENT EMERGENT", "SERIOUS", #' "DRUG-RELATED", "RELATED", "MILD", "MODERATE", "SEVERE", "RECOVERED/RESOLVED", #' "RECOVERING/RESOLVING", "NOT RECOVERING/NOT RESOLVING", "FATAL", "GRADE N" +#' @param subset Analysis subset condition to be applied to `ADAE` dataset prior to ADSL join; +#' will be appended to `ae_filter` #' @param obs_residual If not NA, use this argument to pass a period (numeric) to extend the #' observation period. If passed as NA, overall study duration is considered for analysis. #' eg. if 5, only events occurring upto 5 days past the TRTEDT are considered. +#' @param max_sevctc If needed to filter maximum severity/ctc grade rows. Values: NA/"SEV"/"CTC" +#' @param sev_ctcvar Variable to determine max severity. eg: ASEVN, ATOXGRN +#' @param hterm High Level Event Term (req for max Sev tables only) +#' @param lterm Low Level Event Term (req for max Sev tables only) +#' @param rpt_byvar Page/report by variable if any, to identify max sev/ctc +#' @param trtvar Treatment Variable +#' @param pt_total Required to calculate total of preferred terms? Y/N +#' #' @return : a list containing 2 objects #' \itemize{ #' \item data - Processed dataframe output for further utilities (pass to `mentry()`) @@ -49,8 +59,18 @@ ae_pre_processor <- function(datain, fmq_data = NULL, date_vars = c("ASTDT", "AENDT", "TRTSDT", "TRTEDT"), ae_filter = "Any Event", - obs_residual = NA_real_) { - stopifnot("Empty Data Frame passed" = nrow(datain) != 0) + subset = NA, + obs_residual = NA_real_, + max_sevctc = NA_character_, + sev_ctcvar = "ASEVN", + hterm = "AEBODSYS", + lterm = "AEDECOD", + rpt_byvar = character(0), + trtvar = "TRTA", + pt_total = "N") { + if (nrow(datain) == 0) { + return(list(data = datain, a_subset = NA_character_)) + } # Processing FMQ values if exists if (is.data.frame(fmq_data)) { fmq <- fmq_data |> @@ -86,7 +106,9 @@ ae_pre_processor <- function(datain, data_pro, ae_filter ) - + if (!is.na(subset)) { + filters <- paste(na.omit(c(filters, subset)), collapse = " & ") + } # filter for events occurring in given observation period obs_residual <- as.numeric(obs_residual) if (!is.na(obs_residual) && obs_residual >= 0) { @@ -94,12 +116,57 @@ ae_pre_processor <- function(datain, "Obs period cannot be used; dates unavailable" = all(c("ASTDT", "TRTSDT", "TRTEDT") %in% names(data_pro)) ) - filters <- c(filters, glue("(ASTDT > TRTSDT) & (ASTDT < (TRTEDT + {obs_residual}))")) |> - na.omit() |> - paste(collapse = " & ") + filters <- paste(na.omit( + c(filters, glue("(ASTDT > TRTSDT) & (ASTDT < (TRTEDT + {obs_residual}))")) + ), collapse = " & ") + } + + # Apply AE filters if exist: + if (!is.na(filters) && filters != "") { + data_pro <- data_pro |> + filter(!!!parse_exprs(filters)) + if (nrow(data_pro) < 1) { + return(list(data = data_pro, a_subset = filters)) + } + } + ################### Max SEV/CTC############## + # If maximum severity or CTC required: + # Filter analysis dataset and also flag max variable + # Any AE flag to be set + # Flag for high level term and max sevc/ctc + if (!is.na(max_sevctc) && toupper(max_sevctc) %in% c("SEV", "CTC")) { + data_pro <- data_pro |> + group_by(across( + any_of(c(rpt_byvar, trtvar, "USUBJID", hterm, lterm)) + )) |> + mutate( + MAX_SEVCTC = ifelse(.data[[sev_ctcvar]] == max(.data[[sev_ctcvar]], na.rm = TRUE), 1, 0) + ) |> + filter(.data[["MAX_SEVCTC"]] == 1) |> + group_by(across(any_of(c(rpt_byvar, trtvar, "USUBJID")))) |> + mutate( + ANY = ifelse(.data[[sev_ctcvar]] == max(.data[[sev_ctcvar]], na.rm = TRUE), 1, 0) + ) |> + group_by(across( + any_of(c(rpt_byvar, trtvar, "USUBJID", hterm)) + )) |> + mutate( + HT_FL = ifelse(.data[[sev_ctcvar]] == max(.data[[sev_ctcvar]], na.rm = TRUE), 1, 0) + ) + # For preferred term total count + if (toupper(max_sevctc) == "SEV" && pt_total == "Y") { + data_pro <- data_pro |> + group_by(across(any_of(c(rpt_byvar, trtvar, lterm, "USUBJID")))) |> + mutate( + PT_CNT = ifelse(.data[[sev_ctcvar]] == max(.data[[sev_ctcvar]], na.rm = TRUE), 1, 0) + ) + } + filters <- paste(na.omit(c(filters, "MAX_SEVCTC == 1")), collapse = " & ") } + ################### ENDax SEV/CTC############## + # Return processed dataframe and filter conditions - return(list(data = data_pro, a_subset = filters)) + return(list(data = ungroup(data_pro), a_subset = filters)) } #' Create filter condition for Adverse Events from keyword diff --git a/R/ae_volcano_plot.R b/R/ae_volcano_plot.R index be246ab..13ab772 100644 --- a/R/ae_volcano_plot.R +++ b/R/ae_volcano_plot.R @@ -66,7 +66,7 @@ #' trtgrp = "Xanomeline High Dose", #' statistics = "Risk Ratio", #' alpha = 0.05, -#' cutoff = 5, +#' cutoff_where = "FREQ >5", #' sort_opt = "Ascending", #' sort_var = "Count" #' ) @@ -102,7 +102,9 @@ ae_volcano_plot <- function(datain, pvalue_sig = 0.05, interactive = "N") { ### Construction of volcano plot - datain <- datain |> filter(!.data[["RISK"]] %in% c(NA, Inf)) + datain <- datain |> + filter(!.data[["RISK"]] %in% c(NA, Inf)) |> + mutate(key = dplyr::row_number()) # Check if getstats data is empty: stopifnot("Risk data is empty" = nrow(datain) != 0) stopifnot( @@ -209,6 +211,40 @@ ae_volcano_plot <- function(datain, #' @export #' #' @examples +#' data("adae") +#' +#' ae_pre <- ae_pre_processor( +#' datain = adae, +#' obs_residual = 0, +#' fmq_data = NA +#' ) +#' +#' ae_entry <- mentry( +#' datain = ae_pre$data, +#' subset = NA, +#' byvar = "AEBODSYS", +#' trtvar = "TRTA", +#' trtsort = "TRTAN", +#' subgrpvar = NA, +#' trttotalyn = "N", +#' add_grpmiss = "N", +#' sgtotalyn = "N", +#' pop_fil = "SAFFL" +#' ) +#' +#' ae_risk <- risk_stat( +#' datain = ae_entry, +#' a_subset = ae_pre$a_subset, +#' summary_by = "Patients", +#' eventvar = "AEDECOD", +#' ctrlgrp = "Placebo", +#' trtgrp = "Xanomeline High Dose", +#' statistics = "Risk Ratio", +#' alpha = 0.05, +#' cutoff_where = "FREQ >5", +#' sort_opt = "Ascending", +#' sort_var = "Count" +#' ) #' ae_volcano_opts(ae_risk, #' pvalue_trans = "-log10" #' ) diff --git a/R/bar_plot.R b/R/bar_plot.R index f7d568f..624d0db 100644 --- a/R/bar_plot.R +++ b/R/bar_plot.R @@ -46,7 +46,8 @@ #' adsl_sum <- msumstat( #' datain = adsl_entry, #' dptvar = "AGE", -#' statvar = "mean" +#' statvar = "mean", +#' figyn = "Y" #' )[["gsum"]] |> #' plot_display_bign(adsl_entry) |> #' dplyr::mutate( @@ -93,15 +94,15 @@ bar_plot <- function(datain, ) # Remove empty rows datain <- datain |> - mutate(YVAR = as.numeric(YVAR)) + mutate(YVAR = as.numeric(.data[["YVAR"]])) # Bar plot: # Legend Labels if based on other variable: series_labels <- series_leg_lab(datain, series_var, series_labelvar) g_plot <- datain |> ggplot(aes( - x = XVAR, - y = YVAR, + x = .data[["XVAR"]], + y = .data[["YVAR"]], fill = .data[[series_var]], group = .data[[series_var]] )) + diff --git a/R/box_plot.R b/R/box_plot.R index 2860f9e..0a568c1 100644 --- a/R/box_plot.R +++ b/R/box_plot.R @@ -169,13 +169,13 @@ box_plot <- function(datain, # Check for existence of outliers in data if ("outliers" %in% names(datain)) { stat_outliers <- datain |> - tidyr::separate_rows(outliers, sep = "~") |> - mutate(outliers = as.numeric(outliers)) + tidyr::separate_rows("outliers", sep = "~") |> + mutate(outliers = as.numeric(.data[["outliers"]])) g_plot <- g_plot + geom_point( data = stat_outliers, mapping = aes( - x = XVAR, y = outliers, + x = .data[["XVAR"]], y = .data[["outliers"]], group = .data[[series_var]] ), shape = 21, diff --git a/R/carver-package.R b/R/carver-package.R index fd8bb2b..6aa65e6 100644 --- a/R/carver-package.R +++ b/R/carver-package.R @@ -12,7 +12,7 @@ # See the License for the specific language governing permissions and # limitations under the License. # -#' @import shiny ggplot2 dplyr scales shinyWidgets flextable htmltools tools ggsurvfit +#' @import shiny ggplot2 dplyr scales shinyWidgets flextable htmltools tools stringr #' @importFrom DT addRow colReorder datatable formatDate saveWidget #' formatPercentage formatRound formatStyle selectCells #' selectColumns selectPage selectRows showCols styleEqual @@ -26,15 +26,10 @@ #' expr expr_interp expr_label exprs f_lhs f_rhs inform #' is_missing new_formula parse_expr parse_exprs set_names sym #' syms type_of warn eval_tidy is_expression -#' @importFrom stringr str_c str_detect str_extract str_glue str_match str_sub -#' str_remove str_remove_all str_replace str_replace_all str_subset -#' str_trim str_to_lower str_to_title str_to_upper str_length -#' str_locate str_wrap str_split str_squish #' @importFrom stats na.omit p.adjust qnorm reorder setNames median IQR quantile qt sd -#' @importFrom purrr map map2 pmap map_chr map_dbl keep discard modify modify_at +#' @importFrom purrr map map2 pmap map_chr map_dbl keep modify modify_at #' modify_if reduce set_names every none compact every flatten pluck list_modify #' @importFrom tidyr drop_na pivot_wider replace_na unite pivot_longer -#' @importFrom survival coxph Surv cox.zph survfit #' @importFrom glue glue #' @importFrom plotly ggplotly subplot add_annotations layout "_PACKAGE" diff --git a/R/data.R b/R/data.R index 6841a2a..97a4a56 100644 --- a/R/data.R +++ b/R/data.R @@ -36,9 +36,9 @@ #' Adverse Events Analysis Dataset. #' #' @source , -#' downloaded 2023-03-17 +#' downloaded 2023-03-17, modified 2023-03-17 #' -#' @format Data frame with 1191 features and 55 fields +#' @format Data frame with 1191 features and 56 fields "adae" #' FMQ Consolidated List @@ -59,13 +59,6 @@ #' @format List of length `2`, 1 data frame and 1 string "ae_pre_process" -#' ae_risk -#' -#' Output from `risk_stat()` -#' -#' @format Data frame with `46` rows and `17` variables -"ae_risk" - #' event_df #' #' Output from `risk_stat()` required for `event_analysis()` diff --git a/R/data_read.R b/R/data_read.R index c6568d5..de427da 100644 --- a/R/data_read.R +++ b/R/data_read.R @@ -36,8 +36,9 @@ #' df <- data_read(ui_data_source = "Default", ui_adam_data = "ADSL") #' dplyr::slice_head(df$adam$adsl, n = 10) data_read <- function( - ui_data_source, - ui_adam_data) { + ui_data_source, + ui_adam_data +) { adam <- list() adam_attrib <- list() ### Reading data from local folders, based on the format of the file loaded in the shiny interface diff --git a/R/dataset_merge.R b/R/dataset_merge.R index bdb5f0c..fb74309 100644 --- a/R/dataset_merge.R +++ b/R/dataset_merge.R @@ -11,64 +11,67 @@ # WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. # See the License for the specific language governing permissions and # limitations under the License. +# #' Merge Datasets #' #' @param ... Datasets to be merged. #' @param byvars By variables required to perform merge. #' @param subset Dataset specific subset conditions as `list`, default is `NULL`. #' Has to be specified in the same order of datasets to be merged +#' @param type Type of join to perform. Values: "left", "right", "inner", "full", "semi", "anti" #' #' @return A `data.frame` #' @export #' #' @examples #' dataset_merge( -#' lab_data$adsl, -#' lab_data$adlb, +#' adsl, +#' adlb, #' byvars = "STUDYID~USUBJID~SUBJID", -#' subset = list("SEX=='F'", "PARAMCD == 'L00021S'") +#' subset = list("SEX=='F'", "PARAMCD == 'ALT'") #' ) #' #' dataset_merge( -#' lab_data$adsl, -#' lab_data$adlb, +#' adsl, +#' adlb, #' byvars = "STUDYID~USUBJID~SUBJID", #' subset = list("SEX=='F'", NA_character_) #' ) #' #' dataset_merge( -#' lab_data$adsl, -#' lab_data$adlb, +#' adsl, +#' adlb, #' byvars = "STUDYID~USUBJID~SUBJID", -#' subset = list(NA_character_, "PARAMCD == 'L00021S'") +#' subset = list(NA_character_, "PARAMCD == 'ALT'") #' ) #' #' dataset_merge( -#' lab_data$adsl, -#' lab_data$adlb, +#' adsl, +#' adlb, #' byvars = "STUDYID~USUBJID~SUBJID", -#' subset = list("USUBJID == 'XYZ1 1003 10031009'", NA_character_) -#' ) -#' -#' dataset_merge( -#' waterfall_plot_data$adrs, -#' waterfall_plot_data$adtr, -#' byvars = "STUDYID~USUBJID~TRT01P", -#' subset = list("PARAMCD == 'BOR_C'", NA_character_) +#' subset = list("USUBJID == '01-701-1015'", NA_character_) #' ) #' #' ## more than 2 datasets #' #' dataset_merge( -#' dplyr::filter(lab_data$adsl, USUBJID == "XYZ1 1003 10031009"), -#' lab_data$adsl, -#' lab_data$adlb, +#' dplyr::filter(adsl, USUBJID == "01-701-1015"), +#' adsl, +#' adlb, #' byvars = "STUDYID~USUBJID~SUBJID" #' ) #' -dataset_merge <- function(..., byvars, subset = NULL) { - dfs <- list2(...) +dataset_merge <- function(..., byvars, subset = NULL, type = "left") { + dfs <- rlang::list2(...) stopifnot("At least two datasets required for merging" = length(dfs) >= 2) + stopifnot( + "Type should be one of left, right, inner, full" = + type %in% c("left", "right", "inner", "full") + ) + + if (type == "full") { + warning("For full join, subsets will not work as expected. Consider using adsl_merge() instead") + } byvars <- str_to_vec(byvars) if (!every(dfs, \(x) all(byvars %in% names(x)))) stop("`byvars` not present") @@ -95,7 +98,8 @@ dataset_merge <- function(..., byvars, subset = NULL) { } out }) - reduce(df_list, left_join, byvars) + type <- paste0(type, "_join") + reduce(df_list, get(type), byvars) } #' Merge adsl dataset with the analysis dataset @@ -103,32 +107,33 @@ dataset_merge <- function(..., byvars, subset = NULL) { #' @param adsl adsl dataset #' @param adsl_subset population variable subset condition #' @param dataset_add analysis dataset +#' @param byvars Variables to merge the datasets by #' #' @return merged dataset #' @export #' #' @examples -#' data(lab_data) -#' +#' data("adae") +#' data("adsl") #' adsl_merge( -#' adsl = lab_data$adsl, +#' adsl = adsl, #' adsl_subset = "SAFFL=='Y'", -#' dataset_add = lab_data$adlb +#' dataset_add = adae #' ) #' -adsl_merge <- function(adsl = NULL, adsl_subset = "", dataset_add = NULL) { - stopifnot(length(adsl) > 0) - stopifnot(nrow(adsl) > 0) - stopifnot(length(dataset_add) > 0) +adsl_merge <- function(adsl = NULL, adsl_subset = "", dataset_add = NULL, byvars = NULL) { + stopifnot("Pass an ADSL dataset" = length(adsl) > 0) + stopifnot("Pass an Analysis Dataset" = length(dataset_add) > 0) + if (nrow(adsl) == 0 || nrow(dataset_add) == 0) { + return(data.frame()) + } + if (is.null(byvars)) { + byvars <- intersect(colnames(adsl), colnames(dataset_add)) + } + outdata <- full_join(adsl, dataset_add, by = byvars) if (adsl_subset != "" && !is.na(adsl_subset)) { - adsl <- adsl |> - filter(!!!parse_exprs(adsl_subset)) + outdata <- filter(outdata, !!!parse_exprs(adsl_subset)) } - - byvars <- grep("STUDYID|USUBJID|SUBJID", names(dataset_add), value = TRUE) - - adsl |> - select(all_of(c(byvars, setdiff(names(adsl), names(dataset_add))))) |> - left_join(dataset_add, by = byvars) + outdata } diff --git a/R/edish_plot.R b/R/edish_plot.R index 62031cf..9f6bf85 100644 --- a/R/edish_plot.R +++ b/R/edish_plot.R @@ -1,3 +1,17 @@ +# Copyright 2024 Pfizer Inc +# +# Licensed under the Apache License, Version 2.0 (the "License"); +# you may not use this file except in compliance with the License. +# You may obtain a copy of the License at +# +# http://www.apache.org/licenses/LICENSE-2.0 +# +# Unless required by applicable law or agreed to in writing, software +# distributed under the License is distributed on an "AS IS" BASIS, +# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +# See the License for the specific language governing permissions and +# limitations under the License. +# #' Process data for eDISH plot #' #' @param datain Input dataset. @@ -9,6 +23,7 @@ #' @param alt_paramcd `PARAMCD` value for `ALANINE AMINOTRANSFERASE` in `datain`. #' @param ast_paramcd `PARAMCD` value for `ASPARTATE AMINOTRANSFERASE` in `datain`. #' @param bili_paramcd `PARAMCD` value for `BILIRUBIN` in `datain`. +#' @param legendbign (`string`) Display BIGN in Legend (`Y/N`). #' #' @return A `data.frame` required for `edish_plot`. #' @export @@ -37,10 +52,13 @@ #' process_edish_data <- function(datain, xvar = "both", - alt_paramcd = "L00030S", - ast_paramcd = "L00028S", - bili_paramcd = "L00021S") { - stopifnot(is.data.frame(datain)) + alt_paramcd = "ALT", + ast_paramcd = "AST", + bili_paramcd = "BILI", + legendbign = "Y") { + if (!is.data.frame(datain) || nrow(datain) == 0) { + return(data.frame()) + } stopifnot("`xvar` must be one of 'alt', 'ast' or 'both'" = xvar %in% c("alt", "ast", "both")) stopifnot( "Please provide valid PARAMCD" = @@ -48,7 +66,10 @@ process_edish_data <- function(datain, ) hy_data <- datain |> - filter(.data$PARAMCD %in% c(alt_paramcd, ast_paramcd, bili_paramcd)) |> + filter( + .data$PARAMCD %in% c(alt_paramcd, ast_paramcd, bili_paramcd), + !is.na(.data$ANRHI) + ) |> mutate(maxv = .data$AVAL / .data$ANRHI) |> mutate( PARM = case_when( @@ -63,8 +84,8 @@ process_edish_data <- function(datain, summarise(x = max(.data$maxv)) |> pivot_wider( id_cols = c(USUBJID, TRTVAR), - names_from = PARM, - values_from = x + names_from = "PARM", + values_from = "x" ) if (xvar %in% c("alt", "ast")) { @@ -82,14 +103,14 @@ process_edish_data <- function(datain, ifelse(xvar == "both", "Max of ALT/AST = ", paste("value of", toupper(xvar), "=") ), - round(XVAR, 3), + round(.data[["XVAR"]], 3), "\n", "Bilirubin = ", - round(bili, 3) + round(.data[["bili"]], 3) ), YVAR = .data[["bili"]] ) |> - na.omit() + plot_display_bign(datain, bignyn = legendbign) } #' eDISH Plot @@ -113,8 +134,8 @@ process_edish_data <- function(datain, #' @export #' #' @examples -#' data("adsl") #' data("adlb") +#' data("adsl") #' #' merged_data <- adsl_merge( #' adsl = adsl, @@ -143,9 +164,9 @@ process_edish_data <- function(datain, #' datain = pt_data, #' axis_opts = plot_axis_opts( #' xlinearopts = list( -#' breaks = c(0.1, 1, 2, 10), -#' limits = c(0.1, 10), -#' labels = c("0.1", "1", "2x ULN", "10") +#' breaks = c(0.1, 1, 2, 5), +#' limits = c(0.1, 5), +#' labels = c("0.1", "1", "2x ULN", "5") #' ), #' ylinearopts = list( #' breaks = c(0.1, 1, 3, 10), @@ -196,24 +217,7 @@ edish_plot <- function(datain, dir = "horizontal" ), interactive = "N") { - stopifnot(is.data.frame(datain)) - - ### Modified plot options #### - if (length(axis_opts$Xbrks) > 0 && length(axis_opts$Xlims) > 0) { - axis_opts$Xlims[2] <- max(ceiling(max(datain$XVAR)), axis_opts$Xlims) - axis_opts$Xbrks[which.max(axis_opts$Xbrks)] <- min( - ceiling(max(datain$XVAR)), - max(axis_opts$Xbrks) - ) - } - - if (length(axis_opts$Ybrks) > 0 && length(axis_opts$Ylims) > 0) { - axis_opts$Ylims[2] <- max(ceiling(max(datain$XVAR)), axis_opts$Ylims) - axis_opts$Ybrks[which.max(axis_opts$Ybrks)] <- min( - ceiling(max(datain$XVAR)), - max(axis_opts$Ybrks) - ) - } + stopifnot(is.data.frame(datain) && nrow(datain) > 0) # plot and options # setting labels for each quadrants quad_labels <- str_to_vec(quad_labels) @@ -252,16 +256,6 @@ edish_plot <- function(datain, color = xrefline[2], linetype = xrefline[3] ) + - geom_hline( - yintercept = 1, - color = "grey30", - linetype = "solid" - ) + - geom_vline( - xintercept = 1, - color = "grey30", - linetype = "solid" - ) + # Add annotations to graph annotate( geom = "text", x = quad_labels_opts_x[1], diff --git a/R/event_analysis.R b/R/event_analysis.R index a942a82..d46e522 100644 --- a/R/event_analysis.R +++ b/R/event_analysis.R @@ -36,7 +36,8 @@ #' ae_pre_processor( #' ae_filter = "ANY", #' obs_residual = 0, -#' fmq_data = FMQ_Consolidated_List +#' fmq_data = FMQ_Consolidated_List, +#' subset = "AOCCPFL == 'Y'" #' ) #' #' ## prepare data for plot @@ -50,7 +51,7 @@ #' ## prepare data for plot #' prep_event_analysis <- prep_entry |> #' process_event_analysis( -#' a_subset = glue::glue("AOCCPFL == 'Y' & {prep_ae$a_subset}"), +#' a_subset = prep_ae$a_subset, #' summary_by = "Events", #' hterm = "FMQ_NAM", #' ht_val = "ABDOMINAL PAIN", @@ -239,7 +240,7 @@ process_event_analysis <- HTERM = hterm, HVAL = str_remove_all(ht_val, glue("/{toupper(ht_scope)}")), LVAL = lt_val, - Percent = paste(.data$PCT, "% \n Low Term:", .data$DPTVAL), + Percent = paste(.data$CPCT, "% \n Low Term:", .data$DPTVAL), PCT_N = as.numeric(.data$PCT) ) |> group_by(.data$TRTVAR) |> @@ -254,7 +255,7 @@ process_event_analysis <- filter_events(lterm, lt_val, "DPTVAL") |> mutate( PCT_N = as.numeric(.data$PCT), - Percent = paste(.data$PCT, "%") + Percent = paste(.data$CPCT, "%") ) |> arrange(.data$TRTVAR, .data$PCT_N) diff --git a/R/event_interval.R b/R/event_interval.R index 34ec8bb..5143072 100644 --- a/R/event_interval.R +++ b/R/event_interval.R @@ -100,7 +100,7 @@ interval_plot <- function(datain, # Use data with either Start or end dates only for scatter plot scatterdata <- ad_plot %>% filter(Status != "Complete" | !!sym(startvar) == !!sym(endvar)) %>% - tidyr::pivot_longer(c(startvar, endvar), names_to = "key", values_to = "Value") %>% + tidyr::pivot_longer(all_of(c(startvar, endvar)), names_to = "key", values_to = "Value") %>% filter(!is.na(Value)) %>% select(-key) %>% distinct(.keep_all = TRUE) diff --git a/R/forest_plot.R b/R/forest_plot.R index 1f38f4f..df1c4a4 100644 --- a/R/forest_plot.R +++ b/R/forest_plot.R @@ -35,14 +35,40 @@ #' @export #' #' @examples -#' data(ae_risk) +#' data("adae") +#' ae_pre_process <- ae_pre_processor( +#' datain = adae, +#' obs_residual = 0 +#' ) +#' +#' ae_entry <- mentry( +#' datain = ae_pre_process$data, +#' byvar = "AEBODSYS", +#' trtvar = "TRTA", +#' trtsort = "TRTAN", +#' pop_fil = "SAFFL" +#' ) +#' +#' ae_risk <- risk_stat( +#' datain = ae_entry, +#' a_subset = ae_pre_process$a_subset, +#' summary_by = "Patients", +#' eventvar = "AEDECOD", +#' ctrlgrp = "Placebo", +#' trtgrp = "Xanomeline High Dose", +#' statistics = "Risk Ratio", +#' alpha = 0.05, +#' cutoff_where = "PCT > 2", +#' hoveryn = "Y" +#' ) |> +#' dplyr::mutate(key = dplyr::row_number()) #' forest_plot_base( #' ae_risk, #' xvar = "RISK", #' yvar = "DPTVAL", #' xminvar = "RISKCIL", #' xmaxvar = "RISKCIU", -#' hovervar = "HOVER_RISK", +#' hovervar = "HOVER_TEXT", #' series_var = "TRTPAIR", #' xrefline = 1, #' axis_opts = plot_axis_opts( @@ -128,7 +154,33 @@ forest_plot_base <- function(datain, #' @export #' #' @examples -#' data(ae_risk) +#' data("adae") +#' ae_pre_process <- ae_pre_processor( +#' datain = adae, +#' obs_residual = 0 +#' ) +#' +#' ae_entry <- mentry( +#' datain = ae_pre_process$data, +#' byvar = "AEBODSYS", +#' trtvar = "TRTA", +#' trtsort = "TRTAN", +#' pop_fil = "SAFFL" +#' ) +#' +#' ae_risk <- risk_stat( +#' datain = ae_entry, +#' a_subset = ae_pre_process$a_subset, +#' summary_by = "Patients", +#' eventvar = "AEDECOD", +#' ctrlgrp = "Placebo", +#' trtgrp = "Xanomeline High Dose", +#' statistics = "Risk Ratio", +#' alpha = 0.05, +#' cutoff_where = "PCT > 2", +#' hoveryn = "Y" +#' ) |> +#' dplyr::mutate(key = dplyr::row_number()) #' forest_plot_scatter( #' datain = ae_risk, #' xvar = "PCT", @@ -139,7 +191,7 @@ forest_plot_base <- function(datain, #' shape = g_seriessym(ae_risk, NA, "TRTVAR"), #' size = rep(1, 2) #' ), -#' hovervar = "HOVER_PCT", +#' hovervar = "HOVER_TEXT", #' xaxis_pos = "top" #' ) #' @@ -216,12 +268,39 @@ forest_plot_scatter <- function(datain, #' @param plot_height Height of plotly output, if specifically required #' @param xpos Where should X xaxis for `splot` and `fplot` be displayed in interactive plot? #' Values: "top"/"bottom". Value for static output is decided prior to passing in this function. -#' +#' @param legend_opts Legend styling option, a `list` containing `pos`(position) and +#' `dir` (direction). #' @return plot_grid object or plotly forest plot object #' @export #' #' @examples -#' data(ae_risk) +#' data("adae") +#' ae_pre_process <- ae_pre_processor( +#' datain = adae, +#' obs_residual = 0 +#' ) +#' +#' ae_entry <- mentry( +#' datain = ae_pre_process$data, +#' byvar = "AEBODSYS", +#' trtvar = "TRTA", +#' trtsort = "TRTAN", +#' pop_fil = "SAFFL" +#' ) +#' +#' ae_risk <- risk_stat( +#' datain = ae_entry, +#' a_subset = ae_pre_process$a_subset, +#' summary_by = "Patients", +#' eventvar = "AEDECOD", +#' ctrlgrp = "Placebo", +#' trtgrp = "Xanomeline High Dose", +#' statistics = "Risk Ratio", +#' alpha = 0.05, +#' cutoff_where = "PCT > 2", +#' hoveryn = "Y" +#' ) |> +#' dplyr::mutate(key = dplyr::row_number()) #' splot <- forest_plot_scatter( #' datain = ae_risk, #' xvar = "PCT", @@ -232,7 +311,7 @@ forest_plot_scatter <- function(datain, #' shape = g_seriessym(ae_risk, NA, "TRTVAR"), #' size = rep(1, 2) #' ), -#' hovervar = "HOVER_PCT", +#' hovervar = "HOVER_TEXT", #' xaxis_pos = "top", #' legend_opts = list(pos = "bottom", dir = "horizontal"), #' axis_opts = list(xsize = 8, xtsize = 6, xaxis_label = "Percentage") @@ -243,7 +322,7 @@ forest_plot_scatter <- function(datain, #' yvar = "DPTVAL", #' xminvar = "RISKCIL", #' xmaxvar = "RISKCIU", -#' hovervar = "HOVER_RISK", +#' hovervar = "HOVER_TEXT", #' series_var = "TRTPAIR", #' xrefline = 1, #' axis_opts = plot_axis_opts( @@ -263,7 +342,8 @@ forest_display <- function(plot_list, rel_widths = c(0.25, 0.38, 0.27, 0.10), interactive = "N", plot_height = NULL, - xpos = "top") { + xpos = "top", + legend_opts = list(pos = "bottom", dir = "horizontal")) { stopifnot(all(c("splot", "fplot") %in% names(plot_list))) stopifnot( "rel_widths should be equal to the number of plot columns" = @@ -298,8 +378,9 @@ forest_display <- function(plot_list, plotly_legend(lg_pos = c(0.5, -0.2), dir = "h") combine_plot$x$source <- "plot_output" } else { - legend1 <- cowplot::get_legend(plot_list[["splot"]]) - legend2 <- cowplot::get_legend(plot_list[["fplot"]]) + legpattern <- paste0("guide-box-", trimws(legend_opts$pos)) + legend1 <- cowplot::get_plot_component(plot_list[["splot"]], pattern = legpattern) + legend2 <- cowplot::get_plot_component(plot_list[["fplot"]], pattern = legpattern) plot_list[["splot"]] <- plot_list[["splot"]] + theme(legend.position = "none") plot_list[["fplot"]] <- plot_list[["fplot"]] + theme(legend.position = "none") # Combine for grid ggplot output diff --git a/R/global.R b/R/global.R index 1fb5717..50aa389 100644 --- a/R/global.R +++ b/R/global.R @@ -18,6 +18,7 @@ globalVariables(c( "ADJPVALUE", + ".env", "AEDECOD", "AEENDT", "AENDT", @@ -96,11 +97,15 @@ globalVariables(c( "DENOMN_TRTGRP", "FMQ_NAM", "USUBJID", + "SUBJID", + "x", "key", ":=", "curve_n", "point_n", "Status", "Value", - "ASEV" + "ASEV", + "TA", + "REPTYPE" )) diff --git a/R/graph_utils.R b/R/graph_utils.R index 93c03b5..d2fe525 100644 --- a/R/graph_utils.R +++ b/R/graph_utils.R @@ -21,7 +21,6 @@ #' @export #' #' @examples -#' library(carver) #' library(ggplot2) #' ggplot(data = mtcars, mapping = aes(x = mpg, y = hp)) + #' geom_point() + @@ -71,7 +70,7 @@ g_seriescol <- function(gdata, levs <- levels(unique(gdata[[SERIESVAR]])) vals <- levs[levs %in% unique(gdata[[SERIESVAR]])] seriescols <- setNames(col_list[seq_along(vals)], vals) - return(seriescols) + seriescols } #' Recode Shapes to Numbers @@ -142,7 +141,7 @@ g_seriessym <- function(gdata, levs <- levels(unique(gdata[[SERIESVAR]])) vals <- levs[levs %in% unique(gdata[[SERIESVAR]])] ptshapes <- setNames(shapelist[seq_along(vals)], vals) - return(ptshapes) + ptshapes } @@ -159,7 +158,6 @@ g_seriessym <- function(gdata, #' @export #' #' @examples -#' library(carver) #' empty_plot() empty_plot <- function(message = "No data available for these values", fontsize = 8) { @@ -173,7 +171,7 @@ empty_plot <- function(message = "No data available for these values", layout( xaxis = list(visible = FALSE), yaxis = list(visible = FALSE) ) - return(list(plot = g_plot, ptly = fig)) + list(plot = g_plot, ptly = fig) } @@ -204,8 +202,6 @@ def_axis_spec <- function(arg, vec, val) { #' @export #' #' @examples -#' library(carver) -#' #' plot_axis_opts( #' xlinearopts = list( #' breaks = c(0.001, 0.01, 0.1, 1, 10, 100), @@ -400,7 +396,7 @@ plot_aes_opts <- function(datain, out$contrast <- unname(g_seriescol(datain, series_contrast, "aesvar")) } } - return(out) + out } #' Return N count in plot legend (treatment) @@ -425,7 +421,7 @@ plot_aes_opts <- function(datain, #' msumstat( #' adsl_entry, #' dptvar = "AGE", -#' statvar = "meansd" +#' statvar = "mean" #' )$gsum |> #' plot_display_bign(adsl_entry) plot_display_bign <- function(datain, @@ -453,7 +449,7 @@ plot_display_bign <- function(datain, } else { datain[["TRTTXT"]] <- datain[["TRTVAR"]] } - return(datain) + datain } #' Theme for ggplots with only X axis title/ticks @@ -557,7 +553,7 @@ theme_std <- function(axis_opts = plot_axis_opts(), panel.grid.major.y = element_line(linewidth = 0.1, color = "grey") ) } - return(t) + t } #' Calculate plot title N values @@ -599,7 +595,6 @@ plot_title_nsubj <- function(datain, plot_data, by) { #' @export #' #' @examples -#' library(carver) #' MPG <- ggplot2::mpg #' MPG[["cyl"]] <- as.character(MPG[["cyl"]]) #' tbl_to_plot( diff --git a/R/km_plot.R b/R/km_plot.R index 75a558f..e152ef9 100644 --- a/R/km_plot.R +++ b/R/km_plot.R @@ -35,33 +35,6 @@ #' @export #' #' @examples -#' data("survival") -#' -#' km_df <- survival[["adsl"]] |> -#' surv_pre_processor( -#' dataset_analysis = survival[["adtte"]], -#' analysis_subset = "PARAMCD == 'PFS_P'" -#' ) -#' -#' km_df |> -#' km_plot( -#' trt_colors = "#F8766D~#00BA38~#619CFF" -#' ) -#' -#' ## with confidence interval and multiple `risk table` statistics -#' km_df |> -#' km_plot( -#' disp_conf.int = "Y", -#' risktab_stats = "n.risk~n.censor", -#' risktab_height = 0.25, -#' trt_colors = "#F8766D~#00BA38~#619CFF", -#' axis_opts = plot_axis_opts( -#' xlinearopts = list(breaks = 3), -#' ylinearopts = list(breaks = 0.1), -#' xaxis_label = "Progression-Free Survival Time (Months)", -#' yaxis_label = "Probability of Progression Free Survival" -#' ) -#' ) #' #' ## with `{pharmaverseadam}` test data sets #' ## run `install.packages("pharmaverseadam")` prior running this example @@ -123,7 +96,7 @@ km_plot <- ))) ## create the `survfit` object survfit_km <- - survfit2( + ggsurvfit::survfit2( Surv(timevar, cnsrvar) ~ TRTVAR, data = plot_data, conf.type = "log-log", @@ -131,7 +104,7 @@ km_plot <- ) ## get legend labels to display km_legend <- survfit_km |> - km_legend_txt(time_unit) + ggsurvfit::km_legend_txt(time_unit) ## get pairwise prop hazard stats using `survival::coxph()` pair_stat <- NULL if (disp_pair.stat == "Y") { @@ -140,7 +113,7 @@ km_plot <- } ## Kaplan-Meir plot km <- survfit_km |> - ggsurvfit( + ggsurvfit::ggsurvfit( linewidth = 0.8, theme = list_modify( theme_std(axis_opts, legend_opts), @@ -166,7 +139,7 @@ km_plot <- ## prepare km plot for display ### plot specific options km + - scale_ggsurvfit( + ggsurvfit::scale_ggsurvfit( x_scales = list( breaks = @@ -203,7 +176,7 @@ km_plot <- km_legend_txt <- function(survfit_km, time_unit) { tibble::as_tibble(summary(survfit_km)[["table"]], rownames = "strata") |> mutate(across("strata", \(x) str_remove_all(x, "TRTVAR="))) |> - semi_join(tidy_survfit(survfit_km), by = "strata") |> + semi_join(ggsurvfit::tidy_survfit(survfit_km), by = "strata") |> mutate( txt = glue( "{strata} (N={records}, Events={events}, Median={round_f(median, 1)} {time_unit}, 95%CI ({round_f(`0.95LCL`, 1)}, {round_f(`0.95UCL`, 1)}))" # nolint diff --git a/R/adlb_r301.R b/R/lab_abnormality.R similarity index 65% rename from R/adlb_r301.R rename to R/lab_abnormality.R index 6c0a824..57ff7ef 100644 --- a/R/adlb_r301.R +++ b/R/lab_abnormality.R @@ -1,19 +1,32 @@ +# Copyright 2024 Pfizer Inc +# +# Licensed under the Apache License, Version 2.0 (the "License"); +# you may not use this file except in compliance with the License. +# You may obtain a copy of the License at +# +# http://www.apache.org/licenses/LICENSE-2.0 +# +# Unless required by applicable law or agreed to in writing, software +# distributed under the License is distributed on an "AS IS" BASIS, +# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +# See the License for the specific language governing permissions and +# limitations under the License. +# #' Incidence of Laboratory Test Abnormalities (Without Regard to Baseline Abnormality) #' #' @param datain Input dataset (`adlb`). #' @param crit_vars Criteria variables -#' @param pctdisp Denominator to calculate percentages by. +#' @param stathead Column label to display `n` in the output. Default is `n (%)` #' Values: `"TRT", "VAR","COL", "SUBGRP", "SGRPN", "CAT", "NONE", "NO", "DPTVAR"` -#' @param a_subset Subset conditions for analysis of dependent variable. -#' @param denom_subset Subset conditions for denominator eg. `"APSBLFL == 'Y'"` +#' @inheritParams mcatstat #' #' @return `data.frame` with summary of laboratory abnormality incidence counts #' @export #' #' @examples -#' data("lab_data") +#' data("adlb") #' -#' lb_entry <- lab_data$adlb |> +#' lb_entry <- adlb |> #' mentry( #' subset = NA_character_, #' byvar = "PARCAT1~PARAM", @@ -29,15 +42,14 @@ #' out <- #' lb_entry |> #' lab_abnormality_summary( -#' crit_vars = "CRIT3~CRIT4", +#' crit_vars = "CRIT1~CRIT2", #' pctdisp = "SUBGRP", #' a_subset = NA_character_, -#' denom_subset = NA_character_ +#' denom_subset = NA_character_, +#' sigdec = 1 #' ) |> #' display_bign_head(mentry_data = lb_entry) |> -#' tbl_processor( -#' dptlabel = "" -#' ) +#' tbl_processor() #' #' out #' @@ -49,12 +61,18 @@ #' ) #' lab_abnormality_summary <- function(datain, - crit_vars = "CRIT3~CRIT4", + crit_vars = "CRIT1~CRIT2", pctdisp = "SUBGRP", a_subset = NA_character_, - denom_subset = NA_character_) { + denom_subset = NA_character_, + sigdec = 2, + sparseyn = "Y", + pctsyn = "N", + stathead = "n (%)") { # Data checks and error messages - stopifnot(is.data.frame(datain) && nrow(datain) > 0) + if (nrow(datain) < 1) { + return(datain) + } dptvars <- toupper(str_to_vec(crit_vars)) dptvars_fl <- glue("{dptvars}FL") byvars <- var_start(datain, "BYVAR") @@ -80,7 +98,7 @@ lab_abnormality_summary <- function(datain, # Replace missing values numeric equivalent grouping variables with 0 mutate(across(any_of(byvarsN), ~ replace_na(., 0))) # Calculate lab abnormalities by Criteria Flags - seq_along(dptvars) |> + out_data <- seq_along(dptvars) |> map(\(dptval) { asubset <- glue("{dptvars_fl[dptval]} == 'Y'") if (!is.na(a_subset) && @@ -94,14 +112,23 @@ lab_abnormality_summary <- function(datain, dsubset, toupper(byvars), dptvars[[dptval]], - pctdisp + pctdisp, + sigdec, + sparseyn, + pctsyn, + dptval ) }) |> # combine and display lab abnormality table - bind_rows() |> + bind_rows() + # Data check: + if (nrow(out_data) == 0) { + return(data.frame()) + } + out_data |> mutate(across(c("DENOMN", "CVALUE"), as.character)) |> - rename(N = DENOMN, n = CVALUE) |> - pivot_longer(c("N", "n"), names_to = "SUBGRPVARX", values_to = "CVALUE") |> + rename(N = DENOMN, !!stathead := CVALUE) |> + pivot_longer(c("N", stathead), names_to = "SUBGRPVARX", values_to = "CVALUE") |> mutate(SUBGRPVARXN = 9999) } @@ -118,7 +145,14 @@ count_abnormalities <- denom_subset, byvars, dptvars, - pctdisp) { + pctdisp, + sigdec, + sparseyn, + pctsyn, + dptvarn) { + if (nrow(datain) == 0) { + return(data.frame()) + } crit_df <- datain |> filter(.data[[dptvars]] != "") |> @@ -132,7 +166,11 @@ count_abnormalities <- a_subset = a_subset, denom_subset = denom_subset, dptvar = "DPTVAR", + dptvarn = dptvarn, pctdisp = pctdisp, - pctsyn = "N" + pctsyn = pctsyn, + sigdec = sigdec, + return_zero = "Y", + sparseyn = sparseyn ) } diff --git a/R/line_plot.R b/R/line_plot.R index 8d5c8ae..1e97dbf 100644 --- a/R/line_plot.R +++ b/R/line_plot.R @@ -16,54 +16,52 @@ #' #' @param datain Input dataset from process_line_plot_data() output. #' @inheritParams box_plot +#' @param dodge_width Width to dodge points/lines by, IF required. #' #' @return plot - Line plot. #' @export #' #' @examples -#' data("vx_line_data") -#' -#' lineplot_df <- process_line_plot_data( -#' dataset_adsl = vx_line_data$adsl, -#' dataset_analysis = vx_line_data$adva, -#' adsl_subset = "SAFFL == 'Y'", -#' analysis_subset = 'PARAMN==2 & TRTARN!=""& (AVISITN %in% c(1,3,4,5,6,7))', -#' trtvar = "TRTP", -#' trtsort = "TRTPN", -#' xvar = "AVISIT", -#' yvar = "AVAL" +#' data("adsl") +#' adsl_entry <- mentry( +#' datain = adsl, +#' subset = "EFFFL=='Y'", +#' byvar = "RACE", +#' trtvar = "TRT01A", +#' trtsort = "TRT01AN", +#' pop_fil = NA #' ) #' -#' plot <- line_plot( -#' datain = lineplot_df, -#' series_var = "TRTVAR", -#' series_labelvar = "TRTVAR", -#' series_opts = list( -#' color = g_seriescol(lineplot_df, NA, "TRTVAR") -#' ), -#' axis_opts = plot_axis_opts( -#' ylinearopts = list( -#' breaks = c(100, 1000, 10000, 100000), -#' limits = c(100, 100000) -#' ), -#' xaxis_label = "Visit", -#' yaxis_label = "Geometric Mean Titer" -#' ), +#' adsl_sum <- msumstat( +#' datain = adsl_entry, +#' dptvar = "AGE", +#' statvar = "mean" +#' ) +#' adsl_sum$gsum <- adsl_sum$gsum |> +#' dplyr::mutate( +#' XVAR = forcats::fct_reorder(.data[["BYVAR1"]], .data[["BYVAR1N"]]), +#' YVAR = as.numeric(.data[["mean"]]) +#' ) +#' line_plot( +#' datain = adsl_sum$gsum, +#' axis_opts = plot_axis_opts(xaxis_label = "Race", yaxis_label = "Mean Age"), #' legend_opts = list( -#' label = "", -#' pos = "bottom", +#' label = "Treatment", pos = "bottom", #' dir = "horizontal" #' ), -#' griddisplay = "N", -#' plot_title = "Line Plot" +#' series_opts = plot_aes_opts( +#' adsl_sum$gsum, +#' "TRTVAR", +#' series_color = "firebrick~forestgreen~dodgerblue", +#' series_shape = "triangle~square~circle" +#' ), +#' griddisplay = "Y" #' ) #' -#' plot -#' line_plot <- function(datain, series_var = "TRTVAR", series_labelvar = series_var, - series_opts, + series_opts = plot_aes_opts(datain, "TRTVAR"), axis_opts = plot_axis_opts(), legend_opts = list( label = "", @@ -71,7 +69,8 @@ line_plot <- function(datain, dir = "horizontal" ), griddisplay = "N", - plot_title = NULL) { + plot_title = NULL, + dodge_width = NULL) { stopifnot(nrow(datain) != 0) stopifnot( "XVAR, YVAR, series_var and series_labelvar should exist in data" = @@ -84,11 +83,24 @@ line_plot <- function(datain, x = .data[["XVAR"]], y = .data[["YVAR"]], group = .data[[series_var]] - )) + - geom_line(aes(color = .data[[series_var]])) + - geom_point(aes(color = .data[[series_var]]), - shape = 16 - ) + + )) + dodge_width <- as.numeric(dodge_width) + if (length(dodge_width) > 0 && !is.na(dodge_width)) { + plot <- plot + + geom_line(aes(color = .data[[series_var]]), position = position_dodge(dodge_width)) + + geom_point(aes( + color = .data[[series_var]], shape = .data[[series_var]], + size = .data[[series_var]] + ), position = position_dodge(dodge_width)) + } else { + plot <- plot + + geom_line(aes(color = .data[[series_var]])) + + geom_point(aes( + color = .data[[series_var]], shape = .data[[series_var]], + size = .data[[series_var]] + )) + } + plot <- plot + labs( title = plot_title, x = axis_opts$xaxis_label, @@ -102,14 +114,25 @@ line_plot <- function(datain, ) + scale_x_discrete( breaks = axis_opts$Xbrks, - limits = axis_opts$Xlims + limits = axis_opts$Xlims, + labels = axis_opts$Xticks ) + theme_std(axis_opts, legend_opts, griddisplay) + scale_color_manual( name = legend_opts$label, values = series_opts$color, labels = series_labels + ) + + scale_shape_manual( + name = legend_opts$label, + values = series_opts$shape, + labels = series_labels + ) + + scale_size_manual( + name = legend_opts$label, + values = series_opts$size, + labels = series_labels ) message("Line Plot Generated") - return(plot) + plot } diff --git a/R/mcatstat.R b/R/mcatstat.R index 5a9c4e1..6c73602 100644 --- a/R/mcatstat.R +++ b/R/mcatstat.R @@ -22,7 +22,7 @@ #' category #' @param a_subset Analysis Subset condition specific to categorical analysis. #' @param denom_subset Subset condition to be applied to data set for calculating denominator. -#' @param uniqid Variable to calculate unique counts of. Expected values: `"USUBJID"`, `"SITEID"`, +#' @param uniqid Variable(s) to calculate unique counts of. eg. `"USUBJID"`, `"SITEID"`, #' `"ALLCT"` #' @param dptvar Categorical Analysis variable and ordering variable if exists, #' separated by /. eg: `"SEX"`, `"SEX/SEXN"`, `"AEDECOD"`, `"ISTPT/ISTPTN"` @@ -40,7 +40,12 @@ #' @param dptvarn Number to assign as `DPTVARN`, useful for block sorting when #' multiple `mcatstat()` outputs are created to be combined. #' @param pctsyn Display Percentage Sign in table or not. Values: `"Y"/"N"` +#' @param sigdec Number of decimal places for % displayed in output #' @param denomyn Display denominator in output or not. Values: `"Y"/"N"` +#' @param sparseyn To sparse missing categories/treatments or not? `"Y"/"N"` +#' @param sparsebyvalyn Sparse missing categories within by groups. `"Y"/"N"` +#' @param return_zero Return rows with zero counts if analysis subset/ non-missing does not +#' exist in data. `"Y"/"N"` #' #' @details #' \itemize{ @@ -113,17 +118,25 @@ mcatstat <- function(datain = NULL, total_catlabel = "Total", dptvarn = 1, pctsyn = "Y", - denomyn = "N") { - stopifnot("No data for mcatstat" = nrow(datain) != 0) - stopifnot("uniqid should exist in data or be ALLCT" = uniqid %in% c(names(datain), "ALLCT")) + sigdec = 2, + denomyn = "N", + sparseyn = "N", + sparsebyvalyn = "N", + return_zero = "N") { + if (nrow(datain) == 0) { + return(datain) + } + stopifnot("uniqid should exist in data or be ALLCT" = all(uniqid %in% c(names(datain), "ALLCT"))) # Identify by groups if exists BYVAR <- var_start(datain, "BYVAR") # Identify subgroups if exists SUBGRP <- var_start(datain, "SUBGRP") + SUBGRPN <- var_start(datain, "SUBGRPN") + BYVARN <- var_start(datain, "BYVARN") dptvars <- sep_var_order(dptvar) # Process unique ID variable (if passed as "ALLCT") # If unique ID is ALLCT, use all rows instead of unique subjects - if (uniqid == "ALLCT") { + if (all(uniqid == "ALLCT")) { datain <- datain |> mutate(ALLCT = row_number()) } @@ -145,44 +158,77 @@ mcatstat <- function(datain = NULL, .data[["DPTVAL"]] ) ) - # Apply subsets to get num - if (!is.na(a_subset) && str_squish(a_subset) != "") { - data_num <- data_pro |> - filter(!!!parse_exprs(a_subset)) - } else { - data_num <- data_pro - } - # Subset for denom data - if (!is.na(denom_subset) && str_squish(denom_subset) != "") { - data_denom <- data_pro |> - filter(!!!parse_exprs(denom_subset)) - } else { - data_denom <- data_pro - } - if (nrow(data_num) < 1 || nrow(data_denom) < 1) { - return(data.frame()) - } + # Apply subsets to get num and denom data: + dflist <- map(list(a_subset, denom_subset), \(s) { + if (!is.na(s) && str_squish(s) != "") { + filter(data_pro, !!!parse_exprs(s)) + } else { + data_pro + } + }) + data_num <- dflist[[1]] + data_denom <- dflist[[2]] + # If missing categories to be included if (miss_catyn == "N") { data_num <- data_num |> filter(.data[["DPTVAL"]] != miss_catlabel) } # Set groups by Treatment, Sub,By if any to use for counts # Get N count as variable FREQ: - counts <- data_num |> - group_by(across(any_of(c( - "TRTVAR", SUBGRP, var_start(datain, "SUBGRPN"), BYVAR, - var_start(datain, "BYVARN"), "DPTVAL", "DPTVALN" - )))) |> - summarise(FREQ = length(unique(.data[[uniqid]]))) |> - ungroup() - - # If cumulative count is required then - if (cum_ctyn == "Y") { - counts <- counts |> - group_by(across(any_of(c("TRTVAR", BYVAR, SUBGRP)))) |> - arrange(.data[["DPTVALN"]], .by_group = TRUE) |> - mutate(FREQ = cumsum(.data[["FREQ"]])) |> + countgrp <- c( + var_start(data_num, "TRTVAR"), SUBGRP, SUBGRPN, BYVAR, + BYVARN, "DPTVAL", "DPTVALN" + ) + # If a_subset returns NONE and equired to return 0 count row: + if (nrow(data_num) < 1 && return_zero == "Y") { + counts <- data_pro |> + group_by(across(any_of(countgrp))) |> + summarise(FREQ = 0) |> ungroup() + } else { + # Else proceed to calculate count and percentage + if (nrow(data_num) < 1 || nrow(data_denom) < 1) { + return(data.frame()) + } + # Get count dataset and sparse categories + counts <- data_num |> + group_by(across(any_of(countgrp))) |> + summarise(FREQ = n_distinct(across(any_of(uniqid)))) |> + ungroup() + # Sparse categories (within by groups for sparseyn) + # sparsebyvalyn will also impute for 'by' categories + if (sparseyn == "Y" || (sparsebyvalyn == "Y" && length(BYVAR) > 0)) { + data_sparse <- data_pro + } else { + data_sparse <- counts + } + counts <- counts |> + sparse_vals( + data_sparse = data_sparse, + sparseyn = "Y", + sparsebyvalyn = "N", + BYVAR, + SUBGRP, + BYVARN, + SUBGRPN + ) |> + sparse_vals( + data_sparse = data_sparse, + sparseyn = "N", + sparsebyvalyn = sparsebyvalyn, + BYVAR, + SUBGRP, + BYVARN, + SUBGRPN + ) + # If cumulative count is required then + if (cum_ctyn == "Y") { + counts <- counts |> + group_by(across(any_of(c("TRTVAR", BYVAR, SUBGRP)))) |> + arrange(.data[["DPTVALN"]], .by_group = TRUE) |> + mutate(FREQ = cumsum(.data[["FREQ"]])) |> + ungroup() + } } # Calculate denominator/pct and add requisite variables for standard display processing: df <- counts |> @@ -192,9 +238,11 @@ mcatstat <- function(datain = NULL, pctdisp, pctsyn, denomyn, + sigdec, BYVAR, SUBGRP - ) |> + ) + df <- df |> mutate( DPTVAR = dptvars$vars, XVAR = .data[["DPTVAL"]], DPTVARN = dptvarn, CN = "C" ) |> @@ -202,7 +250,7 @@ mcatstat <- function(datain = NULL, message("mcatstat success") - return(df) + df } #' Caclulate denominator and oercentage for mcatstat @@ -227,6 +275,7 @@ calc_denom <- function(counts, pctdisp = "TRT", pctsyn = "Y", denomyn = "N", + sigdec = 2, BYVAR, SUBGRP) { # Check Allowable pctdisp values @@ -237,12 +286,13 @@ calc_denom <- function(counts, ) # Set denominator values for percentage if (pctdisp %in% c("NONE", "NO")) { - df <- counts |> mutate(CVALUE = .data[["FREQ"]]) # No percentage if pctdisp is NO/NONE + df <- counts |> mutate(CVALUE = as.character(.data[["FREQ"]])) + # No percentage if pctdisp is NO/NONE } else { # Identify which variables go towards creating Denominator if (pctdisp == "VAR") { # If pctdisp = VAR, total percent across all records - df <- counts |> mutate(DENOMN = length(unique(data_denom[[uniqid]]))) + df <- counts |> mutate(DENOMN = nrow(unique(data_denom[uniqid]))) } else { percgrp <- switch(gsub("[[:digit:]]", "", pctdisp), "TRT" = "TRTVAR", @@ -258,18 +308,24 @@ calc_denom <- function(counts, # Get denominator count per above variables df <- data_denom |> group_by(across(all_of(percgrp))) |> - summarise(DENOMN = length(unique(.data[[uniqid]]))) |> + summarise(DENOMN = n_distinct(across(any_of(uniqid)))) |> inner_join(counts, by = percgrp, multiple = "all") } # Calculate percentage as PCT and concatenate as CVALUE p <- ifelse(pctsyn == "N", "", "%") # nolint - df <- df |> mutate(PCT = round_f((FREQ * 100) / DENOMN, 2)) + df <- df |> + mutate( + PCT = (.data[["FREQ"]] * 100) / DENOMN, + CPCT = round_f(.data[["PCT"]], sigdec) + ) if (denomyn == "Y") { - df <- df |> mutate(CVALUE = glue("{FREQ}/{DENOMN} ({PCT}{p})")) + cstat <- "{FREQ}/{DENOMN} ({CPCT}{p})" } else { - df <- df |> mutate(CVALUE = glue("{FREQ} ({PCT}{p})")) + cstat <- "{FREQ} ({CPCT}{p})" } + df <- df |> + mutate(CVALUE = ifelse(FREQ == 0, "0", glue(cstat))) } return(df |> ungroup()) } diff --git a/R/mentry.R b/R/mentry.R index 58fe185..391675c 100644 --- a/R/mentry.R +++ b/R/mentry.R @@ -12,7 +12,7 @@ # See the License for the specific language governing permissions and # limitations under the License. # -#' Function to read in and process data with subsets and variables. +#' Read and process data with subsets and variables #' #' @description #' @@ -33,6 +33,8 @@ #' @param trttotalyn Add total treatment values to be displayed as column in #' table or category in plot (`"Y"/"N"`). #' @param trttotlabel Label for total Treatment column/group +#' @param trtmissyn Retain Missing treatment counts in Total (if `trttotalyn` = Y). Missing +#' treatment will not be considered as a column in analysis in any case. #' @param sgtotalyn Add total subgroup values to be displayed as column in #' table or category in plot (`"Y"/"N"`). #' @param add_grpmiss Add row or column for missing category in grouping @@ -99,10 +101,13 @@ mentry <- function(datain, trtsort = NA, trttotalyn = "N", trttotlabel = "Total", + trtmissyn = "N", sgtotalyn = "N", add_grpmiss = "N", pop_fil = "Overall Population") { - stopifnot(is.data.frame(datain), nrow(datain) > 0) + if (!is.data.frame(datain) || nrow(datain) == 0) { + return(data.frame()) + } byvarlist <- sep_var_order(byvar) byvar <- byvarlist[["vars"]] sgvarlist <- sep_var_order(subgrpvar) @@ -147,7 +152,7 @@ mentry <- function(datain, ## TRTVARs if (!is.na(trtvar) && str_squish(trtvar) != "") { dsin <- dsin |> - create_trtvar(trtvar, trtsort, trttotalyn, trttotlabel) + create_trtvar(trtvar, trtsort, trttotalyn, trttotlabel, trtmissyn) } # Remove invalid Treatment Values if ("TRTVAR" %in% names(dsin)) { @@ -157,7 +162,9 @@ mentry <- function(datain, "SCREEN FAILURE", "SCRNFAIL", "NOTRT", - "NOTASSGN" + "NOTASSGN", + "", + NA_character_ ) )) } @@ -213,15 +220,21 @@ create_grpvars <- function(dsin, vars, varN, new_var = "BYVAR", totalyn = "N", t #' @param trtvar Treatment Variable #' @param trtsort Treatment Sorting variable #' @param trttotalyn Display treatment total (`Y/N`) +#' @param trtmissyn Retain Missing treatment counts in Total (if `trttotalyn` = Y) #' #' @return Data frame with added `TRT` variables #' @noRd -create_trtvar <- function(dsin, trtvar, trtsort, trttotalyn, trttotlabel = "Total") { +create_trtvar <- function(dsin, trtvar, trtsort, trttotalyn, trttotlabel = "Total", trtmissyn) { map <- c(trt = "TRTVAR", sort = "TRTSORT") df <- dsin |> mutate(!!unname(map["trt"]) := .data[[trtvar]]) - + # keep missing treatments in total if trtmissyn is given (always removed in post) + if (trtmissyn != "Y") { + df <- df |> + filter(!(.data[["TRTVAR"]] %in% c("", NA_character_))) + } + # Create trt sorting variable if (is.na(trtsort) || str_squish(trtsort) == "") { trtsort <- trtvar } diff --git a/R/mod_generic_filters.R b/R/mod_generic_filters.R index 83517e2..feeba97 100644 --- a/R/mod_generic_filters.R +++ b/R/mod_generic_filters.R @@ -76,6 +76,18 @@ mod_generic_filters_ui <- function(id) { selected = "N", inline = TRUE ) + ), + fluidRow( + column( + width = 4, + tagAppendAttributes( + actionButton( + inputId = ns("apply_gen_filt"), + label = "Apply" + ), + class = "sidebar-btn" + ) + ) ) ) ), @@ -128,10 +140,6 @@ mod_generic_filters_ui <- function(id) { selected = c("Body System or Organ Class (AEBODSYS)" = "AEBODSYS") ) ), - column( - width = 3, - uiOutput(ns("ae_catvar_UI")) - ), column( width = 3, selectInput( @@ -149,6 +157,10 @@ mod_generic_filters_ui <- function(id) { choices = c("Participants" = "Patients", "Events" = "Events") ) ), + column( + width = 3, + uiOutput(ns("ae_catvar_UI")) + ), column( width = 3, selectInput( @@ -342,7 +354,7 @@ mod_generic_filters_ui <- function(id) { textInput( ns("statvar"), label = "Statistics", - value = "N~Range~Meansd~Median~q1q3" + value = "N~minmaxc~mean(sd)~Median~q1q3" ) ), column( @@ -350,7 +362,7 @@ mod_generic_filters_ui <- function(id) { textInput( ns("statlabel"), label = "Statistics Labels", - value = "N~Range~Mean (SD)~Median~(Q1, Q3)" + value = "N~(Min,Max)~Mean (SD)~Median~(Q1,Q3)" ) ) ) @@ -403,10 +415,8 @@ mod_generic_filters_server <- req(repName()) if (repName() == "eDISH_plot") { text <- "PARAMCD %in% c('ALT', 'AST', 'BILI')" - hide("box_3") } else { text <- "USUBJID != ''" - show("box_3") } updateTextInput( session, @@ -432,7 +442,8 @@ mod_generic_filters_server <- } else { hide("box_2") } - if (repName() %in% c("ae_forest_plot", "ae_volcano_plot", "adae_risk_summary")) { + if (repName() %in% + c("ae_forest_plot", "ae_volcano_plot", "adae_risk_summary", "tornado_plot")) { show("box_3") } else { hide("box_3") @@ -463,20 +474,26 @@ mod_generic_filters_server <- if (repName() == "Event Analysis") { show("ref_line") - hide("summary_by") hide("cutoff") + updateSelectInput( + session, + "summary_by", + choices = c("Events" = "Events", "Participants" = "Patients") + ) } else { hide("ref_line") - show("summary_by") show("cutoff") } if (repName() == "tornado_plot") { - hide("ui_llt") - hide("ae_llt") + hide("ui_hlt") + hide("ae_hlt") hide("summary_by") + hide("cutoff") + hide("statistics") + hide("alpha") } else { - show("ui_hlt") + show("ui_llt") show("treatment1") show("treatment2") show("treatment1_label") @@ -523,6 +540,7 @@ mod_generic_filters_server <- req(repName()) req(repType()) req(input$ae_filter) + req(input$a_subset) if (tolower(domain()) == "adae") { print("AE preprocessing start") ### calling Pre Processing AE data @@ -533,7 +551,8 @@ mod_generic_filters_server <- app_sys("extdata"), "/FMQ_Consolidated_List.csv" )), ae_filter = input$ae_filter, - obs_residual = ifelse(input$period == "Other", input$period_spec, NA) + obs_residual = ifelse(input$period == "Other", input$period_spec, NA), + subset = input$a_subset ), message = "Executing pre processing for AE...", min = 0, @@ -616,7 +635,7 @@ mod_generic_filters_server <- }) |> bindEvent( list( - repName(), input$overall_subset, input$trttotalyn, trt_var(), + repName(), input$apply_gen_filt, trt_var(), trt_sort(), popfilter(), input$ae_hlt, input$byvar, input$subgrp, input$subtotyn ) ) @@ -657,7 +676,7 @@ mod_generic_filters_server <- output$treatment1_label_UI <- renderUI({ req(tolower(repName()) %in% c("tornado_plot", "ae_volcano_plot")) textInput(ns("treatment1_label"), - if (repName() == "tornado_plot") "Treatment Left Label" else "Label for Control Group", + if (repName() == "tornado_plot") "Treatment Left Label" else "Label for Control Group", # nolint value = if (repName() == "tornado_plot") input$treatment1 else "Control" ) }) @@ -665,7 +684,7 @@ mod_generic_filters_server <- output$treatment2_label_UI <- renderUI({ req(tolower(repName()) %in% c("tornado_plot", "ae_volcano_plot")) textInput(ns("treatment2_label"), - if (repName() == "tornado_plot") "Treatment Right Label" else "Label for Treatment Group", + if (repName() == "tornado_plot") "Treatment Right Label" else "Label for Treatment Group", # nolint value = if (repName() == "tornado_plot") input$treatment2 else "Treatment" ) }) @@ -718,7 +737,7 @@ mod_generic_filters_server <- }) updateSelectInput( session, - "ae_hlt", + "ae_llt", selected = c("Primary System Organ Class (AESOC)" = "AESOC") ) } @@ -840,7 +859,7 @@ mod_generic_filters_server <- }) |> bindEvent(list( repName(), rv$ment_out, input$dptvar, input$statvar, input$pctdisp_adsl, - input$totcat, input$misscat, input$a_subset + input$totcat, input$misscat, input$apply_gen_filt )) observe({ @@ -856,12 +875,16 @@ mod_generic_filters_server <- req(input$treatment1) req(input$treatment2) req(input$trtbign) - req(input$ae_hlt) + req(input$ae_llt) if (tolower(repName()) %in% c("tornado_plot")) { print("AE Tornado plot pre-processing start") data <- sourcedata()[[domain()]] - + if (!is.null(sourcedata()[["ADSL"]])) { + data_adsl <- sourcedata()[["ADSL"]] + } else { + data_adsl <- NULL + } ae_catvarN <- paste0(input$ae_catvar, "N") if (!(ae_catvarN %in% colnames(data))) { data <- data |> @@ -872,7 +895,7 @@ mod_generic_filters_server <- mutate(SUBJID := .data[["USUBJID"]]) rv$process_tornado_data <- process_tornado_data( - dataset_adsl = NULL, + dataset_adsl = data_adsl, dataset_analysis = data, adsl_subset = "", analysis_subset = input$a_subset, @@ -891,7 +914,7 @@ mod_generic_filters_server <- pctdisp = "TRT", denom_subset = NA, legendbign = input$trtbign, - yvar = input$ae_hlt + yvar = input$ae_llt ) print("AE Tornado plot pre-processing end") @@ -900,8 +923,8 @@ mod_generic_filters_server <- bindEvent(list( repName(), trt_var(), trt_sort(), popfilter(), input$ae_filter, input$ae_catvar, input$period, input$period_spec, - input$treatment1, input$treatment2, input$pctdisp, input$denom_subset, - input$trtbign, input$ae_hlt + input$treatment1, input$treatment2, input$pctdisp, input$apply_gen_filt, + input$ae_hlt )) observe({ @@ -941,7 +964,7 @@ mod_generic_filters_server <- print("Edish process ends") }) %>% bindEvent(list( - trt_var(), trt_sort(), popfilter(), input$a_subset, input$overall_subset + trt_var(), trt_sort(), popfilter(), input$apply_gen_filt )) filters <- reactive({ @@ -954,7 +977,7 @@ mod_generic_filters_server <- req(input$statistics) req(input$alpha) } - if (repName() == "ae_volcano_plot") { + if (repName() %in% c("tornado_plot", "ae_volcano_plot")) { req(input$treatment1) req(input$treatment2) req(input$treatment1_label) diff --git a/R/mod_goutput.R b/R/mod_goutput.R index 12038cc..d2e6ab2 100644 --- a/R/mod_goutput.R +++ b/R/mod_goutput.R @@ -119,17 +119,10 @@ mod_goutput_server <- function(id, sourcedata, repName, filters, process_btn) { req(filters()$alpha) req(filters()$cutoff) print("AE risk_stat process start") - if (filters()$a_subset == "") { - a_subset <- filters()$ae_pre$a_subset - } else { - a_subset <- paste(na.omit( - c(filters()$ae_pre$a_subset, filters()$a_subset) - ), collapse = " & ") - } withProgress( rv$outdata <- risk_stat( datain = filters()$ment_out, - a_subset = a_subset, + a_subset = filters()$ae_pre$a_subset, eventvar = ifelse(is.null(filters()$ae_llt), filters()$ae_hlt, filters()$ae_llt), summary_by = filters()$summary_by, ctrlgrp = ifelse(tolower(repName()) == "ae_volcano_plot", @@ -143,7 +136,7 @@ mod_goutput_server <- function(id, sourcedata, repName, filters, process_btn) { ), statistics = filters()$statistics, alpha = filters()$alpha, - cutoff = filters()$cutoff, + cutoff_where = paste0("PCT > ", filters()$cutoff), sort_opt = ifelse(tolower(repName()) == "ae_forest_plot", filters()$sort_opt, "Ascending" ), @@ -155,9 +148,6 @@ mod_goutput_server <- function(id, sourcedata, repName, filters, process_btn) { max = 1, value = 1 ) - rv$outdata <- rv$outdata |> - filter(!is.nan(.data[["RISK"]]), !is.infinite(.data[["RISK"]])) |> - mutate(key = dplyr::row_number()) print("AE risk_stat process end") rv$output_trigger <- rv$output_trigger + 1 }) %>% @@ -182,7 +172,8 @@ mod_goutput_server <- function(id, sourcedata, repName, filters, process_btn) { datain = forest_data, series_opts = plot_aes_opts( datain = forest_data, - series_color = c("black", "royalblue2", "goldenrod", "forestgreen", "magenta", "brown"), + series_color = + c("black", "royalblue2", "goldenrod", "forestgreen", "magenta", "brown"), series_size = rep(1, 5) ), trtpair_color = "#F8766D~#7CAE00~#00BFC4~#C77CFF", @@ -462,18 +453,11 @@ mod_goutput_server <- function(id, sourcedata, repName, filters, process_btn) { } req(filters()$summary_by) print("AE event analysis process start") - if (filters()$a_subset == "") { - a_subset <- filters()$ae_pre$a_subset - } else { - a_subset <- paste(na.omit( - c(filters()$ae_pre$a_subset, filters()$a_subset) - ), collapse = " & ") - } withProgress(message = "Generating AE event analysis", value = 0, { rv$outdata <- try( process_event_analysis( datain = filters()$ment_out, - a_subset = a_subset, + a_subset = filters()$ae_pre$a_subset, summary_by = filters()$summary_by, hterm = filters()$ae_hlt, ht_val = input$hlt_val, @@ -511,7 +495,7 @@ mod_goutput_server <- function(id, sourcedata, repName, filters, process_btn) { if (event$curveNumber == 0 && event$x > 0) { test <- NULL } else { - test <- rv$goutput$rpt_data + test <- rv$outdata$query_df trt_level_diff <- length(levels(test$TRTVAR)) - length(unique(test$TRTVAR)) test <- test %>% mutate(point_n = as.numeric(as.factor(TRTVAR)) - trt_level_diff) @@ -524,14 +508,16 @@ mod_goutput_server <- function(id, sourcedata, repName, filters, process_btn) { req(test) - display <- filters()$ment_out %>% + display <- filters()$ment_out |> + mutate(TRTVAR = as.character(TRTVAR)) |> select(any_of(c( "USUBJID", "TRTVAR", "BYVAR1", filters()$ae_llt, "AESER", "AEOUT", "AESEV", "AESTDT", "ASTTM", "AEENDT", "TRTSTDT", "TRTEDT", "TRTEMFL" ))) - plot_table <- select(test, "BYVAR1", "DPTVAL", "TRTVAR") %>% - rename(!!filters()$ae_llt := "DPTVAL") %>% - inner_join(display) %>% + plot_table <- select(test, "BYVAR1", "DPTVAL", "TRTVAR") |> + mutate(TRTVAR = gsub("\n", " ", as.character(TRTVAR))) |> + rename(!!filters()$ae_llt := "DPTVAL") |> + inner_join(display) |> relocate(c("USUBJID", "TRTVAR")) ## displaying the listing table @@ -562,7 +548,6 @@ mod_goutput_server <- function(id, sourcedata, repName, filters, process_btn) { output$figure_UI <- plotly::renderPlotly({ req(rv$goutput) - # req(rv$goutput$ptly) rv$goutput }) diff --git a/R/mod_toutput.R b/R/mod_toutput.R index e4c01c6..0ddf3d4 100644 --- a/R/mod_toutput.R +++ b/R/mod_toutput.R @@ -69,13 +69,6 @@ mod_toutput_server <- function(id, repName, filters, popfilter, process_btn) { req(filters()$sort_opt) req(filters()$sort_by) print("ADAE table process start") - if (filters()$a_subset == "") { - a_subset <- filters()$ae_pre$a_subset - } else { - a_subset <- paste(na.omit( - c(filters()$ae_pre$a_subset, filters()$a_subset) - ), collapse = " & ") - } # Title and Footnote rv$title <- paste0( "Participants With ", filters()$ae_filter, @@ -98,7 +91,7 @@ mod_toutput_server <- function(id, repName, filters, popfilter, process_btn) { rv$outdata <- try( adae_risk_summary( filters()$ment_out, - a_subset = a_subset, + a_subset = filters()$ae_pre$a_subset, summary_by = filters()$summary_by, hterm = filters()$ae_hlt, lterm = filters()$ae_llt, @@ -106,12 +99,12 @@ mod_toutput_server <- function(id, repName, filters, popfilter, process_btn) { trtgrp = filters()$treatment2, statistics = filters()$statistics, alpha = filters()$alpha, - cutoff = filters()$cutoff, + cutoff_where = paste0("PCT > ", filters()$cutoff), sort_opt = filters()$sort_opt, sort_var = filters()$sort_by ) ) - keepvars <- c("Risk Ratio (CI)", "P-value") + keepvars <- c(paste(filters()$statistics, "(CI)"), "P-value") rv$footnote <- paste0( rv$footnote, "\n", filters()$statistics, " is shown between ", filters()$treatment1, " and ", filters()$treatment2 @@ -123,12 +116,12 @@ mod_toutput_server <- function(id, repName, filters, popfilter, process_btn) { rv$outdata <- try( occ_tier_summary( filters()$ment_out, - a_subset = a_subset, + a_subset = filters()$ae_pre$a_subset, summary_by = filters()$summary_by, hterm = filters()$ae_hlt, lterm = filters()$ae_llt, pctdisp = filters()$ui_pctdisp, - cutoff = filters()$cutoff, + cutoff_where = paste0("PCT > ", filters()$cutoff), apply_hrow_cutoff = "N", sort_opt = filters()$sort_opt, sort_var = filters()$sort_by diff --git a/R/msumstat.R b/R/msumstat.R index 3432d28..aaab885 100644 --- a/R/msumstat.R +++ b/R/msumstat.R @@ -19,17 +19,18 @@ #' @param a_subset Analysis subset condition specific to this function. #' @param statvar `Tilde` (`~`)-separated list of statistics to be computed. eg: `"mean~median"` #' @param sigdec Number of base decimal places to retain in output -#' Applies to mean, min, max etc and `+ 1` for sd +#' Applies to mean, min, max, sd etc #' @param dptvarn Number to assign as `'DPTVARN'`, used for block sorting when #' multiple blocks are created to be combined. +#' @param sparsebyvalyn Sparse missing categories within by groups. `"Y"/"N"` +#' @param figyn Determine if output is for figure or not `"Y"/"N"` #' #' @details Current available statistics (values for `statvar`) : #' n (count per group), mean, median, sd (standard deviation), min, max, #' iqr (interquartile range), var (variance), sum, range ("min, max") -#' meansd ("mean (sd)"), medianrange ("median (range)"), -#' q25/q1 (25 % quantile), q75/q3 (75 % quantile) , p10 (10% quantile), p5, p1, -#' p90, p95, p99, q1q3 ("q25, q75"), whiskerlow, whiskerup (box lower/upper -#' whiskers), outliers (boxplot outliers, tilde-separated output), +#' mean(sd), median(minmax), q25/q1 (25 % quantile), q75/q3 (75 % quantile) , p10 (10% quantile), +#' p5, p1, p90, p95, p99, q1q3 ("q25, q75"), whiskerlow, whiskerup (box lower/upper +#' whiskers), outliers (boxplot outliers, tilde-separated output), geometric mean/sd/CI #' box = median~q25~q75~whiskerlow~whiskerup~outliers (Tukey's method) #' #' @return a list containing 2 elements @@ -54,9 +55,10 @@ #' adsl_sum <- adsl_entry |> #' msumstat( #' dptvar = "AGE", -#' a_subset = "BYVAR1 == 'M'", -#' statvar = "mean", -#' sigdec = 2 +#' a_subset = "SEX == 'F'", +#' statvar = "mean(sd)~median(minmaxc)~q3", +#' sigdec = "3(2)~2(0)~1", +#' sparsebyvalyn = "N" #' ) #' #' adsl_sum$tsum @@ -66,52 +68,95 @@ msumstat <- function(datain = NULL, a_subset = NA_character_, dptvar = NULL, statvar = "", - sigdec = 1, - dptvarn = 1) { + sigdec = "", + dptvarn = 1, + sparsebyvalyn = "N", + figyn = "N") { # Check if data is present - stopifnot("No data to analyze" = nrow(datain) != 0) + if (nrow(datain) == 0) { + return(datain) + } # Check that dependent variable exists and convert it to numeric stopifnot("Dependent Variable does not Exist" = dptvar %in% names(datain)) if (!is.numeric(datain[[dptvar]])) { datain <- datain |> mutate(across(all_of(dptvar), ~ as.numeric(.))) } - datain <- datain |> filter(!is.na(.data[[dptvar]])) # IF analysis subset is given: if (!is.na(a_subset) && str_squish(a_subset) != "") { - datain <- datain |> filter(eval(parse(text = a_subset))) + datapro <- datain |> filter(eval(parse(text = a_subset))) + # Check data exists after subset: + if (nrow(datapro) == 0) { + return(datapro) + } + } else { + datapro <- datain } + # Available and customized statistics if (is.null(statvar) || all(statvar == "")) { statinput <- c("n", "mean", "min", "median", "max", "sd") - } else { + } else if (any(str_detect(statvar, "box"))) { # custom statistics given as input statinput <- statvar |> str_replace("box", "median~q25~q75~whiskerlow~whiskerup~outliers") |> str_to_vec() + } else { + statinput <- str_to_vec(statvar) } - # Define basic statistics to be printed in the output. - # Creates summary stats functions: - statinput <- recode( - tolower(statinput), - q1 = "q25", q3 = "q75" + sigdec <- str_to_vec(sigdec) + # Resolve concatenated statisitcs into simpler ones + baselist <- parse_stats(tolower(statinput), sigdec) + # Get list of basic functions from summary_functions() + list_stats <- summary_functions(names(baselist), unname(baselist)) + # Stat grouping vars: + countgrp <- c( + grep("BYVAR", names(datapro), value = TRUE), "TRTVAR", + grep("SUBGRPVAR", names(datapro), value = TRUE) ) - # Get list of functions from summary_functions() - list_stats <- summary_functions(sigdec) - # Check that input stat functions exist - stopifnot("Statistics not in summary_functions()" = all(statinput %in% names(list_stats))) - list_stats <- list_stats[statinput] # Bring two variables for name and values of category and perform analyses - data_wide <- datain |> - select(any_of(c(dptvar, "TRTVAR")), starts_with(c("BYVAR", "SUBGRP"))) |> - group_by(across(any_of(starts_with(c("BYVAR", "TRTVAR", "SUBGRP"))))) |> - summarise(across(all_of(dptvar), list_stats, .names = "{.fn}")) |> - mutate(across(where(is.character), ~ replace(., is.na(.), "-"))) |> - mutate(DPTVAR = dptvar, CN = "N", DPTVARN = dptvarn) |> - ungroup() - + data_wide <- datapro |> + select(any_of(c(dptvar, countgrp))) |> + group_by(across(any_of(countgrp))) |> + summarise(across(all_of(dptvar), list_stats, .names = "{tolower(.fn)}")) |> + ungroup() |> + mutate(across(any_of(names(baselist)), ~ ifelse(.x %in% c("Inf", "-Inf"), NA, .x))) + # If required, sparse empty by groups: + # Note this only works if by variables exist and for tables: + BYVAR <- var_start(data_wide, "BYVAR") + BYVARN <- var_start(data_wide, "BYVARN") + if (length(BYVAR) > 0 && figyn != "Y") { + if (sparsebyvalyn == "Y") { + data_sparse <- datain + } else { + data_sparse <- data_wide |> group_by(across(starts_with("BYVAR"))) + BYVAR <- character(0) + BYVARN <- character(0) + } + data_wide <- data_wide |> + sparse_vals( + data_sparse = data_sparse, + sparseyn = "N", + sparsebyvalyn = "Y", + BYVAR, + var_start(data_wide, "SUBGRP"), + BYVARN, + var_start(data_wide, "SUBGRPN"), + fillvar = colnames(data_wide)[!colnames(data_wide) %in% countgrp], + fill_with = "-" + ) + } + data_wide <- data_wide |> + derv_stats(statinput) |> + select(any_of(c(countgrp, tolower(statinput)))) |> + mutate(DPTVAR = dptvar, CN = "N", DPTVARN = dptvarn) + # Post-sparsing, n/miss/obs should be 0 and not - + if (any(c("n", "nmiss", "nobs") %in% names(data_wide))) { + data_wide <- data_wide |> + mutate(across(any_of(c("n", "nmiss", "nobs")), ~ gsub("^-$", "0", .x))) + } # Tidy into long dataframe for use in tabular display data_long <- data_wide |> - pivot_longer(all_of(statinput), + pivot_longer(all_of(tolower(statinput)), names_to = "DPTVAL", values_to = "CVALUE" ) |> diff --git a/R/multi_interval.R b/R/multi_interval.R index fae4d96..3ed9031 100644 --- a/R/multi_interval.R +++ b/R/multi_interval.R @@ -28,7 +28,6 @@ #' @export #' #' @examples -#' library(carver) #' data(adae) #' data(cm) #' multi_interval( diff --git a/R/occ_tier_summary.R b/R/occ_tier_summary.R index 383719c..2f6114f 100644 --- a/R/occ_tier_summary.R +++ b/R/occ_tier_summary.R @@ -11,27 +11,67 @@ # WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. # See the License for the specific language governing permissions and # limitations under the License. +# #' Generic Occurrence Summary Tiered Table #' #' @inheritParams risk_stat #' @param datain Input dataset (generally the output from `mentry()`) -#' @param hterm High Level Event term variable, used for analysis +#' @param hterm High Level Event term variable, used for analysis (tilde-separated) #' @param lterm Low Level Event term variable, used for analysis +#' @param htermctyn To show count of high term rows or not. Should correspond to and be same number +#' of terms passed in `hterm` (tilde-separated). To suppress showing counts for any term pass "N" #' @param pctdisp Method to calculate denominator (for %) by. #' Possible values: `"TRT"`, `"VAR"`, `"COL"`, `"SUBGRP"`, `"CAT"`, `"NONE"`, `"NO"`, `"DPTVAR"`, #' `"BYVARxyN"` -#' @param apply_hrow_cutoff To apply cutoff value to high terms in addition to low term. +#' @param sum_row To show summary/any term row or not. 'Y'/'N' +#' @param sum_row_label Label for Summary Row to be displayed, if Y. +#' @param apply_hrow_cutoff To apply `cutoff_where` value to high terms in addition to low term. #' If set to "Y" same cutoff is applied to remove both high and low level terms that don't meet #' the criteria. #' If set to "N" (default), cutoff is applied only to Lower Level term. The terms that do not fit #' the criteria are then excluded from the counts for High Level term. This does not happen in case -#' of "N" - all counts are included in high term which is displayed as long as it meets the criteria -#' as well. +#' of "N" - all low terms are included in high term which is displayed as long as it meets the +#' criteria as well. +#' @param sort_col Which treatment column to sort by. (Depends on trt levels) eg: 1, 2, 3 +#' @param nolwrtierdispyn When`apply_hrow_cutoff` = Y, to display high level terms with zero low +#' level terms satisfying the cutoff threshold or not? If Y, high terms will be displayed even with +#' no corresponding lower levels in the table. +#' @param sigdec_cat Number of decimal places for % displayed in output +#' @param pctsyn Display Percentage Sign in table or not. Values: `"Y"/"N"` +#' @param stathead Label for sub-column header in output. eg. "n (%)" +#' +#' @details +#' \itemize{ +#' \item `cutoff_where` is applied to event lower term only, unless `apply_hrow_cutoff` is given. +#' \item If `apply_hrow_cutoff` is Y, cutoff_where is applied to higher terms as well. If it is N, +#' lower terms which do not meet criteria are removed from higher term count. eg: if `cutoff_where` +#' is set to "PCT >= 2" and `hterm` and `lterm` are AEBODSYS and AEDECOD: +#' +#' EYE DISORDERS 9 (3.1) +#' Dry eye 3 (1.4) +#' Wet eye 6 (2.4) +#' +#' Here if `apply_hrow_cutoff` is set to N then 'Dry eye' row will be excluded and the 3 excluded +#' from count of EYE DISORDERS as well (9). If Y, then 'Dry eye' will be excluded but EYE DISORDERS +#' not impacted as it is 4.4% and its PCT >= 2. +#' +#' \item If `cutoff_where` is PCT >= 3 and `nolwrtierdispyn` set to Y, then +#' neither Dry eye nor Wet eye will be shown, but EYE DISORDERS will still be displayed. +#' +#' If `nolwrtierdispyn` is N in this case, EYE DISORDERS will also be removed as no low terms meet +#' the criteria. +#' } #' #' @return Summarized data frame for Adverse Events based on high and lower terms. #' @export #' #' @examples +#' data("adae") +#' ae_pre_process <- ae_pre_processor( +#' datain = adae, +#' obs_residual = 0, +#' fmq_data = NA +#' ) #' ae_entry <- ae_pre_process[["data"]] |> #' mentry( #' subset = NA, @@ -50,7 +90,7 @@ #' hterm = "AEBODSYS", #' lterm = "AEDECOD", #' pctdisp = "TRT", -#' cutoff = 2, +#' cutoff_where = "PCT > 2", #' apply_hrow_cutoff = "N", #' sort_opt = "Ascending", #' sort_var = "Count" @@ -58,72 +98,207 @@ #' output |> #' tbl_processor() |> #' tbl_display() +#' # Example 2: ADAE table with max sev/ctc grade: +#' ae_pre <- ae_pre_processor( +#' adae, +#' subset = "TRTEMFL == 'Y'", +#' max_sevctc = "SEV", +#' sev_ctcvar = "AESEVN", +#' pt_total = "Y" +#' ) +#' ae_entry_max <- adsl_merge( +#' adsl, +#' adsl_subset = 'SAFFL == "Y"', +#' ae_pre[["data"]] +#' ) |> +#' mentry( +#' subset = NA, +#' byvar = "AEBODSYS", +#' trtvar = "TRTA", +#' trtsort = "TRTAN", +#' trttotalyn = "N", +#' add_grpmiss = "N", +#' subgrpvar = "AESEV", +#' sgtotalyn = "N", +#' pop_fil = "Overall Population" +#' ) +#' rpt_data <- occ_tier_summary( +#' ae_entry_max, +#' a_subset = ae_pre[["a_subset"]], +#' summary_by = "Patients", +#' hterm = "AEBODSYS", +#' lterm = "AEDECOD", +#' cutoff_where = "FREQ > 2", +#' pctdisp = "TRT", +#' sum_row = "Y", +#' sum_row_label = "Any Adverse Event", +#' nolwrtierdispyn = "N", +#' sort_opt = "Alphabetical", +#' stathead = "n (%)" +#' ) +#' rpt_data |> +#' tbl_processor() |> +#' tbl_display(dpthead = "No. of Adverse Events_SOC and PT") |> +#' flextable::autofit() +#' ## ADPR Example: +#' \dontrun{ +#' pr_entry <- adsl |> +#' adsl_merge( +#' adsl_subset = "SAFFL == 'Y'", +#' dataset_add = adpr +#' ) |> +#' mentry( +#' subset = NA, +#' byvar = "PRSOC", +#' trtvar = "TRT01A", +#' trtsort = "TRT01AN", +#' trttotalyn = "N", +#' add_grpmiss = "N", +#' sgtotalyn = "N", +#' pop_fil = "Overall Population" +#' ) +#' output <- occ_tier_summary( +#' pr_entry, +#' a_subset = "ONPERFL == 'Y' & PRDECOD != ''", +#' summary_by = "Patients", +#' hterm = "PRSOC", +#' lterm = "PRDECOD", +#' pctdisp = "TRT", +#' apply_hrow_cutoff = "N", +#' sort_opt = "Ascending", +#' sort_var = "Count", +#' sum_row = "Y", +#' sum_row_label = "Participants with 1 term", +#' htermctyn = "N" +#' ) +#' output |> +#' display_bign_head( +#' mentry_data = pr_entry +#' ) |> +#' tbl_processor() |> +#' tbl_display() +#' } #' occ_tier_summary <- function(datain, a_subset = NA_character_, summary_by = "Patients", hterm = "AEBODSYS", lterm = "AEDECOD", + htermctyn = "Y", pctdisp = "TRT", - cutoff = 2, + cutoff_where = NA, + sum_row = "N", + sum_row_label = "Number of Participants with Any AE", apply_hrow_cutoff = "N", sort_opt = "Ascending", - sort_var = "Count") { - stopifnot("Input data is empty" = nrow(datain) > 0) - stopifnot("Invalid method to set denominator percentage" = pctdisp %in% c("TRT", "HT", "VAR")) + sort_var = "Count", + sort_col = 1, + nolwrtierdispyn = "N", + sigdec_cat = 2, + pctsyn = "Y", + stathead = "n (%)") { + if (nrow(datain) == 0) { + return(datain) + } stopifnot( "`byvar` in `mentry()` cannot be `NA` or ''" = identical(var_start(datain, "BYVAR"), "BYVAR1") ) - stopifnot( - "`byvar` in `mentry()` should be identical to `hterm` in `occurrence_summary()" = - identical(unique(datain[["BYVAR1"]]), unique(datain[[hterm]])) - ) - rows <- c(var_start(datain, "BYVAR"), "DPTVAL") + byvars <- var_start(datain, "BYVAR") + rows <- c(byvars, "DPTVAL") # Lowest Term Calculation lcat <- mcatstat( datain = datain, a_subset = a_subset, uniqid = ifelse(summary_by == "Events", "ALLCT", "USUBJID"), dptvar = lterm, - pctdisp = pctdisp - ) |> - mutate(across(all_of(c("FREQ", "PCT")), \(x) as.double(x))) + pctdisp = pctdisp, + sigdec = sigdec_cat, + pctsyn = pctsyn, + sparseyn = "N" + ) + if (!is.data.frame(lcat) || nrow(lcat) == 0) { + return(data.frame()) + } # Applying Cutoff to lower level term counts/pct - if (!cutoff %in% c("", NA, 0)) { - lcat_cut <- lcat |> filter(.data[["PCT"]] > as.numeric(cutoff)) + if (!is.na(cutoff_where) && str_detect(cutoff_where, "PCT|FREQ")) { + lcat_cut <- lcat |> + filter(!!!parse_exprs(cutoff_where)) |> + select(all_of(rows)) |> + mutate(CUTFL = "Y") lcat <- lcat |> semi_join(lcat_cut, by = rows) if (nrow(lcat) < 1) { - return(data.frame("Note" = "No low term data available under these conditions")) + return(data.frame()) } # Rows under cutoff to be excluded from higher level term counts if (apply_hrow_cutoff != "Y") { datain <- datain |> - semi_join(rename(lcat_cut, !!lterm := DPTVAL), by = gsub("DPTVAL", lterm, rows)) + left_join(rename(lcat_cut, !!lterm := DPTVAL), by = gsub("DPTVAL", lterm, rows)) + a_subset <- paste(na.omit(c(a_subset, "CUTFL == 'Y'")), collapse = "&") + if (nolwrtierdispyn == "N") { + datain <- semi_join(datain, lcat_cut, by = byvars[length(byvars)]) + } + } else { + if (nolwrtierdispyn == "N") { + datain <- datain |> + left_join(lcat_cut |> select(-all_of("DPTVAL")), by = byvars[length(byvars)]) + a_subset <- paste(na.omit(c(a_subset, "CUTFL == 'Y'")), collapse = "&") + } } } - + hterm <- str_to_vec(hterm) # Higher Terms calculation: hcat <- map(hterm, \(h_term) { h <- mcatstat( datain = datain, - a_subset = a_subset, + a_subset = ifelse("HT_FL" %in% names(datain), "HT_FL == 1", a_subset), uniqid = ifelse(summary_by == "Events", "ALLCT", "USUBJID"), dptvar = h_term, - pctdisp = pctdisp - ) |> - mutate(across(all_of(c("FREQ", "PCT")), \(x) as.double(x))) + pctdisp = pctdisp, + sigdec = sigdec_cat, + pctsyn = pctsyn, + sparseyn = "N" + ) # Apply CUTOFF based on parameter and lower term value - if (!cutoff %in% c("", NA, 0) && apply_hrow_cutoff == "Y") { + if (!is.na(cutoff_where) && str_detect(cutoff_where, "PCT|FREQ") && apply_hrow_cutoff == "Y") { h <- h |> - semi_join(h |> filter(.data[["PCT"]] > as.numeric(cutoff)), by = rows) + semi_join(h |> filter(!!!parse_exprs(cutoff_where)), by = rows) if (nrow(h) < 1) { - return(data.frame("Note" = "No high term data available under these conditions")) + return(data.frame()) } } h }) + + # Summary/Any Row Output + if (sum_row != "N") { + sum_data <- summary_row_cat( + datain, + sum_row_label, + byvaryn = "N", + a_subset, + pctdisp, + sigdec_cat, + pctsyn, + "ANY" + ) + } else { + sum_data <- NULL + } + + if ("PT_CNT" %in% names(datain)) { + pt_data <- datain |> + summary_row_cat( + a_subset = a_subset, + var = "PT_CNT", + pctdisp = "NONE", + sum_row_label = "Total preferred term events", + uniqid = c("AEDECOD", "USUBJID") + ) + } else { + pt_data <- NULL + } ### Combined Processing for lower and higher terms # Sort Values and Options if (sort_opt == "Alphabetical") { @@ -131,11 +306,11 @@ occ_tier_summary <- function(datain, } else { sort_var <- get_sort_var(sort_var) } - ctrlgrp <- get_ctrlgrp(datain) + ctrlgrp <- get_ctrlgrp(datain, sort_col) comb <- append(hcat, list(lcat)) # Mapping over each categorical dataset and applying post-processing function to concatenate # the dataframes into single output - map(seq_along(comb), \(i) { + outdata <- map(seq_along(comb), \(i) { xout <- comb[[i]] |> mutate( CTRL_N = ifelse(.data[["TRTVAR"]] == ctrlgrp, .data[["FREQ"]], NA), @@ -149,7 +324,22 @@ occ_tier_summary <- function(datain, xout |> ord_summ_df(sort_var, sort_opt) }) |> - post_occ_tier(ctrlgrp = ctrlgrp) + post_occ_tier(ctrlgrp = ctrlgrp, sum_row = sum_data, pt_row = pt_data, stathead = stathead) + + # To suppress any high term percentage counts, per variable htermctyn + if (any(str_to_vec(htermctyn) == "N")) { + htermctyn <- str_to_vec(htermctyn) + stopifnot(length(htermctyn) == length(hterm)) + blankterm <- hterm[which(htermctyn == "N")] + outdata <- outdata |> + mutate(CVALUE = ifelse( + toupper(.data[["DPTVAR"]]) %in% toupper(blankterm), + "", + .data[["CVALUE"]] + )) + } + outdata |> + mutate(DPTVAR = "TIER") } #' Prepare Occurrence summary for Tabular Display @@ -160,32 +350,49 @@ occ_tier_summary <- function(datain, #' @return Flextable object #' @noRd post_occ_tier <- - function(occ_summ, riskyn = "N", ctrlgrp, statistics = NULL) { + function(occ_summ, riskyn = "N", ctrlgrp, sum_row = NULL, risklabels = tbl_risk_labels(), + pt_row = NULL, stathead = "n (%)") { occ_summ <- occ_summ |> setNames(c("hterm_summ", "lterm_summ")) final_cts <- occ_summ |> bind_rows() |> select(-any_of(c("DPTVARN", "DPTVALN"))) |> - inner_join(ord_by_ht(occ_summ, ctrlgrp), by = c("BYVAR1", "DPTVAL")) |> - select(-any_of(c("BYVAR1", "BYVAR1N"))) |> - select(-starts_with("CTRL_")) |> + inner_join(ord_by_ht(occ_summ, ctrlgrp), by = c("DPTVAR", "BYVAR1", "DPTVAL")) |> + select(-any_of(c("BYVAR1", "BYVAR1N", "CUTFL"))) |> + select(-starts_with("CTRL_")) + if (is.data.frame(sum_row) && nrow(sum_row) > 0) { + final_cts <- bind_rows(final_cts, sum_row |> mutate(DPTVARN = 0, DPTVALN = 0)) + } + if (is.data.frame(pt_row) && nrow(pt_row) > 0) { + final_cts <- bind_rows( + final_cts, pt_row |> mutate(DPTVALN = 0, DPTVARN = max(final_cts$DPTVARN, na.rm = TRUE) + 1) + ) + } + SUBGRPN <- var_start(final_cts, "SUBGRPN") + if (length(SUBGRPN) > 0) { + repvar <- SUBGRPN[length(SUBGRPN)] + } else { + repvar <- "TRTVAR" + } + final_cts <- final_cts |> mutate( DPTVAL = ifelse(.data[["DPTVALN"]] == 0, - .data[["DPTVAL"]], paste0("\t\t\t", str_to_title(.data[["DPTVAL"]])) + .data[["DPTVAL"]], paste0("\t\t\t", .data[["DPTVAL"]]) ), - DPTVAR = "TIER", - SUBGRPVARX = paste0("n (%)", strrep(" ", as.numeric(.data[["TRTVAR"]]))), + SUBGRPVARX = paste0(stathead, strrep(" ", as.numeric(as.factor(.data[[repvar]])))), SUBGRPVARXN = 1 ) - if (riskyn == "Y") { - # Rename variable containing RISK_CI based on type of statistic + # Rename variable containing RISK_CI based user inputs final_cts <- final_cts |> filter(!is.nan(.data[["RISK"]]), !is.infinite(.data[["RISK"]])) |> mutate( - !!paste0(statistics, " (CI)") := .data[["RISK_CI"]], - !!paste0("P-", "value") := .data[["PVALUE"]], - CVALUE = paste0(.data[["FREQ"]], " (", .data[["PCT"]], "%)") + !!risklabels$riskci := .data[["RISK_CI"]], + !!risklabels$risk := .data[["RISK"]], + !!risklabels$p := .data[["PVALUE"]], + !!risklabels$low := .data[["RISKCIL"]], + !!risklabels$up := .data[["RISKCIU"]], + !!risklabels$lowup := paste0("(", .data[["RISKCIL"]], ",", .data[["RISKCIU"]], ")") ) } final_cts @@ -212,7 +419,7 @@ ord_by_ht <- function(df, ctrlgrp) { map(names(df), \(x) { match_var <- recode(x, "hterm_summ" = "DPTVAL", "lterm_summ" = "BYVAR1") df_out <- df[[x]] |> - select(any_of(c("BYVAR1", "DPTVAL"))) |> + select(all_of(c("DPTVAR", "BYVAR1", "DPTVAL"))) |> distinct() |> mutate(DPTVARN = match(.data[[match_var]], uniqHT)) |> filter(!is.na(.data[["DPTVARN"]])) @@ -237,6 +444,57 @@ ord_by_ht <- function(df, ctrlgrp) { #' #' @return Name of control group #' @noRd -get_ctrlgrp <- function(df) { - levels(df[["TRTVAR"]])[1] +get_ctrlgrp <- function(df, col = 1) { + levels(df[["TRTVAR"]])[as.numeric(col)] +} + +#' Insert Overall/Summary Row +#' +#' @param datain Input dataset `ADAM` or intermediate within summary function +#' @param sum_row_label Label for Summary Row to be displayed, if Y. +#' @param byvaryn Include by variable or not? For single overally row, "N" +#' @param var Flag Variable to identify Any/Summary Rows +#' @inheritParams mcatstat +#' +#' @return dataframe with single overall row count +#' +#' @export +#' +#' @examples +#' data("adae") +#' summary_row_cat( +#' adae, +#' a_subset = "TRTEMFL == 'Y'" +#' ) +#' +summary_row_cat <- function(datain, + sum_row_label = "Any Term", + byvaryn = "N", + a_subset = NA, + pctdisp = "TRT", + sigdec = 2, + pctsyn = "Y", + var = "ANY", + uniqid = "USUBJID") { + if (nrow(datain) < 1) { + return(datain) + } + if (!(var %in% names(datain))) { + datain <- datain |> mutate(!!var := 1) + } + if (byvaryn == "N") { + byvar <- var_start(datain, "BYVAR") + datain <- datain |> + select(-starts_with(byvar[length(byvar)])) + } + datain |> + mcatstat( + a_subset = paste(na.omit(c(a_subset, glue("{var} == 1"))), collapse = "&"), + dptvar = var, + pctdisp = pctdisp, + uniqid = uniqid, + sigdec = sigdec, + pctsyn = pctsyn + ) |> + mutate(DPTVAL = sum_row_label) } diff --git a/R/process_vx_bar_plot.R b/R/process_vx_bar_plot.R deleted file mode 100644 index 005b5cf..0000000 --- a/R/process_vx_bar_plot.R +++ /dev/null @@ -1,125 +0,0 @@ -# Copyright 2024 Pfizer Inc -# -# Licensed under the Apache License, Version 2.0 (the "License"); -# you may not use this file except in compliance with the License. -# You may obtain a copy of the License at -# -# http://www.apache.org/licenses/LICENSE-2.0 -# -# Unless required by applicable law or agreed to in writing, software -# distributed under the License is distributed on an "AS IS" BASIS, -# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -# See the License for the specific language governing permissions and -# limitations under the License. -# -#' Pre-Process data for Bar Plot -#' -#' @param analysis_subset Subset conditions for analysis of dependent variable -#' Applicable only to numerator calculation for % -#' @param overall_subset Subset conditions for overall data. -#' @param denom_subset Subset condition to be applied to data set for -#' calculating denominator. -#' @param xvar Categorical Analysis variable for X axis -#' @param yvar Y axis variable/statistic. Possible Values: "FREQ"/"PCT" -#' @param pctdisp Method to calculate denominator (for %) by -#' Possible values: "TRT","VAR","COL","SUBGRP","CAT","NONE","NO","DPTVAR" -#' @inheritParams process_vx_scatter_data -#' -#' @details -#' \itemize{ -#' \item Subset Processing -#' Applying population subset selected -#' Applying denominator/overall subset condition passed by the user -#' Applying analysis/numerator subset condition passed by the user. -#' \item pctdisp has possible values for method to get denominator to calculate -#' percentage, passed to `mcatstat()`. The commonly passed value for vaccine -#' bar plot is: -#' DPTVAR: Percentage within each Treatment-By group(s)-Subgroup(s)-dptvar -#' combination. -#' } -#' @return mcatstat dataset as data frame. -#' @export -#' -#' @examples -#' data(vx_bar_data) -#' -#' process_vx_bar_plot( -#' dataset_adsl = vx_bar_data$adsl, -#' adsl_subset = "SAFFL=='Y'", -#' dataset_analysis = vx_bar_data$adfacevd, -#' analysis_subset = "ATPTN <= 14 & toupper(FAOBJ) == 'PAIN AT INJECTION SITE' & -#' !(AVAL %in% c(0, 0.5)) & FATESTCD != 'OCCUR' & !is.na(AVAL)", -#' denom_subset = "ATPTN <= 14 & toupper(FAOBJ) == 'PAIN AT INJECTION SITE' & -#' !(AVAL %in% c(0, 0.5))", -#' overall_subset = NA, -#' split_by = "SEX", -#' trtvar = "TRT01A", -#' trtsort = "TRT01AN", -#' xvar = "ATPTN", -#' yvar = "PCT", -#' pctdisp = "DPTVAR" -#' ) -#' -process_vx_bar_plot <- function(dataset_adsl, - adsl_subset = "SAFFL=='Y'", - dataset_analysis, - analysis_subset = NA_character_, - overall_subset = NA_character_, - denom_subset = NA_character_, - split_by = NA_character_, - trtvar = "TRT01A", - trtsort = "TRT01AN", - xvar = "ATPTN", - yvar = "PCT", - pctdisp = "DPTVAR", - legendbign = "Y") { - stopifnot(is.data.frame(dataset_adsl)) - stopifnot(is.data.frame(dataset_analysis)) - stopifnot(nrow(dataset_adsl) > 0) - stopifnot(nrow(dataset_analysis) > 0) - stopifnot(trtvar %in% toupper(names(dataset_adsl))) - stopifnot("AVAL" %in% toupper(names(dataset_analysis))) - - if (!is.na(split_by) && str_squish(split_by) != "") { - stopifnot(all(str_to_vec(split_by) %in% toupper(names(dataset_adsl)))) - } - - adsl_out <- adsl_merge( - dataset_adsl, - adsl_subset, - dataset_analysis - ) - - mentry_out <- mentry( - datain = adsl_out, - subset = overall_subset, - pop_fil = "Overall Population", - subgrpvar = str_remove_all(split_by, " "), - trtvar = trtvar, - trtsort = trtsort, - add_grpmiss = "N" - ) - - mcatstat_out <- mcatstat( - datain = mentry_out, - a_subset = analysis_subset, - denom_subset = denom_subset, - uniqid = "USUBJID", - dptvar = xvar, - pctdisp = pctdisp - ) |> - mutate( - YVAR = as.numeric(.data[[yvar]]), - XVAR = factor(XVAR, - levels = unique(XVAR[order(DPTVALN)]) - ) - ) - plotdata <- plot_title_nsubj( - mentry_out, - mcatstat_out, - var_start(mcatstat_out, "SUBGRP") - ) |> - plot_display_bign(mentry_out, bignyn = legendbign) - - return(plotdata) -} diff --git a/R/risk_stat.R b/R/risk_stat.R index cd26c0e..b4d5d83 100644 --- a/R/risk_stat.R +++ b/R/risk_stat.R @@ -14,10 +14,11 @@ # options(warn = -1) +options(warn = -1) + #' Calculate Risk Statistics for treatment pairs from pre-processed Adverse Events data #' -#' @param datain Input dataset after pre_processing and running `mentry()` to *ADAE* data -#' @param a_subset Analysis Subset condition specific to categorical analysis. +#' @inheritParams mcatstat #' @param summary_by Measure to construct the summary by. Values: `'Patients' or 'Events'`. #' @param eventvar Event Variable to review by. Example: `'AEDECOD', 'AEBODSYS'`. #' @param ctrlgrp Treatment Control value. @@ -25,13 +26,17 @@ options(warn = -1) #' for `forest_plot()`. #' @param statistics Statistic to be calculated. Values: `'Risk Ratio' or 'Risk Difference'`. #' @param alpha Alpha value to determine confidence interval for risk calculation. Default: `0.05` -#' @param cutoff Incidence Cutoff Value; consider only terms with `incidence percentage > cutoff`. +#' @param cutoff_where Filter condition for incidence/pct. Consider only terms with +#' eg: "FREQ > 5" or "PCT <3". Must contain FREQ or PCT (count or percent) #' @param sort_opt How to sort terms, only for table/forest plot. #' Values: `'Ascending','Descending','Alphabetical'`. #' @param sort_var Metric to sort by. Values: `'Count','Percent','RiskValue'`. #' @param g_sort_by_ht For Forest Plot only - include sorting by high term/*BYVAR1*? #' Values: "Y"/"N". In the output, terms will be sorted by group first, then term. To be used #' along with `ht_dispyn` = Y in `ae_forest_plot()` +#' @param riskdiff_pct To display risk and CI as % if `statistic` = risk difference (Y/N) +#' @param hoveryn Include hover information (for graphs) Y/N +#' #' @return A dataset containing risk statistic calculations for given treatment pair(s). #' @export #' @@ -61,7 +66,7 @@ options(warn = -1) #' trtgrp = "Xanomeline High Dose", #' statistics = "Risk Ratio", #' alpha = 0.05, -#' cutoff = 2, +#' cutoff_where = "PCT > 2", #' sort_opt = "Ascending", #' sort_var = "Count" #' ) @@ -74,16 +79,18 @@ risk_stat <- trtgrp, statistics = "Risk Ratio", alpha = 0.05, - cutoff = 2, - sort_opt, - sort_var, - g_sort_by_ht = "N") { + cutoff_where = NA, + sort_opt = "Ascending", + sort_var = "Count", + g_sort_by_ht = "N", + riskdiff_pct = "N", + sigdec = 1, + pctsyn = "Y", + hoveryn = "Y") { trtgrp <- str_to_vec(trtgrp, "~~") - stopifnot("Invalid Control Group" = ctrlgrp %in% unique(datain[["TRTVAR"]])) - stopifnot("Invalid Treatment Group" = all(trtgrp %in% unique(datain[["TRTVAR"]]))) stopifnot( "Invalid Risk Statistics; specify any one of `Risk Ratio` or `Risk Difference`" = - statistics %in% c("Risk Ratio", "Risk Difference") + tolower(statistics) %in% c("risk ratio", "risk difference") ) trt_list <- levels(datain[["TRTVAR"]]) ## getting equivalent data variable for given summary by selection @@ -102,61 +109,66 @@ risk_stat <- id_vars <- c("BYVAR1", "DPTVAL") value_vars <- c("FREQ", "PCT", "DENOMN") - distinct_vars <- c("TRTVAR", id_vars, value_vars) - + mcat_out <- mcatstat( + datain = datain, + a_subset = a_subset, + uniqid = ifelse(tolower(summary_by) == "events", "ALLCT", summ_var), + dptvar = eventvar, + pctdisp = "TRT", + sigdec = sigdec, + pctsyn = pctsyn + ) + if (nrow(mcat_out) == 0) { + return(mcat_out) + } ## calculating risk statistics mapping over each treatment risk_out <- map(set_names(trtgrp), \(trt) { - datain <- datain |> + mcatin <- mcat_out |> filter(.data[["TRTVAR"]] %in% c(ctrlgrp, trt)) - - mcat_out <- mcatstat( - datain = datain, - a_subset = a_subset, - uniqid = ifelse(tolower(summary_by) == "events", "ALLCT", summ_var), - dptvar = eventvar, - pctdisp = "TRT" - ) - + if (!is.na(cutoff_where) && str_detect(cutoff_where, "PCT|FREQ")) { + mcat_cut <- mcatin |> + filter(!!!parse_exprs(cutoff_where)) |> + distinct(across(all_of(id_vars))) |> + mutate(CUTFL = "Y") + mcatin <- mcatin |> + left_join(mcat_cut, by = id_vars) |> + filter(.data[["CUTFL"]] == "Y") + } + if (nrow(mcatin) < 1) { + return(data.frame()) + } rout <- add_risk_stat( - mcatout = mcat_out, + mcatout = mcatin, ctrlgrp = ctrlgrp, trtgrp = trt, id_vars = id_vars, value_vars = value_vars, statistics = statistics, - alpha = alpha, - cutoff = cutoff + riskdiff_pct = riskdiff_pct, + alpha = alpha ) - if (nrow(rout) > 0) { - rout <- rout |> - left_join(distinct(select(mcat_out, any_of( - c(distinct_vars) - ))), by = c("TRTVAR", intersect(id_vars, names(mcat_out)))) |> - mutate(across(any_of(c(value_vars)), \(x) as.double(x))) |> - select(c( - any_of(c(id_vars)), - contains("PVAL"), - contains("RISK"), - contains("CTRL_"), - starts_with("TRT"), - any_of(c(value_vars)), - "TOTAL_N" = "DENOMN" - )) + rout <- mcat_out |> + filter(.data[["TRTVAR"]] %in% c(ctrlgrp, trt) | + str_detect(.data[["TRTVAR"]], "Total")) |> + left_join(rout, by = intersect(names(mcat_out), names(rout))) |> + mutate(across(any_of(c(value_vars)), \(x) as.double(x)), TOTAL_N = DENOMN) |> + filter(!.data[["RISK"]] %in% c(NA, Inf, NaN)) } rout }) |> bind_rows() - - if (nrow(risk_out) > 0) { + if (nrow(risk_out) > 0 && ncol(risk_out) > 1) { ## Add hover_text and order the final table risk_out <- risk_out |> - risk_hover_text(summary_by, eventvar) |> ord_summ_df(sort_var, sort_opt, g_sort_by_ht) risk_out[["TRTVAR"]] <- factor(risk_out[["TRTVAR"]], levels = trt_list, ordered = TRUE ) + if (hoveryn == "Y") { + risk_out <- risk_hover_text(risk_out, summary_by, eventvar) + } } risk_out } @@ -176,8 +188,8 @@ add_risk_stat <- function(mcatout, id_vars = c("BYVAR1", "DPTVAL"), value_vars = c("FREQ", "PCT", "DENOMN"), statistics = "Risk Ratio", - alpha = 0.05, - cutoff = 2) { + riskdiff_pct = "N", + alpha = 0.05) { if (nrow(mcatout) < 1 || !all(c(ctrlgrp, trtgrp) %in% unique(mcatout$TRTVAR))) { return(data.frame()) } @@ -192,18 +204,11 @@ add_risk_stat <- function(mcatout, PCT = as.double(.data[["PCT"]]) ) |> pivot_wider( - id_cols = any_of(c(id_vars)), + id_cols = any_of(c(id_vars, "CUTFL")), names_from = "TRTCD", values_from = any_of(c(value_vars)) ) |> - mutate(across(where(is.numeric), ~ replace_na(.x, 0))) |> - filter(.data[["PCT_CTRLGRP"]] > cutoff | - .data[["PCT_TRTGRP"]] > cutoff) - - if (nrow(risk_prep) < 1) { - message("`cutoff` value provided is too big, please specify a smaller `cutoff` value") - return(data.frame(NULL)) - } + mutate(across(where(is.numeric), ~ replace_na(.x, 0))) ## Calculate Risk Statistics in `risk_out` column using `calc_risk_stat` risk_prep <- risk_prep |> group_by(across(any_of(c(id_vars)))) |> @@ -216,13 +221,19 @@ add_risk_stat <- function(mcatout, calc_risk_stat )) |> ungroup() + # Show as percent if required + if (tolower(statistics) == "risk difference" && riskdiff_pct == "Y") { + ppct <- 100 + } else { + ppct <- 1 + } ## Extract Risk Statistics from the added `risk_out` column by each row rowwise(risk_prep) |> mutate( - PVALUE = flatten(.data[["risk_out"]])[["pval"]], - RISK = flatten(.data[["risk_out"]])[["risk"]], - RISKCIL = flatten(.data[["risk_out"]])[["low_ci"]], - RISKCIU = flatten(.data[["risk_out"]])[["upp_ci"]] + PVALUE = round(flatten(.data[["risk_out"]])[["pval"]], 4), + RISK = round(ppct * flatten(.data[["risk_out"]])[["risk"]], 3), + RISKCIL = round(ppct * flatten(.data[["risk_out"]])[["low_ci"]], 2), + RISKCIU = round(ppct * flatten(.data[["risk_out"]])[["upp_ci"]], 2) ) |> mutate( ADJPVALUE = p.adjust(.data[["PVALUE"]], method = "fdr"), @@ -235,8 +246,7 @@ add_risk_stat <- function(mcatout, ACTIVE = trtgrp ) |> rename(CTRL_N = "FREQ_CTRLGRP", CTRL_PCT = "PCT_CTRLGRP") |> - select(-c("risk_out", any_of(starts_with("DENOMN")), any_of(ends_with("TRTGRP")))) |> - pivot_longer(c("CTRL", "ACTIVE"), values_to = "TRTVAR", names_to = NULL) + select(-c("risk_out", any_of(starts_with("DENOMN")), any_of(ends_with("TRTGRP")))) } #' Calculate Risk Statistics @@ -270,15 +280,11 @@ calc_risk_stat <- suppressWarnings(riskdiff_wald(risk_mat, conf.level = 1 - alpha)) } else { risk_mat <- - suppressWarnings(epitools::riskratio.wald(risk_mat, conf.level = 1 - alpha)) + suppressWarnings( + epitools::riskratio.wald(risk_mat, conf.level = 1 - alpha, correction = TRUE) + ) } - - list( - risk = round(risk_mat$measure[2, 1], 3), - pval = round(risk_mat$p.value[2, 3], 4), - low_ci = round(risk_mat$measure[2, 2], 2), - upp_ci = round(risk_mat$measure[2, 3], 2) - ) + extract_riskstats(risk_mat, statistic) } #' Calculate Risk difference @@ -290,12 +296,7 @@ calc_risk_stat <- #' input data can be one of the following: r x 2 table, vector of numbers from a #' contigency table (will be transformed into r x 2 table in row-wise order), #' or single factor or character vector that will be combined with y into a table. -#' @param y single factor or character vector that will be combined with x into a table -#' (default is NULL) #' @param conf.level confidence level (default is 0.95) -#' @param rev reverse order of "rows", "colums", "both", or "neither" (default) -#' @param correction Yate's continuity correction -#' @param verbose To return more detailed results #' #' @return a list containg a data,measure,p.value,correction #' @export @@ -306,22 +307,9 @@ calc_risk_stat <- #' conf.level = 0.95 #' ) riskdiff_wald <- - function(x, y = NULL, - conf.level = 0.95, - rev = "neither", - correction = FALSE, - verbose = FALSE) { - if (is.matrix(x) && !is.null(y)) { - stop("y argument should be NULL") - } - if (is.null(y)) { - x <- epitools::epitable(x, rev = rev) - } else { - x <- epitools::epitable(x, y, rev = rev) - } + function(x, conf.level = 0.95) { + x <- epitools::epitable(x, rev = "neither") tmx <- epitools::table.margins(x) - p.exposed <- sweep(tmx, 2, tmx["Total", ], "/") - p.outcome <- sweep(tmx, 1, tmx[, "Total"], "/") Z <- qnorm(0.5 * (1 + conf.level)) nr <- nrow(x) wald <- matrix(NA, nr, 3) @@ -331,16 +319,14 @@ riskdiff_wald <- b <- x[i, 1] c <- x[1, 2] d <- x[1, 1] - - # point estimate of risk difference - est <- (a / (a + b)) - (c / (c + d)) - # standard error of risk difference - se_RD <- sqrt((a * b / (a + b)^3) + (c * d / (c + d)^3)) - - ci <- est + c(-1, 1) * Z * se_RD + p2 <- a / (a + b) + p1 <- c / (c + d) + est <- p1 - p2 + se_RD <- sqrt((p1 * (1 - p1) / (c + d)) + (p2 * (1 - p2) / (a + b))) + ci <- (est + c(-1, 1) * Z * se_RD) wald[i, ] <- c(est, ci) } - pv <- epitools::tab2by2.test(x, correction = correction) + pv <- epitools::tab2by2.test(x, correction = FALSE) colnames(wald) <- c("estimate", "lower", "upper") rownames(wald) <- rownames(x) cn2 <- paste( @@ -350,31 +336,14 @@ riskdiff_wald <- ) names(dimnames(wald)) <- c(names(dimnames(x))[1], cn2) - rr <- list( - x = x, - data = tmx, - p.exposed = p.exposed, - p.outcome = p.outcome, - measure = wald, - conf.level = conf.level, - p.value = pv$p.value, - correction = pv$correction - ) rrs <- list( data = tmx, measure = wald, p.value = pv$p.value, correction = pv$correction ) - - attr(rr, "method") <- "Unconditional MLE & normal approximation (Wald) CI" attr(rrs, "method") <- "Unconditional MLE & normal approximation (Wald) CI" - - if (verbose == FALSE) { - rrs - } else { - rr - } + rrs } #' Add Risk Statistics specific Hover Text to data @@ -424,3 +393,31 @@ risk_hover_text <- function(df, summary_by, eventvar) { ) ) } + +#' Extract Risk Statistics +#' +#' @return list of statistics +#' @noRd +extract_riskstats <- function(risk_mat, statistic) { + risk <- risk_mat$measure[2, 1] + pval <- risk_mat$p.value[2, 3] + low_ci <- risk_mat$measure[2, 2] + upp_ci <- risk_mat$measure[2, 3] + + if (statistic == "Risk Difference") { + out <- list( + risk = 0 - risk, + pval = pval, + upp_ci = 0 - low_ci, + low_ci = 0 - upp_ci + ) + } else { + out <- list( + risk = risk, + pval = pval, + upp_ci = upp_ci, + low_ci = low_ci + ) + } + out +} diff --git a/R/riskdiff_wald.R b/R/riskdiff_wald.R deleted file mode 100644 index 7f2f90d..0000000 --- a/R/riskdiff_wald.R +++ /dev/null @@ -1,117 +0,0 @@ -# Copyright 2024 Pfizer Inc -# -# Licensed under the Apache License, Version 2.0 (the "License"); -# you may not use this file except in compliance with the License. -# You may obtain a copy of the License at -# -# http://www.apache.org/licenses/LICENSE-2.0 -# -# Unless required by applicable law or agreed to in writing, software -# distributed under the License is distributed on an "AS IS" BASIS, -# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -# See the License for the specific language governing permissions and -# limitations under the License. -# -#' Calculate Risk difference -#' -#' Function to calculate risk difference by unconditional maximum likelihood estimation (Wald) -#' for any given treatment pairs. -#' -#' @param x input data -#' input data can be one of the following: r x 2 table, vector of numbers from a -#' contigency table (will be transformed into r x 2 table in row-wise order), -#' or single factor or character vector that will be combined with y into a table. -#' -#' @param y single factor or character vector that will be combined with x into a table -#' (default is NULL) -#' -#' @param conf.level confidence level (default is 0.95) -#' -#' @param rev reverse order of "rows", "colums", "both", or "neither" (default) -#' -#' @param correction Yate's continuity correction -#' -#' @param verbose To return more detailed results -#' -#' @return a list containg a data,measure,p.value,correction -#' @export -#' -#' @examples -#' riskdiff_wald( -#' x = matrix(c(178, 79, 1411, 1486), 2, 2), -#' conf.level = 0.95, -#' rev = c("neither", "rows", "columns", "both"), -#' correction = FALSE, -#' verbose = FALSE -#' ) -riskdiff_wald <- - function(x, y = NULL, - conf.level = 0.95, - rev = c("neither", "rows", "columns", "both"), - correction = FALSE, - verbose = FALSE) { - if (is.matrix(x) && !is.null(y)) { - stop("y argument should be NULL") - } - if (is.null(y)) { - x <- epitable(x, rev = rev) - } else { - x <- epitable(x, y, rev = rev) - } - tmx <- table.margins(x) - p.exposed <- sweep(tmx, 2, tmx["Total", ], "/") - p.outcome <- sweep(tmx, 1, tmx[, "Total"], "/") - Z <- qnorm(0.5 * (1 + conf.level)) - nr <- nrow(x) - wald <- matrix(NA, nr, 3) - wald[1, 1] <- 1 - for (i in 2:nr) { - a <- x[i, 2] - b <- x[i, 1] - c <- x[1, 2] - d <- x[1, 1] - - # point estimate of risk difference - est <- (a / (a + b)) - (c / (c + d)) - # standard error of risk difference - se_RD <- sqrt((a * b / (a + b)^3) + (c * d / (c + d)^3)) - - ci <- est + c(-1, 1) * Z * se_RD - wald[i, ] <- c(est, ci) - } - pv <- tab2by2.test(x, correction = correction) - colnames(wald) <- c("estimate", "lower", "upper") - rownames(wald) <- rownames(x) - cn2 <- paste( - "risk difference with", - paste(100 * conf.level, "%", sep = ""), - "C.I." - ) - names(dimnames(wald)) <- c(names(dimnames(x))[1], cn2) - - rr <- list( - x = x, - data = tmx, - p.exposed = p.exposed, - p.outcome = p.outcome, - measure = wald, - conf.level = conf.level, - p.value = pv$p.value, - correction = pv$correction - ) - rrs <- list( - data = tmx, - measure = wald, - p.value = pv$p.value, - correction = pv$correction - ) - - attr(rr, "method") <- "Unconditional MLE & normal approximation (Wald) CI" - attr(rrs, "method") <- "Unconditional MLE & normal approximation (Wald) CI" - - if (verbose == FALSE) { - rrs - } else { - rr - } - } diff --git a/R/run_app.R b/R/run_app.R index b1a8d3a..7ef3a58 100644 --- a/R/run_app.R +++ b/R/run_app.R @@ -22,7 +22,8 @@ #' #' @return No return value, called to run the application. run_app <- function( - ...) { + ... +) { with_golem_options( app = shinyApp( ui = app_ui, diff --git a/R/save_file.R b/R/save_file.R index d814161..9524aa5 100644 --- a/R/save_file.R +++ b/R/save_file.R @@ -142,10 +142,10 @@ save_file <- function(save_object, } else if (file_format == "pptx") { tryCatch( { - read_pptx() %>% - add_slide() %>% - ph_with(external_img(tempfile), - ph_location_fullsize(left = 0, top = 0)) %>% + officer::read_pptx() %>% + officer::add_slide() %>% + officer::ph_with(officer::external_img(tempfile), + officer::ph_location_fullsize(left = 0, top = 0)) %>% print(target = file) message("generating figure output in PPTX format passed") } @@ -154,8 +154,8 @@ save_file <- function(save_object, }else if (file_format == "docx") { tryCatch( { - read_docx() %>% - body_add_img(src = external_img(tempfile), + officer::read_docx() %>% + officer::body_add_img(src = officer::external_img(tempfile), width = 5, height = 8) %>% print(target = file) message("generating figure output in DOCX format passed") diff --git a/R/scatter_plot.R b/R/scatter_plot.R index 9cbb720..c8a8535 100644 --- a/R/scatter_plot.R +++ b/R/scatter_plot.R @@ -1,6 +1,20 @@ +# Copyright 2024 Pfizer Inc +# +# Licensed under the Apache License, Version 2.0 (the "License"); +# you may not use this file except in compliance with the License. +# You may obtain a copy of the License at +# +# http://www.apache.org/licenses/LICENSE-2.0 +# +# Unless required by applicable law or agreed to in writing, software +# distributed under the License is distributed on an "AS IS" BASIS, +# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +# See the License for the specific language governing permissions and +# limitations under the License. +# #' Create Scatter Plot #' -#' @param datain `data.frame` retrieved from `process_vx_scatter_data()`. +#' @param datain Input `data.frame`. #' @param axis_opts A `list` of axis specific options retrieved from `plot_axis_opts()`. #' @param series_var Series (Treatment) Variable. #' @param series_labelvar Series (Treatment) Variable labels for legend, if @@ -18,73 +32,46 @@ #' #' @examples #' library(dplyr) -#' library(purrr) #' #' # Example 1 #' -#' data("vx_scatter_data") -#' -#' ## process data for plotting -#' scatter_df <- -#' process_vx_scatter_data( -#' dataset_adsl = vx_scatter_data[["adsl"]], -#' adsl_subset = 'EVALFL=="Y"', -#' dataset_analysis = vx_scatter_data[["adva"]], -#' analysis_subset = 'ANL01FL=="Y" & PARAMN==23 & -#' ((AVISITN ==1 & EVALFL=="Y")|(AVISITN==2 & EVALFL=="Y" & EXCL5FL=="N")) & # nolint -#' TRTA!="" & DTYPE=="LLOQIMP" & !is.na(AVAL)', # nolint -#' split_by = "SEX", -#' trtvar = "ACTARM", -#' xvar = "AVISITN == 1", -#' yvar = "AVISITN == 2", -#' legendbign = "Y" -#' ) -#' -#' ## shape, color and symbols -#' series_opts <- plot_aes_opts( -#' datain = scatter_df, -#' series_color = "#F8766D~#619CFF", -#' series_shape = "circle~triangle", -#' series_size = as.numeric(str_to_vec("2~2")) -#' ) -#' -#' ## splitting data to generate scatter plots of each subgroup (only if `split_by` is specified in -#' ## `process_vx_scatter_data`) -#' data_list <- split_data_by_var( -#' datain = scatter_df, -#' split_by_prefix = "SUBGRPVAR" -#' ) -#' -#' ## map over `scatter_plot` on split data -#' purrr::map(data_list, \(p) { +#' data(adsl) +#' +#' mentry_df <- adsl |> +#' mentry( +#' subset = "AGE < 60", +#' byvar = NA_character_, +#' trtvar = "TRT01A", +#' trtsort = "TRT01AN", +#' subgrpvar = NA_character_, +#' trttotalyn = "N", +#' add_grpmiss = "N", +#' pop_fil = "SAFFL" +#' ) |> +#' dplyr::mutate(XVAR = as.integer(factor(USUBJID)), YVAR = AGE) +#' mentry_df |> #' scatter_plot( -#' datain = p, #' axis_opts = plot_axis_opts( #' xlinearopts = list( -#' breaks = c(0.001, 0.01, 0.1, 1, 10, 100), -#' limits = c(0.001, 100) -#' ), -#' ylinearopts = list( -#' breaks = c(0.001, 0.01, 0.1, 1, 10, 100, 1000), -#' limits = c(0.001, 1000) +#' breaks = sort(unique(mentry_df$XVAR)), +#' labels = sort(unique(mentry_df$USUBJID)) #' ), -#' xaxis_scale = "log10", -#' yaxis_scale = "log10", -#' xaxis_label = "Before Vaccination 1", -#' yaxis_label = "1 Month after Vaccination 1" +#' xopts = list(angle = 15) #' ), #' series_var = "TRTVAR", #' series_labelvar = "TRTVAR", -#' series_opts = series_opts, +#' series_opts = list( +#' shape = c(16, 17, 18), +#' color = scales::hue_pal()(3), +#' size = c(2, 2, 3) +#' ), #' legend_opts = list( -#' label = "", +#' label = "Treatment", #' pos = "bottom", #' dir = "horizontal" #' ), -#' plot_title = paste("Number of Participants = ", length(unique(p$SUBJID))), -#' griddisplay = "Y" +#' plot_title = "Scatter Plot of Subject vs Age" #' ) -#' }) #' #' # Example 2 #' @@ -133,8 +120,8 @@ scatter_plot <- g <- ggplot( datain, aes( - x = XVAR, - y = YVAR, + x = .data[["XVAR"]], + y = .data[["YVAR"]], shape = .data[[series_var]], color = .data[[series_var]], size = .data[[series_var]] @@ -176,100 +163,3 @@ scatter_plot <- theme_std(axis_opts, legend_opts, griddisplay) g } - -#' Process data for Vaccines Scatter Plot -#' -#' @param dataset_adsl (`data.frame`) ADSL dataset. -#' @param dataset_analysis (`data.frame`) Analysis Dataset. -#' @param adsl_subset (`string`) Subset condition to be applied on `dataset_adsl`. -#' @param analysis_subset (`string`) Subset Condition to be applied on `dataset_analysis`. -#' @param split_by (`string`) By variable for stratification. -#' @param trtvar (`string`) Treatment Variable to be created for analysis. -#' @param trtsort (`string`) Variable to sort treatment variable by. -#' @param xvar (`string`) Values for X axis, determined by filter condition for -#' analysis visit. -#' @param yvar (`string`) Values for Y axis, determined by filter condition for -#' analysis visit. -#' @param legendbign (`string`) Display count as (N = ..) in Treatment legend? Values: "Y"/"N" -#' -#' @return Grouped Data Frames within a list -#' @export -#' -#' @examples -#' data("vx_scatter_data") -#' -#' process_vx_scatter_data( -#' dataset_adsl = vx_scatter_data[["adsl"]], -#' dataset_analysis = vx_scatter_data[["adva"]], -#' adsl_subset = 'EVALFL=="Y"', -#' analysis_subset = 'ANL01FL=="Y" & PARAMN==23 & -#' ((AVISITN ==1 & EVALFL=="Y")|(AVISITN==2 & EVALFL=="Y" & EXCL5FL=="N")) & -#' TRTA!="" & DTYPE=="LLOQIMP" & !is.na(AVAL)', # nolint -#' split_by = "SEX", -#' trtvar = "ACTARM", -#' xvar = "AVISITN == 1", -#' yvar = "AVISITN == 2" -#' ) -#' -process_vx_scatter_data <- - function(dataset_adsl, - dataset_analysis, - adsl_subset, - analysis_subset = NA_character_, - split_by = NA_character_, - trtvar, - trtsort = NA, - xvar = "AVISITN == 1", - yvar = "AVISITN == 2", - legendbign = "Y") { - stopifnot(is.data.frame(dataset_adsl)) - stopifnot(is.data.frame(dataset_analysis)) - stopifnot(nrow(dataset_adsl) > 0) - stopifnot(nrow(dataset_analysis) > 0) - stopifnot(trtvar %in% toupper(names(dataset_adsl))) - stopifnot("AVAL" %in% toupper(names(dataset_analysis))) - stopifnot(xvar != yvar) - if (!is.na(split_by) && str_squish(split_by) != "") { - stopifnot(all(str_to_vec(split_by) %in% toupper(names(dataset_adsl)))) - } - - adsl_sub <- adsl_merge( - dataset_adsl, - adsl_subset, - dataset_analysis - ) - - stopifnot(nrow(adsl_sub) > 0) - - mentry_df <- adsl_sub |> - mentry( - subset = analysis_subset, - subgrpvar = str_remove_all(split_by, " "), - trtvar = trtvar, - trtsort = trtsort, - add_grpmiss = "N", - pop_fil = "Overall Population" - ) - - stopifnot(nrow(mentry_df) > 0) - - a_dsin <- mentry_df |> - mutate(Vars = case_when( - !!!parse_exprs(xvar) ~ "XVAR", - !!!parse_exprs(yvar) ~ "YVAR" - )) - - if (all(is.na(a_dsin[["Vars"]]))) { - stop("`xvar/yvar` are invalid") - } - - a_dsin_ <- pivot_wider( - a_dsin, - id_cols = c(SUBJID, TRTVAR, starts_with("SUBGRPVAR")), - names_from = Vars, - values_from = AVAL - ) |> - plot_display_bign(mentry_df, bignyn = legendbign) - - return(a_dsin_) - } diff --git a/R/stat_utils.R b/R/stat_utils.R new file mode 100644 index 0000000..7fc929c --- /dev/null +++ b/R/stat_utils.R @@ -0,0 +1,208 @@ +# Copyright 2024 Pfizer Inc +# +# Licensed under the Apache License, Version 2.0 (the "License"); +# you may not use this file except in compliance with the License. +# You may obtain a copy of the License at +# +# http://www.apache.org/licenses/LICENSE-2.0 +# +# Unless required by applicable law or agreed to in writing, software +# distributed under the License is distributed on an "AS IS" BASIS, +# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +# See the License for the specific language governing permissions and +# limitations under the License. +# +#' Update functions to round values +#' +#' @param f List of names of summary statistics. +#' @param d Numeric values +#' @param ... +#' +#' @return Rounded numeric values +#' @noRd +#' +fmtrd <- function(f, d = 2, ...) { + function(x) { + dc <- do.call(f, args = list(x, na.rm = TRUE, ...)) + ifelse(is.na(dc), "-", round_f(dc, d)) + } +} + +#' Std Error function definition +#' +#' @param x Input vector +#' +#' @return Numeric value containing standard error +#' +#' @noRd +stderr <- function(x, ...) { + sd(x, ...) / sqrt(length((x))) +} + +#' Dataframe of statistics, labels and derivations +#' +#' @return tibble of 4 columns +#' @noRd +stat_lookup <- function() { + tibble::tribble( + ~Stat, ~base, ~label, ~derv, + "mean(sd)", "mean/sd", "Mean(SD)", "{mean} ({sd})", + "mean(stderr)", "mean/stderr", "Mean(SE)", "{mean} ({stderr})", + "minmax", "min/max", "(Min-Max)", "({min}-{max})", + "minmaxc", "min/max", "(Min,Max)", "({min},{max})", + "median(minmax)", "median/min/max", "Median (Min-Max)", "{median} ({min}-{max})", + "median(minmaxc)", "median/min/max", "Median (Min,Max)", "{median} ({min},{max})", + "q1q3", "q1/q3", "(Q1,Q3)", "({q1}, {q3})", + "median(q1q3)", "median/q1/q3", "Median (Q1,Q3)", "{median} ({q1},{q3})", + "geomean(geosd)", "geomean/geosd", "Geomean(Geomean SD)", "{geomean} ({geosd})", + "q1", "q1", "1st Quantile", "", + "q3", "q3", "3rd Quantile", "", + "stderr", "stderr", "s.e.", "", + "sd", "sd", "s.d.", "" + ) +} + +#' Parse Statistics for msumstat +#' +#' @param statvar Input statistics to msumstat +#' @param statdec Input statistics decimal levels to msumstat +#' +#' @return named vector +#' @noRd +parse_stats <- function(statvar, statdec) { + if (all(is.na(statdec)) || all(statdec == "")) statdec <- rep(2, length(statvar)) + if (length(statdec) == 1) statdec <- rep(statdec, length(statvar)) + stopifnot(length(statvar) == length(statdec)) + lookup <- stat_lookup() |> filter(.data[["derv"]] != "") + stats <- map(seq_along(statvar), \(s) { + if (statvar[s] %in% lookup$Stat) { + st <- lookup |> + filter(Stat == statvar[s]) |> + pull(.data[["base"]]) |> + str_to_vec("/") + d <- unlist(stringr::str_extract_all(statdec[s], "[0-9]+")) + last <- d[length(d)] + length(d) <- length(st) + d[is.na(d)] <- last + setNames(d, st) + } else { + setNames(statdec[s], statvar[s]) + } + }) |> + unlist() + if (any(duplicated(names(stats)))) { + stats[unique(names(stats))] + } else { + stats + } +} + +#' List of Summary Functions +#' +#' @param statvar Input statistics +#' @param statdec Corresponding number of decimal places for each statistic +#' +#' @return A named list containing function definition for all defined summary +#' statistics - mean, min, max, median, mode iqr, var, sum, sd, q25, q75, p1, p5, +#' p10, p90, p95, p99 (where last digits represent % of quantile), whiskerlow, +#' whiskerup, outliers in the Tukey method for box statistics, geometric mean/sd/CI +#' @export +#' +#' @examples +#' summary_functions(c("mean", "mode"), c(2, 1)) +summary_functions <- function(statvar, statdec) { + base_fns <- c( + "mean", "min", "max", "median", "IQR", "var", "sum", "sd", "stderr", "mode", + "whiskerlow", "whiskerup" + ) + map(seq_along(statvar), \(s) { + d <- as.numeric(statdec[s]) + f <- statvar[s] + f <- recode(f, "q1" = "q25", "q3" = "q75", "iqr" = "IQR") + if (f %in% base_fns) { + fmtrd(f, d) + } else if (str_detect(f, "^(q\\d+)$|^(p\\d+)$")) { + fmtrd(f = "quantile", d = d, as.numeric(gsub("\\D", "", f)) / 100, type = 2) + } else if (f == "geomean") { + function(x) round_f(exp(mean(log(x), na.rm = TRUE)), d) + } else if (f == "geosd") { + function(x) round_f(exp(sd(log(x), na.rm = TRUE)), d) + } else if (f == "geomean_lowci") { + function(x) { + x <- log(x) + margin_error <- qt(0.975, df = length(x) - 1) * sd(x, na.rm = TRUE) / sqrt(length(x)) + round_f(exp(mean(x, na.rm = TRUE) - margin_error), d) + } + } else if (f == "geomean_upci") { + function(x) { + x <- log(x) + margin_error <- qt(0.975, df = length(x) - 1) * sd(x, na.rm = TRUE) / sqrt(length(x)) + round_f(exp(mean(x, na.rm = TRUE) + margin_error), d) + } + } else if (f == "outliers") { + function(x) { + x <- x[!is.na(x)] + paste(unique(x[x < whiskerlow(x) | x > whiskerup(x)]), collapse = "") + } + } else if (f == "nobs") { + function(x) paste(n()) + } else if (f == "n") { + function(x) as.character(sum(!is.na(x))) + } else if (f == "nmiss") { + function(x) as.character(sum(is.na(x))) + } else { + function(x) "_NO_STAT" + } + }) |> + setNames(statvar) +} + + +#' Lower Box Whiskers +#' +#' @param x Input data +#' @param na.rm Remove NA +#' +#' @return Lower Whisker Value for box plot data +#' @noRd +whiskerlow <- function(x, na.rm = TRUE) { + min(x[(x >= (quantile(x, 0.25, na.rm = TRUE) - 1.5 * IQR(x, na.rm = TRUE))) & + (x <= quantile(x, 0.25, na.rm = TRUE))], na.rm = na.rm) +} + +#' Upper Box Whiskers +#' +#' @param x Input data +#' @param na.rm Remove NA +#' +#' @return Upper Whisker Value for box plot data +#' @noRd +whiskerup <- function(x, na.rm = TRUE) { + max(x[(x <= (quantile(x, 0.75, na.rm = TRUE) + 1.5 * IQR(x, na.rm = TRUE))) & + (x >= quantile(x, 0.75, na.rm = TRUE))], na.rm = na.rm) +} + +#' Concatenate to create complex statistics +#' +#' @param data Input dataset +#' @param stats Statistics +#' +#' @return Dataframe with mutated columns +#' @noRd +derv_stats <- function(data, stats, lookup = stat_lookup()) { + lookup <- lookup |> filter(.data[["derv"]] != "") + if (!any(stats %in% lookup[[1]])) { + return(data) + } else { + stats <- stats[stats %in% lookup[[1]]] + map(stats, \(s) { + derv <- lookup |> + filter(if_all(1) == s) |> + pull(.data[["derv"]]) + data |> + mutate({{ s }} := glue::glue(derv)) |> + select(all_of(s)) + }) |> + (\(.) bind_cols(data, .))() + } +} diff --git a/R/surv_utils.R b/R/surv_utils.R index c73815f..3854a64 100644 --- a/R/surv_utils.R +++ b/R/surv_utils.R @@ -1,3 +1,17 @@ +# Copyright 2024 Pfizer Inc +# +# Licensed under the Apache License, Version 2.0 (the "License"); +# you may not use this file except in compliance with the License. +# You may obtain a copy of the License at +# +# http://www.apache.org/licenses/LICENSE-2.0 +# +# Unless required by applicable law or agreed to in writing, software +# distributed under the License is distributed on an "AS IS" BASIS, +# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +# See the License for the specific language governing permissions and +# limitations under the License. +# #' Process data for Survival Analysis #' #' @inheritParams process_vx_scatter_data @@ -79,7 +93,7 @@ surv_pre_processor <- function(dataset_adsl, #' @noRd #' pairwise_surv_stats <- function(datain) { - pairs <- utils::combn(sort(unique(datain[["TRTSORT"]])), 2) + pairs <- combn(sort(unique(datain[["TRTSORT"]])), 2) pair_stat <- map_chr(seq_len(ncol(pairs)), \(i) { trt_index <- pairs[, i] @@ -88,7 +102,7 @@ pairwise_surv_stats <- function(datain) { trt_pair <- levels(pair_data[["TRTVAR"]])[trt_index] # nolint # tidy coxph fit summ <- - coxph(Surv(timevar, cnsrvar) ~ TRTVAR, data = pair_data) |> + survival::coxph(survival::Surv(timevar, cnsrvar) ~ TRTVAR, data = pair_data) |> broom::tidy(conf.int = TRUE, exponentiate = TRUE) |> filter(row_number() == 1) # extract coxph statistics diff --git a/R/tbl_display.R b/R/tbl_display.R index 173c733..492571c 100644 --- a/R/tbl_display.R +++ b/R/tbl_display.R @@ -80,7 +80,10 @@ tbl_processor <- function(datain, if (any(keepvars == "")) { rep <- rep |> select( - -any_of(c("DENOMN", "TRTTXT", "FREQ", "PCT", "XVAR", "TOTAL_N", "TRTPAIR", dropvars)), + -any_of(c( + "DENOMN", "TRTTXT", "FREQ", "PCT", "CPCT", "XVAR", + "TOTAL_N", "TRTPAIR", dropvars + )), -starts_with("HOVER") ) } else { @@ -117,6 +120,15 @@ tbl_processor <- function(datain, ~ ifelse(.data[["CN"]] == "C", gsub("^-$", "0", .x), .x) )) } + # Only N and uniqN should be 0 instead of - + if ("DPTVAL" %in% names(rep) && any(c("n", "nmiss", "nobs") %in% unique(rep$DPTVAL))) { + rep <- rep |> mutate(across( + -any_of(c(BYVAR, "DPTVAR", "DPTVAL")) & where(is.character), + ~ if_else(.data[["DPTVAL"]] %in% c("n", "nmiss", "nobs"), + gsub("^-$", "0", .x), .x + ) + )) + } # If additional dataset is given: if (is.data.frame(extra_df)) { rep <- rep |> inner_join(extra_df, by = extra_mergeby) @@ -158,7 +170,7 @@ tbl_processor <- function(datain, # arrange rows and then proceed; combine groups if dptlabel is suitably passed rep |> arrange(across(any_of(c(BYVARN, "DPTVARN", "DPTVALN")))) |> - filter(if_all(any_of("DPTVAL"), ~ !grepl("NONE$|_NONE_$|JOIN$", toupper(.x)))) |> + filter(if_all(any_of("DPTVAL"), ~ !grepl("_NONE_$|_JOIN_$", toupper(.x)))) |> select(any_of(c(BYVAR, "DPTVAR", "DPTVAL")), everything(), -any_of(BYVARN)) } @@ -175,18 +187,25 @@ set_cat_labels <- function(data, dptlabel) { vals <- data |> arrange(.data[["DPTVARN"]]) |> - pull(.data[["DPTVAR"]]) |> + select(all_of(c("DPTVAR", "DPTVARN"))) |> unique() # # Labels for categories if (all(is.na(dptlabel))) { - dptlabel <- setNames(str_to_title(vals), vals) + dptlabel <- setNames(str_to_title(vals[["DPTVAR"]]), vals[["DPTVAR"]]) + label_df <- data |> + mutate(DPTVAR = recode(.data[["DPTVAR"]], !!!dptlabel)) } else { cats <- str_to_vec(dptlabel) - stopifnot("Supply same number of labels as variables" = length(cats) == length(vals)) - dptlabel <- setNames(str_to_vec(dptlabel), vals) + stopifnot( + "Supply same number of labels as variables" = length(cats) == length(vals[["DPTVARN"]]) + ) + label_df <- bind_cols(vals, new_var = cats) |> + select(-DPTVAR) |> + right_join(data, by = "DPTVARN") |> + mutate(DPTVAR = .data[["new_var"]]) |> + select(-all_of("new_var")) } - data |> - mutate(DPTVAR = recode(.data[["DPTVAR"]], !!!dptlabel)) + label_df } #' Add empty row for dptvar @@ -205,18 +224,25 @@ add_row_var <- function(datain, len <- length(addrowvar) dptvaln <- seq(0, 0.9, length.out = len) pad <- strrep("\t\t", seq_len(len + 1) - 1) + if ("DPTVAL" %in% names(datain)) { + val_var <- "DPTVAL" + } else { + val_var <- "DPTVAR" + } + val_varn <- paste0(val_var, "N") purrr::map(seq_along(addrowvar), \(i) { + varn <- paste0(addrowvar[[i]], "N") var <- addrowvar[[i]] datain |> - distinct(across(any_of(unique(c(byvar, byvarn, var, "DPTVARN"))))) |> + distinct(across(any_of(unique(c(byvar, byvarn, var, varn))))) |> mutate( - DPTVALN = dptvaln[i], - DPTVAL = paste0(pad[i], .data[[var]]) + !!val_varn := dptvaln[i], + !!val_var := paste0(pad[i], .data[[var]]) ) }) |> bind_rows( datain |> - mutate(DPTVAL = paste0(pad[len + 1], .data[["DPTVAL"]])) + mutate(!!val_var := paste0(pad[len + 1], .data[[val_var]])) ) } @@ -263,6 +289,7 @@ clear_dup_rows <- function(col, target) { #' @param dpthead String to become name of the column containing categories (`DPTVAL`) in output. #' @param font Font face for text inside table #' @param fontsize Font size for text inside table +#' @param boldheadyn Y/N to determine if table header should be bold #' #' @return flextable object #' @export @@ -296,10 +323,11 @@ clear_dup_rows <- function(col, target) { #' dpthead = " " #' ) tbl_display <- function(datain, - bylabel, + bylabel = NA, dpthead = " ", font = "Arial", - fontsize = 10) { + fontsize = 10, + boldheadyn = "N") { BYVAR <- var_start(datain, "BYVAR") # If by variables exist, process for aptly merging the columns in output lenby <- length(BYVAR) @@ -337,6 +365,10 @@ tbl_display <- function(datain, hline(i = rowh[rowh != 0], j = b:lenby, border = small_border) } } + if (boldheadyn != "N") { + tout <- tout |> + bold(part = "header") + } tout |> hline(j = (lenby + 1):last, border = small_border) |> border_outer(part = "all", border = big_border) |> @@ -344,3 +376,22 @@ tbl_display <- function(datain, vline(part = "all", border = small_border) |> fix_border_issues() } + +#' Return table if output is empty +#' +#' @param text Text to display under table creation +#' +#' @return flextable output +#' @export +#' +#' @examples +#' empty_tbl() +empty_tbl <- function(text = "No participant meets the reporting criteria") { + flextable(data.frame("X" = text)) |> + set_header_labels(X = "Table not created") |> + bold(part = "header") |> + font(fontname = "Arial", part = "all") |> + theme_box() |> + align(align = "center", part = "all") |> + autofit() +} diff --git a/R/tornado_plot.R b/R/tornado_plot.R index 1379196..c5b00fb 100644 --- a/R/tornado_plot.R +++ b/R/tornado_plot.R @@ -1,3 +1,17 @@ +# Copyright 2024 Pfizer Inc +# +# Licensed under the Apache License, Version 2.0 (the "License"); +# you may not use this file except in compliance with the License. +# You may obtain a copy of the License at +# +# http://www.apache.org/licenses/LICENSE-2.0 +# +# Unless required by applicable law or agreed to in writing, software +# distributed under the License is distributed on an "AS IS" BASIS, +# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +# See the License for the specific language governing permissions and +# limitations under the License. +# #' Tornado Plot #' #' @param datain An input dataframe retrieved from `process_tornado_data`()`. @@ -9,21 +23,20 @@ #' @export #' #' @examples -#' data(tornado_plot_data) +#' data("adsl") +#' data("adae") #' #' tornado_df <- process_tornado_data( -#' dataset_adsl = tornado_plot_data[["adsl"]], -#' dataset_analysis = tornado_plot_data[["adae"]], +#' dataset_adsl = adsl, +#' dataset_analysis = adae, #' adsl_subset = "SAFFL == 'Y'", -#' analysis_subset = NA_character_, -#' ae_filter = "Treatment emergent", +#' analysis_subset = "TRTEMFL == 'Y'", #' obs_residual = "30", #' fmq_data = NA, -#' ae_catvar = "AESEV", -#' trtvar = "ARMCD", -#' trt_left = "A", -#' trt_right = "A", -#' pop_fil = "Overall Population", +#' ae_catvar = "AESEV/AESEVN", +#' trtvar = "ARM", +#' trt_left = "Xanomeline High Dose", +#' trt_right = "Xanomeline Low Dose", #' pctdisp = "TRT", #' denom_subset = NA_character_, #' legendbign = "N", @@ -120,8 +133,8 @@ tornado_plot <- function(datain, #' @param dataset_adsl (`data.frame`) ADSL dataset. #' @param dataset_analysis (`data.frame`) ADAE dataset. #' @param adsl_subset (`string`) Subset condition to be applied on `dataset_adsl`. -#' @param analysis_subset Subset conditions for overall data. -#' @param ae_catvar Categorical variable for severity analysis. +#' @param analysis_subset Subset conditions for `dataset_analysis` +#' @param ae_catvar Categorical variable for severity analysis and order variable. eg; "ASEV/ASEVN" #' @param denom_subset Subset condition to be applied to data set for #' calculating denominator. #' @param split_by (`string`) By variable for stratification. @@ -132,15 +145,18 @@ tornado_plot <- function(datain, #' @param yvar Categorical Analysis variable for Y axis #' @param pctdisp Method to calculate denominator (for %) by #' Possible values: "TRT","VAR","COL","SUBGRP","CAT","NONE","NO","DPTVAR" -#' @param pop_fil Population Filter for data set: Name of flag variable. +#' @param subset Overall subset for data set. eg: "EFFFL == 'Y'" #' eg: `"SAFFL"`, `"EFFFL"` or `NA` for Overall Population. #' @param legendbign (`string`) Display BIGN in Legend (`Y/N`). +#' @param pop_fil Population Filter for data set: Name of flag variable. +#' eg: `"SAFFL"`, `"EFFFL"` or `NA` for Overall Population. #' @inheritParams ae_pre_processor #' #' @details #' \itemize{ #' \item ae_catvar grouping variable for severity like AESEV(MILD, MODERATE, -#' SEVERE). It must also have it's numeric variable in the dataset. +#' SEVERE). It must be passed "/" separated with its numeric variable. +#' eg: ASEV/ASEVN; ATOXGR/ATOXGRN #' \item yvar(dptvar) Adverse Event category, derived term from AE. #' Possible Values: AEBODSYS, AEDECOD, AEHLT, AEHLGT. #' } @@ -151,18 +167,16 @@ tornado_plot <- function(datain, #' data(tornado_plot_data) #' #' process_tornado_data( -#' dataset_adsl = tornado_plot_data[["adsl"]], -#' dataset_analysis = tornado_plot_data[["adae"]], +#' dataset_adsl = adsl, +#' dataset_analysis = adae, #' adsl_subset = "SAFFL == 'Y'", -#' analysis_subset = NA_character_, -#' ae_filter = "Treatment emergent", +#' analysis_subset = "TRTEMFL == 'Y'", #' obs_residual = "30", #' fmq_data = NA, -#' ae_catvar = "AESEV", -#' trtvar = "ARMCD", -#' trt_left = "A", -#' trt_right = "A", -#' pop_fil = "Overall Population", +#' ae_catvar = "AESEV/AESEVN", +#' trtvar = "ARM", +#' trt_left = "Xanomeline High Dose", +#' trt_right = "Xanomeline Low Dose", #' pctdisp = "TRT", #' denom_subset = NA_character_, #' legendbign = "N", @@ -174,8 +188,9 @@ process_tornado_data <- dataset_analysis, adsl_subset = NA_character_, analysis_subset = NA_character_, - ae_filter = "Any Event", obs_residual = NA_real_, + ae_filter = "Any Event", + pop_fil = NA_character_, fmq_data = NULL, split_by = NA_character_, ae_catvar, @@ -183,45 +198,50 @@ process_tornado_data <- trt_left, trt_right, trtsort = NA_character_, - pop_fil = "Overall Population", + subset = NA_character_, pctdisp = "TRT", denom_subset = NA_character_, legendbign = "N", - yvar) { + yvar = "AESOC") { # Check data sets are not empty - # stopifnot("ADSL data is empty" = nrow(dataset_adsl) != 0) + stopifnot("ADSL data is empty" = nrow(dataset_adsl) != 0) stopifnot("Analysis data is empty" = nrow(dataset_analysis) != 0) - - # stopifnot(all(c(ae_catvar, paste0(ae_catvar, "N")) %in% - # toupper(names(dataset_analysis)))) - - # Merge with adsl - # adsl_merged <- adsl_merge( - # adsl = dataset_adsl, - # adsl_subset = adsl_subset, - # dataset_add = dataset_analysis - # ) - + maxvar <- str_to_vec(ae_catvar, "/") + numvar <- ifelse(length(maxvar) > 1, maxvar[2], paste0(maxvar[1], "N")) + stopifnot(all(c(numvar, maxvar[1]) %in% toupper(names(dataset_analysis)))) # Pre-Processing data for Adverse Event data_pre <- ae_pre_processor( datain = dataset_analysis, + subset = analysis_subset, ae_filter = ae_filter, obs_residual = obs_residual, - fmq_data = fmq_data + fmq_data = fmq_data, + max_sevctc = "SEV", + sev_ctcvar = numvar, + hterm = character(0), + lterm = yvar ) + # Merge with adsl if exists + if (is.data.frame(dataset_adsl)) { + data_pro <- adsl_merge( + adsl = dataset_adsl, + adsl_subset = adsl_subset, + dataset_add = data_pre$data + ) + } else { + data_pro <- data_pre$data + } # Data mentry processing mentry_out <- mentry( - data_pre$data, - subset = analysis_subset, - byvar = ae_catvar, + data_pro, + subset = subset, + byvar = maxvar, subgrpvar = str_remove_all(split_by, " "), trtvar = trtvar, trtsort = trtsort, pop_fil = pop_fil - ) |> - group_by(!!sym(trtvar), SUBJID, !!sym(yvar)) |> - filter(!!sym(paste0(ae_catvar, "N")) == max(!!sym(paste0(ae_catvar, "N")))) + ) stopifnot( "Given Subsets not present in Analysis Data" = nrow(mentry_out) != 0 @@ -234,7 +254,8 @@ process_tornado_data <- denom_subset = denom_subset, uniqid = "USUBJID", dptvar = yvar, - pctdisp = pctdisp + pctdisp = pctdisp, + sparseyn = "N" ) |> (\(x) { mutate(x, YVAR = as.numeric(PCT), diff --git a/R/utils.R b/R/utils.R index 99dc654..474b696 100644 --- a/R/utils.R +++ b/R/utils.R @@ -44,7 +44,6 @@ data_attrib <- function(datain) { data_attr } - ## Identify any variable names starting with given string. Useful for Byvar,subgrp identification ## #' Find column names with starting pattern #' @@ -110,103 +109,6 @@ round_f <- function(x, digits = 2) { format(round(x, digits), nsmall = digits) } -#' Update functions to round values -#' -#' @param f List of names of summary statistics. -#' @param d Numeric values -#' @param ... -#' -#' @return Rounded numeric values -#' @noRd -#' -fmtrd <- function(f, d = 2, ...) { - function(x) { - dc <- do.call(f, args = list(x, na.rm = TRUE, ...)) - ifelse(is.na(dc), "-", round_f(dc, d)) - } -} - -#' Create summary stats function for use within `msumstat()` -#' -#' @param sigdec Number of significant decimal places (base) -#' -#' @return a named list containing function definition for all defined summary -#' statistics - mean, min, max, median, iqr, var, sum, sd, q25, q75, p1, p5, -#' p10, p90, p95, p99 (where last digits represent % of quantile), meansd, -#' range, q1q3, medianrange (concatenation of indicated names), whiskerlow, -#' whiskerup, outliers in the Tukey method for box statistics -#' @export -summary_functions <- function(sigdec = 2) { - # Basic functions for summary - base_fns <- c("mean", "min", "max", "median", "IQR", "var", "sum", "sd") - d <- c(rep(sigdec, 7), sigdec + 1) - fns_list <- map(seq_along(base_fns), function(f) { - fmtrd(f = base_fns[[f]], d = d[[f]]) - }) |> set_names(tolower(base_fns)) - # Quantiles for data: - q_fns <- c("q25", "q75", "p1", "p10", "p5", "p90", "p95", "p99") - q_pct <- as.numeric(gsub("\\D", "", q_fns)) / 100 - q_list <- seq_along(q_fns) |> - map(function(f) fmtrd(f = "quantile", d = sigdec, q_pct[[f]])) |> - set_names(q_fns) - # Combined list - fns_list <- append(fns_list, q_list) - # Concatenated and Compound functions - fns_list <- append( - fns_list, - list( - meansd = - function(x) paste0(fns_list[["mean"]](x), " (", fns_list[["sd"]](x), ")"), - range = function(x) { - paste0( - "(", fns_list[["min"]](x), ", ", - fns_list[["max"]](x), ")" - ) - }, - q1q3 = function(x) { - paste0( - "(", fns_list[["q25"]](x), ", ", - fns_list[["q75"]](x), ")" - ) - }, - medianrange = - function(x) paste(fns_list[["median"]](x), fns_list[["range"]](x)), - whiskerlow = function(x) { - fns_list[["min"]]( - x[(x >= (quantile(x, 0.25, na.rm = TRUE) - 1.5 * IQR(x, na.rm = TRUE))) & - (x <= quantile(x, 0.25, na.rm = TRUE))]) - }, - whiskerup = function(x) { - fns_list[["max"]]( - x[(x <= (quantile(x, 0.75, na.rm = TRUE) + 1.5 * IQR(x, na.rm = TRUE))) & - (x >= quantile(x, 0.75, na.rm = TRUE))]) - }, - outliers = function(x) { - x <- x[!is.na(x)] - paste(unique(x[x < as.numeric(fns_list[["whiskerlow"]](x)) | - x > as.numeric(fns_list[["whiskerup"]](x))]), collapse = "~") - }, - geom_lowci = function(x) { - ci <- 0.95 - x <- log(x) - margin_error <- qt(ci + (1 - ci) / 2, df = length(x) - 1) * sd(x) / sqrt(length(x)) - paste(exp(mean(x, na.rm = TRUE) - margin_error)) - }, - geom_upci = function(x) { - ci <- 0.95 - x <- log(x) - margin_error <- qt(ci + (1 - ci) / 2, df = length(x) - 1) * sd(x) / sqrt(length(x)) - paste(exp(mean(x, na.rm = TRUE) + margin_error)) - }, - geommean = function(x) { - x <- log(x) - paste(exp(mean(x, na.rm = TRUE))) - }, - n = function(x) paste(n()) - ) - ) - return(fns_list) -} #' Convert string to vector #' @@ -280,7 +182,7 @@ split_data_by_var <- function(datain, split_section_headers <- function(datain, split_by = "", split_by_prefix = "", - split_lab = "", + split_lab = " ", sep = "~") { stopifnot(is.data.frame(datain)) if (split_by == "" && split_by_prefix == "") { @@ -411,15 +313,13 @@ dataset_vignette <- function(df = NULL, disp_vars = NULL, subset = NA_character_ #' @return Data frame with `Big N`. #' @noRd add_bigN <- function(data, dsin, grpvar, modvar, subjid = "USUBJID") { + newvar <- paste0(modvar, "_BIGN") data <- dsin |> group_by(!!!syms(grpvar)) |> distinct(!!!syms(subjid)) |> summarise(BIGN = n()) |> (\(.) left_join(data, ., by = grpvar))() |> - mutate(across(any_of(modvar), - ~ paste0(.x, " (N=", .data[["BIGN"]], ")"), - .names = "{.col}_BIGN" - )) |> + mutate(!!newvar := paste0(.data[[modvar]], " (N=", .data[["BIGN"]], ")")) |> select(-all_of("BIGN")) if (length(modvar) == 1 && is.factor(data[[modvar]])) { newvar <- paste0(modvar, "_BIGN") @@ -454,8 +354,7 @@ add_bigN <- function(data, dsin, grpvar, modvar, subjid = "USUBJID") { #' msumstat( #' adsl_entry, #' dptvar = "AGE", -#' statvar = "meansd", -#' sigdec = 2, +#' statvar = "mean", #' dptvarn = 2 #' )$tsum |> #' display_bign_head(adsl_entry) @@ -511,6 +410,101 @@ display_bign_head <- function(datain, return(datain) } +#' Sparse empty categories/treatments with 0 +#' +#' @param datain Input data to be sparsed for missing categories/treatments/by vars +#' @param data_sparse Initial data to sparse with +#' @param sparseyn Sparse categories within by groups. (Y/N) +#' @param sparsebyvalyn Sparse by groups in data - takes precedence over `sparseyn` (Y/N) +#' @param BYVAR By Variables in data +#' @param BYVARN By Variables N equivalent +#' @param SUBGRP Subgroup Variables in data +#' @param SUBGRPN Subgroup Variables N equivalent +#' @param fillvar Variables to fill with `fill_with` +#' @param fill_with Value to fill empty `fillvar` with +#' +#' @return dataframe sparsed with values for empty categories +#' +#' @examples +#' data(adsl) +#' library(dplyr) +#' adsl_entry <- mentry(adsl, +#' byvar = "SEX", +#' trtvar = "TRT01A", +#' trtsort = "TRT01AN", +#' subset = "SAFFL == 'Y'" +#' ) +#' count <- adsl_entry |> +#' filter(SEX == "F") |> +#' group_by(BYVAR1, TRTVAR) |> +#' summarise(FREQ = length(unique(USUBJID))) +#' sparse_vals(count, +#' data_sparse = adsl_entry, +#' sparseyn = "N", +#' sparsebyvalyn = "Y", +#' "BYVAR1", +#' character(0), +#' "BYVAR1N", +#' character(0) +#' ) +#' +#' @noRd +sparse_vals <- function(datain, + data_sparse, + sparseyn = "Y", + sparsebyvalyn = "N", + BYVAR, + SUBGRP, + BYVARN, + SUBGRPN, + fillvar = "FREQ", + fill_with = 0) { + # Exit if neither are Y + if (!(sparseyn == "Y" || sparsebyvalyn == "Y")) { + return(datain) + } + TRTVAR <- var_start(datain, "TRTVAR") + if (sparsebyvalyn == "Y") { + byn <- c(BYVAR, SUBGRP) + if ("DPTVAL" %in% names(datain)) { + df_exp <- data_sparse |> + tidyr::expand(!!!rlang::syms(c(BYVAR, TRTVAR, SUBGRP)), tidyr::nesting(DPTVAL, DPTVALN)) + dptn <- "DPTVALN" + } else { + if (!any(c(SUBGRP, "TRTVAR") %in% names(datain))) { + return(datain) + } + # Processing if msumstat output/without DPTVAL column + df_exp <- data_sparse |> + tidyr::expand(!!!rlang::syms(c(BYVAR, TRTVAR, SUBGRP))) + dptn <- character() + } + } else if (sparseyn == "Y") { + # Sparse only category columns + byn <- SUBGRP + dptn <- "DPTVALN" + df_exp <- data_sparse |> + tidyr::expand(!!!rlang::syms(c(TRTVAR, SUBGRP)), tidyr::nesting(DPTVAL, DPTVALN)) |> + left_join(distinct(data_sparse, across(any_of(starts_with(c("DPTVAL", "BYVAR"))))), + by = c("DPTVAL", "DPTVALN") + ) + } + data_sparse <- ungroup(data_sparse) + if (length(byn) > 0) { + for (b in byn) { + df_exp <- df_exp |> + left_join(distinct(data_sparse, across(all_of(starts_with(b)))), by = b) + } + } + df_exp <- distinct(df_exp) + datain |> + select(-any_of(c(SUBGRPN, BYVARN, dptn))) |> + (\(.) full_join(., df_exp, by = intersect(names(.), names(df_exp))))() |> + mutate(across(any_of(fillvar), ~ replace_na(.x, fill_with))) |> + ungroup() |> + distinct() +} + #' Report Metadata #' #' @return `data.frame` containing report metadata diff --git a/R/vx_boxplot.R b/R/vx_boxplot.R deleted file mode 100644 index 140b3ed..0000000 --- a/R/vx_boxplot.R +++ /dev/null @@ -1,221 +0,0 @@ -# Copyright 2024 Pfizer Inc -# -# Licensed under the Apache License, Version 2.0 (the "License"); -# you may not use this file except in compliance with the License. -# You may obtain a copy of the License at -# -# http://www.apache.org/licenses/LICENSE-2.0 -# -# Unless required by applicable law or agreed to in writing, software -# distributed under the License is distributed on an "AS IS" BASIS, -# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -# See the License for the specific language governing permissions and -# limitations under the License. -# -#' Process data for vaccine boxplot -#' -#' @inheritParams process_vx_scatter_data -#' @param ystat Additional Statistic to be calculated and plotted as markers. -#' Values: 'mean', 'sum', 'sd' etc -#' @param ada_nab_opts List of values of : *PARAMN*, Y axis Label, Reference -#' line value and Dilution (for footnote) corresponding to ADA and NAb titers -#' respectively. Format: list(N = "1~2", -#' LAB = "ADA Titer (log2)~NAb Titer (log2)", REF = "6.23~1.58", DIL = "75~3") -#' -#' @return Dataframe containing analysis values for requisite box plot statistics -#' @export -#' -#' @examples -#' data(vx_box_data) -#' process_vx_box_data( -#' dataset_adsl = vx_box_data$adsl, -#' dataset_analysis = vx_box_data$adisda, -#' adsl_subset = "RANDFL == 'Y'", -#' analysis_subset = "((ANL08FL == 'Y')|(ANL09FL=='Y'))&(ARMCD!='')&(PARAMN %in% c(1, 2))", -#' trtvar = "TRTA", -#' trtsort = "TRTAN", -#' xvar = "AVISIT", -#' ystat = "mean" -#' ) -process_vx_box_data <- - function(dataset_adsl, - dataset_analysis, - adsl_subset = "SAFFL == 'Y'", - analysis_subset = "((ANL08FL == 'Y')|(ANL09FL=='Y'))&(ARMCD!='')", - split_by = NA_character_, - trtvar = "TRT01A", - trtsort = "TRT01AN", - xvar = "AVISIT", - yvar = "AVAL", - ystat = "mean", - legendbign = "Y", - ada_nab_opts = - list( - N = "1~2", - LAB = "ADA Titer (log2)~NAb Titer (log2)", - REF = "6.23~1.58", - DIL = "75~3" - )) { - # Check data sets are not empty - stopifnot("ADSL data is empty" = nrow(dataset_adsl) != 0) - stopifnot("Analysis data is empty" = nrow(dataset_analysis) != 0) - # Set subgroup variables (page/split variables) - subgrps <- ifelse(all(is.na(split_by)), "PARAM", - paste(c(split_by, "PARAM"), collapse = "~") - ) - # Merge with adsl - adsin_entry <- adsl_merge( - dataset_adsl, - adsl_subset, - dataset_analysis - ) |> - mentry( - subset = analysis_subset, - byvar = xvar, - subgrpvar = subgrps, - trtvar = trtvar, - trtsort = trtsort, - trttotalyn = "N", - sgtotalyn = "N", - add_grpmiss = "N", - pop_fil = NA - ) - stopifnot( - "Given Subsets not present in Analysis Data" = - nrow(adsin_entry) != 0 - ) - stats_data <- msumstat( - datain = adsin_entry, - dptvar = yvar, - statvar = c(ystat, "box"), - sigdec = 3 - ) - # Paramn subgrp var name: - psub <- max(var_start(stats_data$gsum, "SUBGRPVARN")) - # ADa_NaB data combined: - ada_nab_data <- - data.frame( - as.numeric(str_to_vec(ada_nab_opts$N)), - as.numeric(str_to_vec(ada_nab_opts$REF)), - str_to_vec(ada_nab_opts$LAB), - as.numeric(str_to_vec(ada_nab_opts$DIL)), - c("ADA", "NAb") - ) |> setNames(c(psub, "REF", "YLAB", "DIL", "TITER")) - # Merge with ada opts and create X variable; spltN var for plot title - stats <- plot_title_nsubj( - adsin_entry, - stats_data$gsum, - var_start(stats_data$gsum, "SUBGRP") - ) |> - mutate(XVAR = fct_reorder(str_to_title(.data[["BYVAR1"]]), .data[["BYVAR1N"]])) |> - dplyr::inner_join(ada_nab_data, by = psub) |> - plot_display_bign(adsin_entry, bignyn = legendbign) - return(stats) - } - - -#' Generate Vaccine Boxplots for antibody titer using analysed data -#' -#' Creates 2 similar plots with slightly different specifications according to -#' parameter i.e., ADA or NaB titer values are plotted in 2 separate graphs -#' -#' @param datalist List of Input datasets, retrieved from -#' `process_vx_box_data()` and `split_data_by_var()` -#' @inheritParams box_plot -#' -#' @details Input data should come from output of `process_vx_box_data()` and -#' is expected to have the standardised variable XVAR and ada_nab_opts -#' @return a list of lists, each of 2 elements: -#' \itemize{ -#' \item `plot` Plot output -#' \item `footnote` Text to be considered as first line of footnote in report -#' } -#' @export -#' -#' @examples -#' data(vx_box_data) -#' plot_data <- process_vx_box_data( -#' dataset_adsl = vx_box_data$adsl, -#' dataset_analysis = vx_box_data$adisda, -#' adsl_subset = "RANDFL == 'Y'", -#' analysis_subset = "((ANL08FL == 'Y')|(ANL09FL=='Y'))&(ARMCD!='')&(PARAMN %in% c(1, 2))", -#' trtvar = "TRTA", -#' trtsort = "TRTAN", -#' xvar = "AVISIT", -#' ystat = "mean", -#' legendbign = "Y" -#' ) -#' series_opts <- plot_aes_opts( -#' datain = plot_data, -#' series_color = c("red", "blue", "green"), -#' series_shape = c("circlefilled", "trianglefilled", "squarefilled"), -#' series_size = c(2, 2, 2) -#' ) -#' -#' # Splitting data to generate separate plots by `split_by` variable -#' data_list <- split_data_by_var( -#' datain = plot_data, -#' split_by_prefix = "SUBGRPVAR" -#' ) -#' -#' vx_box_plot( -#' datalist = data_list, -#' axis_opts = plot_axis_opts( -#' xaxis_label = "Visits" -#' ), -#' series_opts = series_opts, -#' legend_opts = list( -#' lab = "Treatment", -#' pos = "bottom", -#' dir = "horizontal" -#' ), -#' ystat = "mean" -#' )[[1]][[1]] -vx_box_plot <- function(datalist, - axis_opts, - series_opts, - legend_opts = list( - lab = "", pos = "bottom", - dir = "horizontal" - ), - box_opts = c(0.7, 0.9), - ystat = "mean", - griddisplay = "N") { - datalist |> - map(function(df) { - stopifnot(is.data.frame(df)) - axis_opts$yaxis_label <- unique(df$YLAB) - titerp <- box_plot( - datain = df, - legend_opts = legend_opts, - series_opts = series_opts, - axis_opts = axis_opts, - series_var = "TRTVAR", - series_labelvar = ifelse("TRTTXT" %in% names(df), "TRTTXT", "TRTVAR"), - box_opts = box_opts, - ystat = ystat, - griddisplay = griddisplay, - plot_title = glue("Number of Participants N = {unique(df$splitN)}") - ) + - geom_line( - aes( - x = XVAR, - y = .data[[ystat]], - group = TRTVAR, - color = TRTVAR - ), - position = position_dodge(box_opts[2]) - ) + - geom_hline( - yintercept = unique(df$REF), - linetype = 2, - color = "black" - ) - ftnote <- glue( - "Reference line at Y = {unique(df$REF)} represents the detection limit\\ - in the {unique(df$TITER)} assay (minimum required dilution \\ - {unique(df$DIL)})" - ) - list(plot = titerp, footnote = ftnote) - }) -} diff --git a/data/adae.rda b/data/adae.rda index 3500047..ec03f88 100644 Binary files a/data/adae.rda and b/data/adae.rda differ diff --git a/data/adlb.rda b/data/adlb.rda index 98e403c..4be02b6 100644 Binary files a/data/adlb.rda and b/data/adlb.rda differ diff --git a/data/ae_risk.rda b/data/ae_risk.rda deleted file mode 100644 index 94beb32..0000000 Binary files a/data/ae_risk.rda and /dev/null differ diff --git a/inst/templates/adae_r001_template.Rmd b/inst/templates/adae_r001_template.Rmd deleted file mode 100644 index 676db85..0000000 --- a/inst/templates/adae_r001_template.Rmd +++ /dev/null @@ -1,101 +0,0 @@ ---- -title: "Adverse Event Table" -output: - html_document: - df_print: paged -params: - population_filter: "SAFFL" - ae_filter: "Any Event" - aSubset: "AOCCPFL=='Y'" - dSubset: "!is.na(ASTDT)" - trtvar: "TRTA" - trtsort: "TRTAN" - obs_period: "Overall Duration" - obs_residual: 28 - eventvar: "AEDECOD" - eventbyvar: "AEBODSYS" - summary_by: "Patients" - ctrlgrp: "Placebo" - trtgrp: "Xanomeline Low Dose" - subgrpvar: "" - subgrptot: "N" - alpha: 0.05 - cutoff: 5 - sort_opt: "Ascending" - sort_var: "Count" - riskyn: "Y" - statistics: "Risk Ratio" - trttotalyn: "N" - bign: "Y" - grpvarmiss: "N" - pctdisp: "TRT" ---- - -```{r setup, include=FALSE} -knitr::opts_chunk$set(echo = FALSE) -library(carver) -``` - -```{r processing, include=FALSE} - -data(adae) -data(FMQ_Consolidated_List) - -# Default is for higher level term = "AEBODSYS" and lower level term = "AEDECOD" - -# For higher or lower term to be FMQ, pass FMQ_NAM in aeEventVar or aeByvar and fmq_data as -# FMQ_Consolidated_List dataframe - -## Calling AE pre-processing to apply all the AE user requirements -ae_pre <- ae_pre_processor( - datain = adae, - aeSubset = params$aSubset, - aeDenomSubset = params$dSubset, - ae_filter = params$ae_filter, - aeObsPeriod = params$obs_period, - aeObsResidual = params$obs_residual, - trtvar = params$trtvar, - trtsort = params$trtsort, - pop_fil = params$population_filter, - fmq_data = FMQ_Consolidated_List, - aeEventVar = params$eventvar, - aeByVar = params$eventbyvar, - aeSubGrpVar = ifelse(params$subgrpvar == "", NA, params$subgrpvar), - aeBigN = params$bign, - aeGrpVarMiss = params$grpvarmiss, - aeTrtTot = params$trttotalyn, - aeSubGrpTot = params$subgrptot -) - -# Summary Table -## The function arguments ctrgrp and trtgrp are only used when 'riskyn' is passed as "Y": -## count summary table with pair-wise risk statistic to be displayed -## When riskyn is passed as "N": a table with count summary of all treatments and no risk statistic -## is created - -toutput <- adae_r001( - datain = ae_pre, - population = params$population_filter, - AE_Filter = params$ae_filter, - riskyn = params$riskyn, - summary_by = params$summary_by, - ctrlgrp = params$ctrlgrp, - trtgrp = params$trtgrp, - ui_lt = params$eventvar, - ui_ht = params$eventbyvar, - ui_statistics = params$statistics, - ui_trttotalyn = params$trttotalyn, - ui_trtbign = params$bign, - ui_alpha = params$alpha, - ui_cutoff = params$cutoff, - ui_sortopt = params$sort_opt, - ui_sortvar = params$sort_var -) -``` - -```{r , echo = FALSE, warning = FALSE, message = FALSE, results="asis"} - -cat(gsub(pattern = "\n", replacement = " \n", x = toutput$title), "\n") -toutput$tout -cat(gsub(pattern = "\n", replacement = " \n", x = toutput$footnote), "\n") -``` diff --git a/inst/templates/adsl_summary.Rmd b/inst/templates/adsl_summary.Rmd new file mode 100644 index 0000000..76e4024 --- /dev/null +++ b/inst/templates/adsl_summary.Rmd @@ -0,0 +1,119 @@ +--- +output: + pdf_document: + toc: no + dev: cairo_pdf + latex_engine: xelatex + html_document: + toc: no + toc_float: yes + toc_collapsed: no + highlight: kate + theme: spacelab + fig_caption: yes + df_print: paged +classoption: landscape, a4paper +geometry: margin=1in +params: + ADSL_DSIN: adsl + POPULATION_FILTER: SAFFL + OVERALL_SUBSET: !r NA_character_ + A_SUBSET: !r NA_character_ + DENOM_SUBSET: !r NA_character_ + TRTVAR: TRT01A + TRTSORT: TRT01AN + BYVAR: !r NA_character_ + BYLABEL: !r NA + SUBGRPVAR: SEX + TRTBIGN: yes + SUBBIGN: no + GRPVARMISS: no + TRTTOT: yes + SUBGRPTOT: yes + PCTDISP: TRT + VARS: "AGEGR1/AGEGR1N~AGE-S~SEX/SEXN~RACE/RACEN~ETHNIC" + VARLABELS: Age (Years), n (%)~NONE~Gender, n (%)~Race, n (%)~Ethnicity, n (%) + STATVARS: "n~mean(sd)~median(minmax)~q1q3" + STATLABELS: n~Mean (SD)~Median (range)~(Q1,Q3) + TOTALCATYN: no + MISSCATYN: no + MISSCATLABEL: Missing + TITLE: "Demographic Characteristics - Safety population" + FOOTNOTE: "The denominator to calculate percentages is N, the Number of Participants + in the full analysis set, within each treatment group \\\\ *n is the Number of + Participants with non-missing Age" + head_height: 30pt +header-includes: + - \usepackage{fancyhdr} + - \usepackage{lastpage} + - \pagestyle{fancy} + - \fancyhf{} + - \renewcommand{\headrulewidth}{0pt} + - '`r paste0("\\fancyhead[L]{\\textbf{", params$TITLE, "}}")`' + - '`r paste0("\\fancyfoot[L]{", params$FOOTNOTE, "}")`' + - \setlength{\headsep}{10pt} + - \setlength{\headheight}{40pt} + - \fancyhead[R]{Page \thepage\, of\, \pageref*{LastPage}} +--- + +```{r setup, include=FALSE} +knitr::opts_chunk$set(echo = FALSE, ft.keepnext = FALSE, message = FALSE, warning = FALSE) +## load libraries +library(carver) +library(dplyr, include.only = c("if_else")) +library(stringr, include.only = c("str_glue", "str_replace_all", "str_which")) +library(rlang, include.only = c("parse_expr")) +library(flextable, include.only = c("width", "autofit", "height")) +is_html <- knitr::opts_knit$get("rmarkdown.pandoc.to") == "html" +``` + +```{r adsl_mentry} +adsl_mentry <- eval(parse_expr(params$ADSL_DSIN)) |> + mentry( + subset = params$OVERALL_SUBSET, + byvar = params$BYVAR, + trtvar = params$TRTVAR, + trtsort = params$TRTSORT, + subgrpvar = params$SUBGRPVAR, + trttotalyn = params$TRTTOT, + add_grpmiss = params$GRPVARMISS, + sgtotalyn = params$SUBGRPTOT, + pop_fil = params$POPULATION_FILTER + ) +``` + +```{r adsl_summary, results='asis', ft.align="left"} +if (is_html) { + cat("###", gsub(" \\\\ ", " \n", params$TITLE, fixed = TRUE), " \n") +} +adsl_mentry |> + adsl_summary( + vars = params$VARS, + stat_vars = params$STATVARS, + pctdisp = params$PCTDISP, + total_catyn = params$TOTALCATYN, + miss_catyn = params$MISSCATYN, + miss_catlabel = params$MISSCATLABEL, + a_subset = params$A_SUBSET, + denom_subset = params$DENOM_SUBSET + ) |> + display_bign_head( + mentry_data = adsl_mentry, + trtbignyn = params$TRTBIGN, + subbignyn = params$SUBBIGN + ) |> + tbl_processor( + dptlabel = params$VARLABELS, + statlabel = params$STATLABELS, + addrowvars = "DPTVAR" + ) |> + tbl_display( + bylabel = params$BYLABEL + ) |> + flextable::autofit() |> + {\(x) width(x, width = dim(x)$widths * 8 / sum(dim(x)$widths))}() # nolint +if (is_html) { + cat(gsub(" \\\\ ", " \n", params$FOOTNOTE, fixed = TRUE)) +} +``` + diff --git a/inst/templates/ae_forest_plot.Rmd b/inst/templates/ae_forest_plot.Rmd new file mode 100644 index 0000000..afbdb4b --- /dev/null +++ b/inst/templates/ae_forest_plot.Rmd @@ -0,0 +1,185 @@ +--- +output: + pdf_document: + html_document: + df_print: paged +classoption: landscape, a4paper +params: + ADSL_DSIN: adsl + A_DSIN: adae + ADSL_SUBSET: !r NA_character_ + POPULATION_FILTER: SAFFL + OVERALL_SUBSET: !is.na(ASTDT) + AE_FILTER: TREATMENT EMERGENT + A_SUBSET: !r NA + AEOBSRESIDUAL: !r NA_real_ + TRTVAR: TRTA + TRTSORT: TRTAN + FMQ_DATA: FMQ_Consolidated_List + LEGEND_BIGN: Y + GRPVARMISS: N + SUMMARY_BY: Patients + HT: AEBODSYS + EVENT_VAR: AEDECOD + CTRLGRP: Placebo + TRTGRP: Xanomeline High Dose~~Xanomeline Low Dose + CUTOFF_WHERE: "FREQ > 5" + STATISTICS: Risk Ratio + ALPHA: 0.05 + SORTOPT: Ascending + SORTVAR: Count + SORT_BY_HT: N + SERIES_COLOR: black~royalblue2~goldenrod~orchid3~brown~pink + SERIES_SYMBOL: !r NA + SERIES_SYMSIZE: !r rep(1, 5) + TRTPAIR_COLOR: "#F8766D~#7CAE00~#00BFC4~#C77CFF" + HT_DISPYN: N + PVALUE_DISPYN: Y + XAXISOPTS: !r list(labelsize = 8, labelface = "plain", ticksize = 6, tickface = "plain") + XAXISLINEAROPTS: !r list() + XAXISLABEL: Risk Ratio + XAXIS_SCALE: identity + TERM_LABEL: "" + TEXT_SIZE: 2.4 + RISK_REFVAL: 1 + HLT_SIGYN: Y + PVALUE_SIG: 0.05 + TERMS_PERPAGE: 15 + PAIRWISE: N + TITLE: "Forest plot for Risk Ratio of Treatment Emergent Adverse Events" + FOOTNOTE: "n is the number of Participants \\\\ Classifications of adverse events are based on the + Medical Dictionary for Regulatory Activities. (MedDRA v21.1) \\\\ Dashed Vertical line represents risk value reference line \\\\ The number of participants reporting at least 1 occurrence of the event specified." + WIDTHS: "0.55~0.35~0.1" + INTERACTIVE: N +header-includes: + - \usepackage{fancyhdr} + - \usepackage{lastpage} + - \pagestyle{fancy} + - \fancyhf{} + - \fancyhead[R]{Page \thepage\, of\, \pageref*{LastPage}} + - \renewcommand{\headrulewidth}{0pt} + - '`r paste0("\\fancyhead[L]{\\textbf{", params$TITLE, "}}")`' + - '`r paste0("\\fancyfoot[L]{", params$FOOTNOTE, "}")`' + - \setlength{\headsep}{10pt} + - \setlength{\headheight}{50pt} +--- + +```{r setup, include=FALSE} +knitr::opts_chunk$set( + echo = FALSE, warning = FALSE, message = FALSE, fig.width = 11.5, + fig.height = 6, fig.align = "center" +) +## load libraries +library(carver) +library(purrr, include.only = "walk") +library(rlang, include.only = "parse_expr") +is_html <- knitr::opts_knit$get("rmarkdown.pandoc.to") == "html" +title <- gsub("\\\\", "
", params$TITLE) +footer <- gsub("\\\\", "
", params$FOOTNOTE) +``` + +```{r adae_prep, message=FALSE, eval=TRUE} +## Prepare AE data +adae_prep <- eval(parse_expr(params$A_DSIN)) |> + ### Pre-process AE + ae_pre_processor( + fmq_data = eval(parse_expr(params$FMQ_DATA)), + ae_filter = params$AE_FILTER, + subset = params$A_SUBSET, + obs_residual = params$AEOBSRESIDUAL + ) +adae_merge <- eval(parse_expr(params$ADSL_DSIN)) |> + ### Merge with adsl + adsl_merge( + adsl_subset = params$ADSL_SUBSET, + dataset_add = adae_prep$data + ) + +## Apply subset filtering on processed AE data +adae_entry <- adae_merge |> + mentry( + subset = params$OVERALL_SUBSET, + byvar = params$HT, + trtvar = params$TRTVAR, + trtsort = params$TRTSORT, + add_grpmiss = params$GRPVARMISS, + pop_fil = params$POPULATION_FILTER + ) +``` + +```{r risk_statistic, message=FALSE, eval=TRUE} +# Calculate Risk Statistic and add bigN variable to treatment display legend: +plot_data <- risk_stat( + datain = adae_entry, + a_subset = adae_prep$a_subset, + summary_by = params$SUMMARY_BY, + eventvar = params$EVENT_VAR, + ctrlgrp = params$CTRLGRP, + trtgrp = params$TRTGRP, + statistics = params$STATISTICS, + alpha = params$ALPHA, + cutoff_where = params$CUTOFF_WHERE, + sort_opt = params$SORTOPT, + sort_var = params$SORTVAR, + g_sort_by_ht = params$SORT_BY_HT +) |> + plot_display_bign( + mentry_data = adae_entry, + bignyn = params$LEGEND_BIGN + ) +``` + +```{r plotoptions} +# Prepare graph options for plotting +series_opts <- plot_aes_opts( + datain = plot_data, + series_color = params$SERIES_COLOR, + series_shape = params$SERIES_SYMBOL, + series_size = as.numeric(params$SERIES_SYMSIZE) +) +axis_options <- plot_axis_opts( + xlinearopts = params$XAXISLINEAROPTS, + xopts = params$XAXISOPTS, + xaxis_label = params$XAXISLABEL, + xaxis_scale = params$XAXIS_SCALE +) |> + append(list(xpos = "top")) + +``` + +`r if (is_html) title` + +```{r output, results = "asis"} +# Create plot output +plot_list <- + ae_forest_plot( + datain = plot_data, + series_opts = series_opts, + trtpair_color = params$TRTPAIR_COLOR, + axis_opts = axis_options, + text_size = params$TEXT_SIZE, + term_label = params$TERM_LABEL, + risk_ref = params$RISK_REFVAL, + ht_dispyn = params$HT_DISPYN, + pvalue_dispyn = params$PVALUE_DISPYN, + highlight_sig = params$HLT_SIGYN, + pvalue_sig = params$PVALUE_SIG, + pairwise = params$PAIRWISE, + rel_widths = params$WIDTHS, + terms_perpg = params$TERMS_PERPAGE, + interactive = params$INTERACTIVE + ) +walk( + seq_along(plot_list), + function(i) { + print(plot_list[[i]]) + if (!is_html) { + cat("\n\n\n\\pagebreak\n") + } else { + cat("
") + } + } +) +``` + +`r if (is_html) footer` diff --git a/inst/templates/ae_tornado_plot.Rmd b/inst/templates/ae_tornado_plot.Rmd new file mode 100644 index 0000000..4570ac4 --- /dev/null +++ b/inst/templates/ae_tornado_plot.Rmd @@ -0,0 +1,160 @@ +--- +output: + pdf_document: + toc: no + html_document: + toc: no + toc_float: yes + toc_collapsed: no + highlight: kate + theme: spacelab + fig_caption: yes + df_print: paged +params: + ADSL_DSIN: adsl + ADSL_SUBSET: "SAFFL == 'Y'" + A_DSIN: adae + A_SUBSET: "TRTEMFL == 'Y'" + S_TRTVAR: ARM + TRTSORT: !r NA_character_ + TRT1: "Xanomeline High Dose" + TRT1_LABEL: Drug A + TRT2: "Xanomeline Low Dose" + TRT2_LABEL: Drug B + GROUP: AESEV + FMQ_DATA: !r NA_character_ + AEOBSRESIDUAL: !r 30 + DENOM_SUBSET: !r NA_character_ + PCTDISP: TRT + SPLITBY: !r NA_character_ + SPLITLAB: "" + BARCHART_OPTIONS: !r list(bar_width = 0.5) + D_MARKER_COLOR: blue~yellow~red + LEGENDOPTS: !r list(label = "Severity", pos = c(0.15, 0.15), dir = "vertical") + XAXIS_LABEL: Percentage of Subjects + XAXISLINEAROPTS: !r list(breaks = seq(-100, 100, 10), labels = (c(seq(100, 0, -10), seq(10, 100, 10)))) + YAXIS_GRID: N + YAXIS_LABEL: Primary System Organ Class + YAXIS_VAR: AESOC + LEGEND_BIGN: N + TITLE: "Tornado Plot" + FOOTNOTE: "" +header-includes: + - \usepackage{fancyhdr} + - \usepackage{lastpage} + - \pagestyle{fancy} + - \fancyhf{} + - \fancyhead[R]{Page \thepage\, of\, \pageref*{LastPage}} + - \renewcommand{\headrulewidth}{0pt} + - '`r paste0("\\fancyhead[L]{\\textbf{", params$TITLE, "}}")`' + - '`r paste0("\\fancyfoot[L]{", params$FOOTNOTE, "}")`' + - \setlength{\headsep}{10pt} + - \setlength{\headheight}{50pt} +--- + +```{r setup, include=FALSE} +knitr::opts_chunk$set(echo = FALSE, warning = FALSE, message = FALSE) +library(carver) +library(dplyr) +library(ggplot2) +library(purrr) +library(rlang, include.only = "parse_expr") + +is_html <- knitr::opts_knit$get("rmarkdown.pandoc.to") == "html" +title <- gsub("\\\\", "
", params$TITLE) +footer <- gsub("\\\\", "
", params$FOOTNOTE) +``` + +```{r tornado_data, message=FALSE, eval=TRUE} +# Tornado Plot Preprocess +plot_data <- + process_tornado_data( + dataset_adsl = eval(parse_expr(params$ADSL_DSIN)), + dataset_analysis = eval(parse_expr(params$A_DSIN)), + adsl_subset = params$ADSL_SUBSET, + analysis_subset = params$A_SUBSET, + obs_residual = params$AEOBSRESIDUAL, + fmq_data = params$FMQ_DATA, + ae_catvar = params$GROUP, + split_by = params$SPLITBY, + trtvar = params$S_TRTVAR, + trt_left = params$TRT1, + trt_right = params$TRT2, + trtsort = params$TRTSORT, + pctdisp = params$PCTDISP, + denom_subset = params$DENOM_SUBSET, + legendbign = params$LEGEND_BIGN, + yvar = params$YAXIS_VAR + ) + +## Split Data by grouping variables `SPLITBY` +data_list <- split_data_by_var( + datain = plot_data, + split_by_prefix = ifelse( + !is.na(params$SPLITBY) & params$SPLITBY != "", + "SUBGRPVAR", "" + ) +) + +``` + +```{r,echo=FALSE, message=FALSE, eval=TRUE , warning=FALSE, results='hide'} +series_opts <- g_seriescol(plot_data, params$D_MARKER_COLOR, "BYVAR1") + +# Create plot output +plot_list <- map( + seq_along(data_list), + function(i) { + stopifnot(is.data.frame(data_list[[i]])) + stopifnot(nrow(data_list[[i]]) > 0) + tornado_plot( + datain = data_list[[i]], + trt_left_label = params$TRT1_LABEL, + trt_right_label = params$TRT2_LABEL, + bar_width = params$BARCHART_OPTIONS$bar_width, + axis_opts = plot_axis_opts( + xaxis_label = params$YAXIS_LABEL, + yaxis_label = params$XAXIS_LABEL, + ylinearopts = params$XAXISLINEAROPTS + ), + legend_opts = params$LEGENDOPTS, + series_opts = series_opts, + griddisplay = params$YAXIS_GRID + ) + } +) +``` + +`r if (is_html) title` + +```{r output, fig.align='right', fig.height=6, fig.width=9, warning=FALSE, results = "asis"} +# Split section headers +section_headers <- + split_section_headers( + datain = plot_data, + split_by_prefix = if_else( + params$SPLITBY == "" | + is.na(params$SPLITBY), + "", "SUBGRPVAR" + ), + split_lab = params$SPLITLAB + ) + + +## printing plot outputs +walk( + seq_along(plot_list), + function(i) { + cat("#### ", section_headers[[i]], "\n\n") + print(plot_list[[i]]) + cat("\n") + if (!is_html) { + cat("\n\n\n\\pagebreak\n") + } else { + cat("\n") + } + } +) +``` + +`r if (is_html) footer` diff --git a/inst/templates/ae_volcano_plot.Rmd b/inst/templates/ae_volcano_plot.Rmd new file mode 100644 index 0000000..8b1e43b --- /dev/null +++ b/inst/templates/ae_volcano_plot.Rmd @@ -0,0 +1,155 @@ +--- +output: + html_document: + df_print: paged + pdf_document: +classoption: landscape, a4paper +params: + ADSL_DSIN: adsl + A_DSIN: adae + ADSL_SUBSET: !r NA_character_ + POPULATION_FILTER: SAFFL + OVERALL_SUBSET: !is.na(ASTDT) + AE_FILTER: TREATMENT EMERGENT + A_SUBSET: !r NA + AEOBSRESIDUAL: !r NA_real_ + TRTVAR: TRTA + TRTSORT: TRTAN + FMQ_DATA: FMQ_Consolidated_List + LEGEND_BIGN: Y + GRPVARMISS: N + SUMMARY_BY: Patients + HT: AEBODSYS + EVENT_VAR: AEDECOD + CTRLGRP: Placebo + TRTGRP: Xanomeline High Dose + CTRLGRP_LAB: Control + TRTGRP_LAB: Exposure + CUTOFF_WHERE: "FREQ > 5" + STATISTICS: Risk Ratio + ALPHA: 0.05 + SORTOPT: Ascending + SORTVAR: Count + XAXISOPTS: !r list(labelsize = 8, labelface = "plain", ticksize = 8, tickface = "plain") + YAXISOPTS: !r list(labelsize = 8, labelface = "plain", ticksize = 8, tickface = "plain") + XAXISLINEAROPTS: !r list() + LEGENDOPTS: !r list(label = "", pos = "bottom", dir = "horizontal") + PVALUE_TRANS: "-log10" + REF_OFFSET: 1 + PVALUE_SIG: 0.05 + INTERACTIVE: N + TITLE: "Volcano plot for {params$STATISTICS} of {str_to_title(params$AE_FILTER)} Adverse Events" + FOOTNOTE: !r c("N is the total number of {summary_by}", "Classifications of adverse events are based on the Medical Dictionary for Regulatory Activities. (MedDRA v21.1)", "Dashed Horizontal line represents incidence percentage reference line.", "Totals for the No. of Participants/Events at a higher level are not necessarily the sum of those at the lower levels since a participant may report two or more.") +--- + +```{r setup, include=FALSE} +knitr::opts_chunk$set( + echo = FALSE, warning = FALSE, message = FALSE, fig.width = 8, + fig.height = 5, fig.align = "center" +) +## load libraries +library(carver) +library(rlang, include.only = "parse_expr") +library(stringr, include.only = "str_to_title") +title <- glue::glue(params$TITLE) +if (tolower(params$SUMMARY_BY) != "events") { + summary_by <- "participants" + footnote <- "The number of participants reporting at least 1 occurrence of the event specified." +} else { + summary_by <- "events" + footnote <- "Event counts are the sum of individual occurrences within that category." +} +footer <- glue::glue(paste(params$FOOTNOTE, collapse = " \n"), " \n", footnote) +``` + +```{r adae_prep, message=FALSE, eval=TRUE} +## Prepare AE data +adae_prep <- eval(parse_expr(params$A_DSIN)) |> + ### Pre-process AE + ae_pre_processor( + fmq_data = eval(parse_expr(params$FMQ_DATA)), + ae_filter = params$AE_FILTER, + obs_residual = params$AEOBSRESIDUAL + ) +adae_merge <- eval(parse_expr(params$ADSL_DSIN)) |> + ### Merge with adsl + adsl_merge( + adsl_subset = params$ADSL_SUBSET, + dataset_add = adae_prep$data + ) +``` + +```{r adae_mentry, message=FALSE, eval=TRUE} + +## Apply subset filtering on processed AE data +adae_entry <- adae_merge |> + mentry( + subset = params$OVERALL_SUBSET, + byvar = params$HT, + trtvar = params$TRTVAR, + trtsort = params$TRTSORT, + add_grpmiss = params$GRPVARMISS, + pop_fil = params$POPULATION_FILTER + ) +# Calculate Risk Statistic +adae_risk <- risk_stat( + datain = adae_entry, + a_subset = adae_prep$a_subset, + summary_by = params$SUMMARY_BY, + eventvar = params$EVENT_VAR, + ctrlgrp = params$CTRLGRP, + trtgrp = params$TRTGRP, + statistics = params$STATISTICS, + alpha = params$ALPHA, + cutoff_where = params$CUTOFF_WHERE, + sort_opt = params$SORTOPT, + sort_var = params$SORTVAR +) |> + plot_display_bign(mentry_data = adae_entry, bignyn = params$LEGEND_BIGN) +``` + +```{r plot} +# Get volcano specific options +volcano_opts <- adae_risk |> + ae_volcano_opts( + trt1_label = params$CTRLGRP_LAB, + trt2_label = params$TRTGRP_LAB, + statistic = params$STATISTICS, + pvalue_trans = params$PVALUE_TRANS, + xref_offset = params$REF_OFFSET + ) +# Get remaining axis options - user can change volcano_opts, if desired +axis_options <- plot_axis_opts( + xlinearopts = params$XAXISLINEAROPTS, + ylinearopts = volcano_opts$ylinearopts, + xopts = params$XAXISOPTS, + yopts = params$YAXISOPTS, + xaxis_label = volcano_opts$xaxis_label, + yaxis_label = volcano_opts$yaxis_label, + yaxis_scale = volcano_opts$yaxis_scale +) + +# Create plot output +plot_output <- adae_risk |> + ae_volcano_plot( + axis_opts = axis_options, + legend_opts = params$LEGENDOPTS, + xref = volcano_opts$xref, + pvalue_sig = params$PVALUE_SIG, + interactive = params$INTERACTIVE + ) +``` + +```{r output, results = "asis"} +cat("####", title, " \n") +plot_output +cat(" \n", footer, "\n\n\n\\pagebreak\n") +``` + +```{css styling} +h4 { + font-size: 14px; + font-weight: bold; + color: #666666 !important; +} +``` diff --git a/inst/templates/event_analysis.Rmd b/inst/templates/event_analysis.Rmd index 1ffe58b..0612a4b 100644 --- a/inst/templates/event_analysis.Rmd +++ b/inst/templates/event_analysis.Rmd @@ -1,79 +1,105 @@ --- -title: "event_analysis" -output: rmarkdown::html_vignette +output: + pdf_document: + html_document: + df_print: paged +classoption: landscape, a4paper params: - Population_Filter: "Overall" - data_filter: "" - trtvar: "TRTA" - obs_period: "Overall Duration" - obs_residual: 28 - pop: "SAFFL=='Y'" - query_var: "FMQ_NAM" - query_val: "Erythema" - query_scope: "Narrow" - pt_val: "Erythema" - ref_line: 2 -vignette: > - %\VignetteIndexEntry{event_analysis} - %\VignetteEngine{knitr::rmarkdown} - %\VignetteEncoding{UTF-8} + A_DSIN: adae + OVERALL_SUBSET: "!is.na(ASTDT)" + AE_FILTER: TREATMENT EMERGENT + A_SUBSET: "AOCCPFL == 'Y'" + AEOBSRESIDUAL: !r NA_real_ + TRTVAR: TRTA + TRTSORT: TRTAN + FMQ_DATA: FMQ_Consolidated_List + SUMMARY_BY: Events + HT_VAR: "FMQ_NAM" + HT_VAL: "ABDOMINAL PAIN" + HT_SCOPE: "Narrow" + LT_VAR: "AEDECOD" + LT_VAL: "ABDOMINAL DISCOMFORT" + LT_SCOPE: "Narrow" + REFVAL: 2 + TITLE: "Adverse Event Analysis of FMQ and PT" + FOOTNOTE: "" + INTERACTIVE: N +header-includes: + - \usepackage{fancyhdr} + - \usepackage{lastpage} + - \pagestyle{fancy} + - \fancyhf{} + - \fancyhead[R]{Page \thepage\, of\, \pageref*{LastPage}} + - \renewcommand{\headrulewidth}{0pt} + - '`r paste0("\\fancyhead[L]{\\textbf{", params$TITLE, "}}")`' + - '`r paste0("\\fancyfoot[L]{", params$FOOTNOTE, "}")`' + - \setlength{\headsep}{10pt} + - \setlength{\headheight}{50pt} --- ```{r setup, include = FALSE} knitr::opts_chunk$set( - collapse = TRUE, - comment = "#>" + echo = FALSE, warning = FALSE, message = FALSE, fig.width = 10, + fig.height = 5, fig.align = "center" ) +## load libraries +library(carver) +library(rlang, include.only = "parse_expr") ``` -```{r, include = FALSE} -devtools::load_all() +```{r adae_prep} -data(adsl, package = "carver") -data(adae, package = "carver") -data(FMQ_Consolidated_List, package = "carver") - -adsl_merge <- adsl_merge( - adsl = adsl, - pop = params$pop, - analysis_data = adae -) - - -data_in <- data_processing( - datain = adsl_merge, - Population_Filter = params$Population_Filter, - data_filter = params$data_filter, - trtvar = params$trtvar, - obs_period = params$obs_period, - obs_residual = params$obs_residual, - fmq_query_list = FMQ_Consolidated_List +## Prepare AE data +adae_prep <- eval(parse_expr(params$A_DSIN)) |> + ### Pre-process AE + ae_pre_processor( + fmq_data = eval(parse_expr(params$FMQ_DATA)), + ae_filter = params$AE_FILTER, + subset = params$A_SUBSET, + obs_residual = params$AEOBSRESIDUAL + ) +adae_entry <- mentry( + adae_prep$data, + subset = params$OVERALL_SUBSET, + trtvar = params$TRTVAR, + trtsort = params$TRTSORT, + trttotalyn = "N", + byvar = params$HT_VAR ) +prep_event_analysis <- adae_entry |> + process_event_analysis( + a_subset = adae_prep$a_subset, + summary_by = params$SUMMARY_BY, + hterm = params$HT_VAR, + ht_val = params$HT_VAL, + ht_scope = params$HT_SCOPE, + lterm = params$LT_VAR, + lt_val = params$LT_VAL, + lt_scope = params$LT_SCOPE + ) -goutput <- event_analysis( - data_in, - query_var = params$query_var, - query_val = params$query_val, - query_scope = params$query_scope, - pt_val = params$pt_val, - ref_line = params$ref_line +plot_output <- event_analysis_plot( + datain = prep_event_analysis, + fig.align = "h", + disp.proportion = "4~6", + ref_line = params$REFVAL, + x_tickangle = 15, + pt_color = "royalblue3", + interactive = params$INTERACTIVE ) +``` - -ft_out <- title_ftnote( - summary_by = "Events", - filters = NULL, - statistics = NULL, - report = "event analysis" -) +```{r, include=TRUE, echo=FALSE, results="asis"} +plot_output ``` - -```{r, include=TRUE, echo=FALSE, fig.height=5, fig.width=10, results="asis"} -cat(gsub(pattern = "\n", replacement = " \n", x = ft_out[1]), "\n") -goutput$ptly -cat(gsub(pattern = "\n", replacement = " \n", x = ft_out[2]), "\n") +```{css styling} +h4 { + font-size: 14px; + font-weight: bold; + color: #666666 !important; +} ``` diff --git a/inst/templates/forest_plot_template.Rmd b/inst/templates/forest_plot_template.Rmd deleted file mode 100644 index 03f1f7c..0000000 --- a/inst/templates/forest_plot_template.Rmd +++ /dev/null @@ -1,110 +0,0 @@ ---- -title: "Adverse Event Forest Plot" -output: - html_document: - df_print: paged -params: - population_filter: "SAFFL" - ae_filter: "Any Event" - aSubset: "AOCCPFL=='Y'" - dSubset: "!is.na(ASTDT)" - trtvar: "TRTA" - trtsort: "TRTAN" - obs_period: "Overall Duration" - obs_residual: 28 - eventvar: "AEDECOD" - eventbyvar: "AEBODSYS" - summary_by: "Patients" - ctrlgrp: "Placebo" - trtgrp: "Xanomeline Low Dose~~Xanomeline High Dose" - trttotalyn: "N" - bign: "Y" - grpvarmiss: "N" - alpha: 0.05 - cutoff: 5 - sort_opt: "Ascending" - sort_var: "Count" - series_color: "" - marker_shape: "" - statistics: "Risk Ratio" - xref: 1 - pvalcut: 0.05 - scale_trans: "identity" ---- - -```{r setup, include=FALSE} -knitr::opts_chunk$set(echo = FALSE) -library(carver) - -``` - - -```{r processing, include=FALSE} - -data(adae, package = "carver") -data(FMQ_Consolidated_List, package = "carver") - -# Default lower event term is AEDECOD and default high term is AEBODSYS. -# To make either as FMQ terms, pass aeEventVar or aeByVar as FMQ_NAM - -## Calling AE pre-processing to apply all the AE user requirements -ae_pre <- ae_pre_processor( - datain = adae, - aeSubset = params$aSubset, - aeDenomSubset = params$dSubset, - ae_filter = params$ae_filter, - aeObsPeriod = params$obs_period, - aeObsResidual = params$obs_residual, - trtvar = params$trtvar, - trtsort = params$trtsort, - pop_fil = params$population_filter, - fmq_data = FMQ_Consolidated_List, - aeEventVar = params$eventvar, - aeByVar = params$eventbyvar, - aeSubGrpVar = NA, - aeBigN = "N", - aeGrpVarMiss = params$grpvarmiss, - aeTrtTot = params$trttotalyn -) - -## calling get stat to calculate the risk values -stats <- risk_stat( - datain = ae_pre$dsin, - d_datain = ae_pre$dout, - eventVar = params$eventvar, - summary_by = params$summary_by, - ctrlgrp = params$ctrlgrp, - trtgrp = params$trtgrp, - statistics = params$statistics, - alpha = params$alpha, - cutoff = params$cutoff, - sort_opt = params$sort_opt, - sort_var = params$sort_var -) - - -## calling forest plot utility to generate forest plot and title footnote. -goutput <- forest_plot( - datain = stats, - AE_Filter = params$ae_filter, - review_by = c(params$eventbyvar, params$eventvar), - summary_by = params$summary_by, - statistics = params$statistics, - xref = params$xref, - pvalcut = params$pvalcut, - trtbign = params$bign, - scale_trans = params$scale_trans, - series_color = ifelse(params$series_color == "", NA, params$series_color), - marker_shape = ifelse(params$marker_shape == "", NA, params$marker_shape) -) - -``` - - - -```{r , warning = FALSE, message = FALSE, results="asis"} - -cat(gsub(pattern = "\n", replacement = " \n", x = goutput$title), "\n") -goutput$ptly -cat(gsub(pattern = "\n", replacement = " \n", x = goutput$footnote), "\n") -``` diff --git a/inst/templates/tornado_plot.Rmd b/inst/templates/tornado_plot.Rmd deleted file mode 100644 index 021bd38..0000000 --- a/inst/templates/tornado_plot.Rmd +++ /dev/null @@ -1,164 +0,0 @@ ---- -output: - pdf_document: - toc: no - html_document: - toc: no - toc_float: yes - toc_collapsed: no - highlight: kate - theme: spacelab - fig_caption: yes - df_print: paged -params: - G_ADSL_DSIN: tornado_plot_data[["adsl"]] - G_ADSL_SUBSET: "SAFFL == 'Y'" - G_A_DSIN: tornado_plot_data[["adae"]] - G_GTL_A_SUBSET: !r NA_character_ - G_S_TRTVAR: ARMCD - G_GTL_TRTSORT: !r NA_character_ - G_TRT1: A - G_TRT1_LABEL: Drug B - G_TRT2: A - G_TRT2_LABEL: Drug C - G_GROUP: AESEV - G_GTL_FMQ_DATA: !r NA_character_ - G_GTL_AE_FILTER: "Treatment emergent" - G_GTL_AEOBSRESIDUAL: !r 30 - G_GTL_DENOM_SUBSET: !r NA_character_ - G_GTL_POPULATION_FILTER: "Overall Population" - G_GTL_PCTDISP: TRT - G_GTL_SPLITBY: !r NA_character_ - G_GTL_SPLITLAB: "" - G_BARCHART_OPTIONS: !r list(bar_width = 0.5) - G_D_MARKER_COLOR: blue~yellow~red - G_GTL_LEGENDOPTS: !r list(label = "Severity", pos = c(0.15, 0.15), dir = "vertical") - G_XAXIS_LABEL: Percentage of Subjects - G_GTL_XAXISLINEAROPTS: !r list(breaks = seq(-100, 100, 10), labels = (c(seq(100, 0, -10), seq(10, 100, 10)))) - G_YAXIS_GRID: N - G_YAXIS_LABEL: Primary System Organ Class - G_YAXIS_VAR: AEBODSYS - G_GTL_LEGEND_BIGN: N - TITLE: "Tornado Plot" - FOOTNOTE: "" -header-includes: - - \usepackage{fancyhdr} - - \usepackage{lastpage} - - \pagestyle{fancy} - - \fancyhf{} - - \fancyhead[R]{Page \thepage\, of\, \pageref*{LastPage}} - - \renewcommand{\headrulewidth}{0pt} - - '`r paste0("\\fancyhead[L]{\\textbf{", params$TITLE, "}}")`' - - '`r paste0("\\fancyfoot[L]{", params$FOOTNOTE, "}")`' - - \setlength{\headsep}{10pt} - - \setlength{\headheight}{50pt} ---- - -```{r setup, include=FALSE} -knitr::opts_chunk$set(echo = FALSE, warning = FALSE, message = FALSE) -library(tlfcarver) -library(dplyr) -library(ggplot2) -library(purrr) -library(rlang, include.only = "parse_expr") - -is_html <- knitr::opts_knit$get("rmarkdown.pandoc.to") == "html" -title <- gsub("\\\\", "
", params$TITLE) -footer <- gsub("\\\\", "
", params$FOOTNOTE) -``` - -```{r tornado_data, message=FALSE, eval=TRUE} -# Tornado Plot Preprocess -plot_data <- - process_tornado_data( - dataset_adsl = eval(parse_expr(params$G_ADSL_DSIN)), - dataset_analysis = eval(parse_expr(params$G_A_DSIN)), - adsl_subset = params$G_ADSL_SUBSET, - analysis_subset = params$G_GTL_A_SUBSET, - ae_filter = params$G_GTL_AE_FILTER, - obs_residual = params$G_GTL_AEOBSRESIDUAL, - fmq_data = params$G_GTL_FMQ_DATA, - ae_catvar = params$G_GROUP, - split_by = params$G_GTL_SPLITBY, - trtvar = params$G_S_TRTVAR, - trt_left = params$G_TRT1, - trt_right = params$G_TRT2, - trtsort = params$G_GTL_TRTSORT, - pop_fil = params$G_GTL_POPULATION_FILTER, - pctdisp = params$G_GTL_PCTDISP, - denom_subset = params$G_GTL_DENOM_SUBSET, - legendbign = params$G_GTL_LEGEND_BIGN, - yvar = params$G_YAXIS_VAR - ) - -## Split Data by grouping variables `G_GTL_SPLITBY` -data_list <- split_data_by_var( - datain = plot_data, - split_by_prefix = ifelse( - !is.na(params$G_GTL_SPLITBY) & params$G_GTL_SPLITBY != "", - "SUBGRPVAR", "" - ) -) - -``` - -```{r,echo=FALSE, message=FALSE, eval=TRUE , warning=FALSE, results='hide'} -series_opts <- g_seriescol(plot_data, params$G_D_MARKER_COLOR, "BYVAR1") - -# Create plot output -plot_list <- map( - seq_along(data_list), - function(i) { - stopifnot(is.data.frame(data_list[[i]])) - stopifnot(nrow(data_list[[i]]) > 0) - tornado_plot( - datain = data_list[[i]], - trt_left_label = params$G_TRT1_LABEL, - trt_right_label = params$G_TRT2_LABEL, - bar_width = params$G_BARCHART_OPTIONS$bar_width, - axis_opts = plot_axis_opts( - xaxis_label = params$G_YAXIS_LABEL, - yaxis_label = params$G_XAXIS_LABEL, - ylinearopts = params$G_GTL_XAXISLINEAROPTS - ), - legend_opts = params$G_GTL_LEGENDOPTS, - series_opts = series_opts, - griddisplay = params$G_YAXIS_GRID - ) - } -) -``` - -`r if (is_html) title` - -```{r output, fig.align='right', fig.height=6, fig.width=9, warning=FALSE, results = "asis"} -# Split section headers -section_headers <- - split_section_headers( - datain = plot_data, - split_by_prefix = if_else( - params$G_GTL_SPLITBY == "" | - is.na(params$G_GTL_SPLITBY), - "", "SUBGRPVAR" - ), - split_lab = params$G_GTL_SPLITLAB - ) - - -## printing plot outputs -walk( - seq_along(plot_list), - function(i) { - cat("#### ", section_headers[[i]], "\n\n") - print(plot_list[[i]]) - cat("\n") - if (!is_html) { - cat("\n\n\n\\pagebreak\n") - } else { - cat("\n") - } - } -) -``` - -`r if (is_html) footer` diff --git a/inst/templates/volcano_plot_template.Rmd b/inst/templates/volcano_plot_template.Rmd deleted file mode 100644 index d2f03ce..0000000 --- a/inst/templates/volcano_plot_template.Rmd +++ /dev/null @@ -1,116 +0,0 @@ ---- -title: "Adverse Event Volcano Plot" -output: - html_document: - df_print: paged -params: - aeSubset: "AOCCPFL=='Y'" - aeDenomSubset: "!is.na(ASTDT)" - aeObsPeriod: "Overall Duration" - aeObsResidual: 0 - aeEventVar: "FMQ_NAM" - eventVar: "AEDECOD" - aeByVar: "AEBODSYS" - aeBigN: "Y" - aeGrpVarMiss: "Y" - aeTrtTot: "Y" - aeSubGrpTot: "Y" - pop_fil: "SAFFL" - ae_filter: "Any Event" - trtvar: "TRTA" - trtsort: "TRTAN" - obs_period: "Overall Duration" - obs_residual: 28 - ctrlgrp: "Placebo" - trtgrp: "Xanomeline High Dose" - summary_by: "Patients" - alpha: 0.05 - cutoff: 5 - sort_opt: "Ascending" - sort_var: "Count" - statistics: "Risk Ratio" - xlims: c(0, 3) - xref: 0 - pvalue_label: "None" - treatment1_label: 'Control' - treatment2_label: 'Treatment' - pvalcut: 0.05 ---- - -```{r setup, include=FALSE} -knitr::opts_chunk$set(echo = TRUE) -library(carver) -``` - - -```{r processing, include=FALSE} -# Read input datasets -data("adae") -data("FMQ_Consolidated_List") - -# Pre-processing of input dataset -ae_pre <- ae_pre_processor( - datain = adae, - aeSubset = params$aeSubset, - aeDenomSubset = params$aeDenomSubset, - ae_filter = params$ae_filter, - aeObsPeriod = params$aeObsPeriod, - aeObsResidual = params$aeObsResidual, - trtvar = params$trtvar, - trtsort = params$trtsort, - pop_fil = params$pop_fil, - fmq_data = FMQ_Consolidated_List, - aeEventVar = params$aeEventVar, - aeByVar = params$aeByVar, - aeSubGrpVar = NA, - aeBigN = params$aeBigN, - aeGrpVarMiss = params$aeGrpVarMiss, - aeTrtTot = params$aeTrtTot, - aeSubGrpTot = params$aeSubGrpTot -) - - - -# Calculate statistics needed for the analysis - stats <- risk_stat( - data = ae_pre$dsin, - d_datain = ae_pre$dout, - eventVar = params$eventVar, - summary_by = params$summary_by, - ctrlgrp = params$ctrlgrp, - trtgrp = params$trtgrp, - statistics = params$statistics, - alpha = params$alpha, - cutoff = params$cutoff, - sort_opt = params$sort_opt, - sort_var = params$sort_var -) - - -# Generates volcano plot -goutput <- volcano_plot( - datain = ae_pre$dsin, - statistics_data = stats, - AE_Filter = params$ae_filter, - summary_by = params$summary_by, - statistics = params$statistics, - treatment1 = params$ctrlgrp, - treatment1_label = params$treatment1_label, - treatment2_label = params$treatment2_label, - treatment2 = params$trtgrp, - X_ref = params$xref, - pvalue_label = params$pvalue_label, - pvalcut = params$pvalcut -) - - -``` - - - -```{r , echo = FALSE, warning = FALSE, message = FALSE, results="asis"} - -cat(gsub(pattern = "\n", replacement = " \n", x = goutput$title), "\n") -goutput$ptly -cat(gsub(pattern = "\n", replacement = " \n", x = goutput$footnote), "\n") -``` diff --git a/man/adae.Rd b/man/adae.Rd index bcadcd5..1001187 100644 --- a/man/adae.Rd +++ b/man/adae.Rd @@ -5,11 +5,11 @@ \alias{adae} \title{ADAE} \format{ -Data frame with 1191 features and 55 fields +Data frame with 1191 features and 56 fields } \source{ \url{https://github.com/phuse-org/aesummaries/tree/main/inst/extdata/adae.xpt}, -downloaded 2023-03-17 +downloaded 2023-03-17, modified 2023-03-17 } \usage{ adae diff --git a/man/adae_risk_summary.Rd b/man/adae_risk_summary.Rd index 8f4fe9e..33b6105 100644 --- a/man/adae_risk_summary.Rd +++ b/man/adae_risk_summary.Rd @@ -13,14 +13,21 @@ adae_risk_summary( ctrlgrp, trtgrp, statistics = "Risk Ratio", + riskdiff_pct = "N", alpha = 0.05, - cutoff = 5, + cutoff_where = NA, sort_opt = "Ascending", - sort_var = "Count" + sort_var = "Count", + sum_row = "N", + sum_row_label = "Participants with Any AE", + risklabels = tbl_risk_labels(statistics), + sigdec_cat = 1, + pctsyn = "Y" ) } \arguments{ -\item{datain}{Input dataset after pre_processing and running \code{mentry()} to \emph{ADAE} data} +\item{datain}{Input data from \code{mentry()} output to get counts for each +category} \item{a_subset}{Analysis Subset condition specific to categorical analysis.} @@ -37,17 +44,30 @@ for \code{forest_plot()}.} \item{statistics}{Statistic to be calculated. Values: \verb{'Risk Ratio' or 'Risk Difference'}.} +\item{riskdiff_pct}{To display risk and CI as \% if \code{statistic} = risk difference (Y/N)} + \item{alpha}{Alpha value to determine confidence interval for risk calculation. Default: \code{0.05}} -\item{cutoff}{Incidence Cutoff Value; consider only terms with \verb{incidence percentage > cutoff}.} +\item{cutoff_where}{Filter condition for incidence/pct. Consider only terms with +eg: "FREQ > 5" or "PCT <3". Must contain FREQ or PCT (count or percent)} \item{sort_opt}{How to sort terms, only for table/forest plot. Values: \verb{'Ascending','Descending','Alphabetical'}.} \item{sort_var}{Metric to sort by. Values: \verb{'Count','Percent','RiskValue'}.} + +\item{sum_row}{To show summary/any term row or not. 'Y'/'N'} + +\item{sum_row_label}{Label for Summary Row to be displayed, if Y.} + +\item{risklabels}{List containing labels for table with elements: risk, riskci, p, low, up, lowup} + +\item{sigdec_cat}{Number of decimal places for \% displayed in output} + +\item{pctsyn}{Display Percentage Sign in table or not. Values: \code{"Y"/"N"}} } \value{ -List of summarized data frames for Adverse Events based on high and lower term. +Data frame to be displayed with risk/counts of higher and lower AE terms } \description{ ADAE Summary with Risk Statistics @@ -83,7 +103,7 @@ ae_risk <- ae_entry |> trtgrp = "Xanomeline Low Dose", statistics = "Risk Ratio", alpha = 0.05, - cutoff = 5, + cutoff_where = "PCT > 5", sort_opt = "Ascending", sort_var = "Count" ) diff --git a/man/adsl_merge.Rd b/man/adsl_merge.Rd index fecd93d..2fbeea8 100644 --- a/man/adsl_merge.Rd +++ b/man/adsl_merge.Rd @@ -4,7 +4,7 @@ \alias{adsl_merge} \title{Merge adsl dataset with the analysis dataset} \usage{ -adsl_merge(adsl = NULL, adsl_subset = "", dataset_add = NULL) +adsl_merge(adsl = NULL, adsl_subset = "", dataset_add = NULL, byvars = NULL) } \arguments{ \item{adsl}{adsl dataset} @@ -12,6 +12,8 @@ adsl_merge(adsl = NULL, adsl_subset = "", dataset_add = NULL) \item{adsl_subset}{population variable subset condition} \item{dataset_add}{analysis dataset} + +\item{byvars}{Variables to merge the datasets by} } \value{ merged dataset @@ -20,12 +22,12 @@ merged dataset Merge adsl dataset with the analysis dataset } \examples{ -data(lab_data) - +data("adae") +data("adsl") adsl_merge( - adsl = lab_data$adsl, + adsl = adsl, adsl_subset = "SAFFL=='Y'", - dataset_add = lab_data$adlb + dataset_add = adae ) } diff --git a/man/adsl_summary.Rd b/man/adsl_summary.Rd index 43e43c6..ff8983b 100644 --- a/man/adsl_summary.Rd +++ b/man/adsl_summary.Rd @@ -1,5 +1,5 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/adsl_r001.R +% Please edit documentation in R/adsl_summary.R \name{adsl_summary} \alias{adsl_summary} \title{Demographic Characteristics Table} @@ -7,14 +7,19 @@ adsl_summary( datain, vars, - stat_vars = "N~Range~Meansd~Median~IQR", + stat_vars = "n~minmaxc~mean(sd)~median~q1q3", pctdisp = "TRT", total_catyn = "N", total_catlabel = "Total", miss_catyn = "N", miss_catlabel = "Missing", + pctsyn = "Y", + sigdec_stat = 2, + sigdec_cat = 2, a_subset = NA_character_, - denom_subset = NA_character_ + denom_subset = NA_character_, + sparseyn = "N", + sparsebyvalyn = "N" ) } \arguments{ @@ -25,10 +30,12 @@ tilde-separated} \item{stat_vars}{Statistics to display in table for numeric vars, tilde-separated.} -\item{pctdisp}{Denominator to calculate percentages by. -Values: \verb{"TRT", "VAR", "COL", "SUBGRP", "SGRPN", "CAT", "NONE", "NO", "DPTVAR"}.} +\item{pctdisp}{Method to calculate denominator (for \%) by. +Possible values: \code{"TRT"}, \code{"VAR"}, \code{"COL"}, \code{"SUBGRP"}, \code{"CAT"}, \code{"NONE"}, \code{"NO"}, \code{"DPTVAR"}, +\code{"BYVARxyN"}} -\item{total_catyn}{To return a 'Total' row for categorical analysis in \code{vars}. Values: \code{"Y"/"N"}} +\item{total_catyn}{To return a 'Total' row for the categories of \code{dptvar} +variable or not. Possible values: \code{"Y"/"N"}} \item{total_catlabel}{Label for total category row. eg- "All"/"Total"} @@ -37,10 +44,21 @@ Values: \verb{"TRT", "VAR", "COL", "SUBGRP", "SGRPN", "CAT", "NONE", "NO", "DPTV \item{miss_catlabel}{Label for missing values} +\item{pctsyn}{Display Percentage Sign in table or not. Values: \code{"Y"/"N"}} + +\item{sigdec_stat}{Number of base decimal places to retain in output of summary statistic. +Applies to mean, min, max, sd etc} + +\item{sigdec_cat}{Number of decimal places for \% displayed in output} + \item{a_subset}{Analysis Subset condition; tilde-separated for each variable in \code{vars}.} \item{denom_subset}{Subset condition to be applied to dataset for calculating denominator, tilde-separated for categorical variables within \code{vars}.} + +\item{sparseyn}{To sparse missing categories/treatments or not? \code{"Y"/"N"}} + +\item{sparsebyvalyn}{Sparse missing categories within by groups. \code{"Y"/"N"}} } \value{ \code{data.frame} to be passed on to \code{tbl_processor} and \code{tbl_display} @@ -55,7 +73,7 @@ variables, the remaining being for categorical analysis. eg. for \code{"AGEGR1/AGEGR1N~AGE-S~SEX/SEXN~BMIBL-S"}, \code{AGEGR1} and \code{SEX} will be analysed by category and \code{AGE} and \code{BMIBL} as summary statistics. \item Argument \code{stat_vars} should contain names of statistic to apply to all summary analysis -variables. +variables. \code{sigdec} applies only to statistical analysis of numeric variables (-S) \item Arguments \code{pctdisp}, \code{total_catyn}, \code{miss_catyn}, \code{miss_catlabel} apply to all variables under categorical analyses. \item \code{a_subset} should tilde-separated subset conditions, corresponding to each variable in @@ -88,11 +106,28 @@ adsl_sum <- mentry_df |> a_subset = "AGE<65~AGE>80~SEX=='F'~NA" ) +adsl_sum |> + display_bign_head(mentry_data = mentry_df) |> + tbl_processor( + statlabel = "N~Range~Meansd~Median~Q1Q3", + dptlabel = "Age Group~_NONE_~Sex~Race", + addrowvar = "DPTVAR" + ) |> + tbl_display() |> + flextable::autofit() + +# Same variable with 2 unique subset conditions +adsl_sum <- mentry_df |> + adsl_summary( + vars = "AGEGR1~AGE-S~SEX~SEX~RACE", + a_subset = "AGE<65~AGE>80~SEX=='F'~SEX=='M'~NA" + ) + adsl_sum |> display_bign_head(mentry_data = mentry_df) |> tbl_processor( statlabel = "N~Range~Meansd~Median~IQR", - dptlabel = "Age Group~NONE~Sex~Race", + dptlabel = "Age Group~_NONE_~Sex1~Sex2~Race", addrowvar = "DPTVAR" ) |> tbl_display() |> @@ -174,13 +209,13 @@ adsl_vs <- pharmaverseadam::adsl |> adsl_vs |> adsl_summary( vars = "SEX~AGE-S~AGEGR1~RACE~ETHNIC~HEIGHT-S~WEIGHT-S~BMI-S", - stat_vars = "medianrange~meansd" + stat_vars = "median(minmax)~mean(sd)" ) |> display_bign_head(adsl_vs) |> tbl_processor( dptlabel = "Sex, n(\%)~Age (Years)~Age Category (Years), n(\%)~Race, n(\%)~Ethnicity, n(\%)~Height (cm)~Weight (kg)~BMI (kg/m2)", - statlabel = "Median (Range)~Mean (SD)", + statlabel = "Median (Min, Max)~Mean (SD)", addrowvars = "DPTVAR" ) |> tbl_display() |> diff --git a/man/ae_forest_plot.Rd b/man/ae_forest_plot.Rd index 12e763f..ef6d5d2 100644 --- a/man/ae_forest_plot.Rd +++ b/man/ae_forest_plot.Rd @@ -113,7 +113,7 @@ ae_risk_forest <- risk_stat( trtgrp = "Xanomeline High Dose", statistics = "Risk Ratio", alpha = 0.05, - cutoff = 5, + cutoff_where = "FREQ >5", sort_opt = "Ascending", sort_var = "Count" ) |> diff --git a/man/ae_pre_processor.Rd b/man/ae_pre_processor.Rd index 6367b6f..7430e63 100644 --- a/man/ae_pre_processor.Rd +++ b/man/ae_pre_processor.Rd @@ -9,7 +9,15 @@ ae_pre_processor( fmq_data = NULL, date_vars = c("ASTDT", "AENDT", "TRTSDT", "TRTEDT"), ae_filter = "Any Event", - obs_residual = NA_real_ + subset = NA, + obs_residual = NA_real_, + max_sevctc = NA_character_, + sev_ctcvar = "ASEVN", + hterm = "AEBODSYS", + lterm = "AEDECOD", + rpt_byvar = character(0), + trtvar = "TRTA", + pt_total = "N" ) } \arguments{ @@ -24,9 +32,26 @@ Permissible Values: "ANY", "ANY EVENT", "TREATMENT EMERGENT", "SERIOUS", "DRUG-RELATED", "RELATED", "MILD", "MODERATE", "SEVERE", "RECOVERED/RESOLVED", "RECOVERING/RESOLVING", "NOT RECOVERING/NOT RESOLVING", "FATAL", "GRADE N"} +\item{subset}{Analysis subset condition to be applied to \code{ADAE} dataset prior to ADSL join; +will be appended to \code{ae_filter}} + \item{obs_residual}{If not NA, use this argument to pass a period (numeric) to extend the observation period. If passed as NA, overall study duration is considered for analysis. eg. if 5, only events occurring upto 5 days past the TRTEDT are considered.} + +\item{max_sevctc}{If needed to filter maximum severity/ctc grade rows. Values: NA/"SEV"/"CTC"} + +\item{sev_ctcvar}{Variable to determine max severity. eg: ASEVN, ATOXGRN} + +\item{hterm}{High Level Event Term (req for max Sev tables only)} + +\item{lterm}{Low Level Event Term (req for max Sev tables only)} + +\item{rpt_byvar}{Page/report by variable if any, to identify max sev/ctc} + +\item{trtvar}{Treatment Variable} + +\item{pt_total}{Required to calculate total of preferred terms? Y/N} } \value{ : a list containing 2 objects diff --git a/man/ae_risk.Rd b/man/ae_risk.Rd deleted file mode 100644 index e80c74e..0000000 --- a/man/ae_risk.Rd +++ /dev/null @@ -1,16 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/data.R -\docType{data} -\name{ae_risk} -\alias{ae_risk} -\title{ae_risk} -\format{ -Data frame with \code{46} rows and \code{17} variables -} -\usage{ -ae_risk -} -\description{ -Output from \code{risk_stat()} -} -\keyword{datasets} diff --git a/man/ae_volcano_opts.Rd b/man/ae_volcano_opts.Rd index 8c306cb..b259062 100644 --- a/man/ae_volcano_opts.Rd +++ b/man/ae_volcano_opts.Rd @@ -34,6 +34,40 @@ List of volcano-specific options Volcano Plot axis Options } \examples{ +data("adae") + +ae_pre <- ae_pre_processor( + datain = adae, + obs_residual = 0, + fmq_data = NA +) + +ae_entry <- mentry( + datain = ae_pre$data, + subset = NA, + byvar = "AEBODSYS", + trtvar = "TRTA", + trtsort = "TRTAN", + subgrpvar = NA, + trttotalyn = "N", + add_grpmiss = "N", + sgtotalyn = "N", + pop_fil = "SAFFL" +) + +ae_risk <- risk_stat( + datain = ae_entry, + a_subset = ae_pre$a_subset, + summary_by = "Patients", + eventvar = "AEDECOD", + ctrlgrp = "Placebo", + trtgrp = "Xanomeline High Dose", + statistics = "Risk Ratio", + alpha = 0.05, + cutoff_where = "FREQ >5", + sort_opt = "Ascending", + sort_var = "Count" +) ae_volcano_opts(ae_risk, pvalue_trans = "-log10" ) diff --git a/man/ae_volcano_plot.Rd b/man/ae_volcano_plot.Rd index 13ea3ad..dd94db9 100644 --- a/man/ae_volcano_plot.Rd +++ b/man/ae_volcano_plot.Rd @@ -74,7 +74,7 @@ ae_risk <- risk_stat( trtgrp = "Xanomeline High Dose", statistics = "Risk Ratio", alpha = 0.05, - cutoff = 5, + cutoff_where = "FREQ >5", sort_opt = "Ascending", sort_var = "Count" ) diff --git a/man/bar_plot.Rd b/man/bar_plot.Rd index 92c93ef..173bdfe 100644 --- a/man/bar_plot.Rd +++ b/man/bar_plot.Rd @@ -72,7 +72,8 @@ adsl_entry <- mentry( adsl_sum <- msumstat( datain = adsl_entry, dptvar = "AGE", - statvar = "mean" + statvar = "mean", + figyn = "Y" )[["gsum"]] |> plot_display_bign(adsl_entry) |> dplyr::mutate( diff --git a/man/dataset_merge.Rd b/man/dataset_merge.Rd index 51f76c0..3ba0aa6 100644 --- a/man/dataset_merge.Rd +++ b/man/dataset_merge.Rd @@ -4,7 +4,7 @@ \alias{dataset_merge} \title{Merge Datasets} \usage{ -dataset_merge(..., byvars, subset = NULL) +dataset_merge(..., byvars, subset = NULL, type = "left") } \arguments{ \item{...}{Datasets to be merged.} @@ -13,6 +13,8 @@ dataset_merge(..., byvars, subset = NULL) \item{subset}{Dataset specific subset conditions as \code{list}, default is \code{NULL}. Has to be specified in the same order of datasets to be merged} + +\item{type}{Type of join to perform. Values: "left", "right", "inner", "full", "semi", "anti"} } \value{ A \code{data.frame} @@ -22,46 +24,39 @@ Merge Datasets } \examples{ dataset_merge( - lab_data$adsl, - lab_data$adlb, + adsl, + adlb, byvars = "STUDYID~USUBJID~SUBJID", - subset = list("SEX=='F'", "PARAMCD == 'L00021S'") + subset = list("SEX=='F'", "PARAMCD == 'ALT'") ) dataset_merge( - lab_data$adsl, - lab_data$adlb, + adsl, + adlb, byvars = "STUDYID~USUBJID~SUBJID", subset = list("SEX=='F'", NA_character_) ) dataset_merge( - lab_data$adsl, - lab_data$adlb, + adsl, + adlb, byvars = "STUDYID~USUBJID~SUBJID", - subset = list(NA_character_, "PARAMCD == 'L00021S'") + subset = list(NA_character_, "PARAMCD == 'ALT'") ) dataset_merge( - lab_data$adsl, - lab_data$adlb, + adsl, + adlb, byvars = "STUDYID~USUBJID~SUBJID", - subset = list("USUBJID == 'XYZ1 1003 10031009'", NA_character_) -) - -dataset_merge( - waterfall_plot_data$adrs, - waterfall_plot_data$adtr, - byvars = "STUDYID~USUBJID~TRT01P", - subset = list("PARAMCD == 'BOR_C'", NA_character_) + subset = list("USUBJID == '01-701-1015'", NA_character_) ) ## more than 2 datasets dataset_merge( - dplyr::filter(lab_data$adsl, USUBJID == "XYZ1 1003 10031009"), - lab_data$adsl, - lab_data$adlb, + dplyr::filter(adsl, USUBJID == "01-701-1015"), + adsl, + adlb, byvars = "STUDYID~USUBJID~SUBJID" ) diff --git a/man/display_bign_head.Rd b/man/display_bign_head.Rd index 7a8619c..7560432 100644 --- a/man/display_bign_head.Rd +++ b/man/display_bign_head.Rd @@ -44,8 +44,7 @@ adsl_entry <- mentry( msumstat( adsl_entry, dptvar = "AGE", - statvar = "meansd", - sigdec = 2, + statvar = "mean", dptvarn = 2 )$tsum |> display_bign_head(adsl_entry) diff --git a/man/edish_plot.Rd b/man/edish_plot.Rd index 4ad8fd3..d785981 100644 --- a/man/edish_plot.Rd +++ b/man/edish_plot.Rd @@ -58,8 +58,8 @@ order: "upper right~lower right~upper left~lower left" or as a vector of length } } \examples{ -data("adsl") data("adlb") +data("adsl") merged_data <- adsl_merge( adsl = adsl, @@ -88,9 +88,9 @@ edish_plot( datain = pt_data, axis_opts = plot_axis_opts( xlinearopts = list( - breaks = c(0.1, 1, 2, 10), - limits = c(0.1, 10), - labels = c("0.1", "1", "2x ULN", "10") + breaks = c(0.1, 1, 2, 5), + limits = c(0.1, 5), + labels = c("0.1", "1", "2x ULN", "5") ), ylinearopts = list( breaks = c(0.1, 1, 3, 10), diff --git a/man/empty_plot.Rd b/man/empty_plot.Rd index f582b42..4c81a57 100644 --- a/man/empty_plot.Rd +++ b/man/empty_plot.Rd @@ -22,6 +22,5 @@ a list containing 2 objects Empty plot with message } \examples{ -library(carver) empty_plot() } diff --git a/man/empty_tbl.Rd b/man/empty_tbl.Rd new file mode 100644 index 0000000..65c0ee1 --- /dev/null +++ b/man/empty_tbl.Rd @@ -0,0 +1,20 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/tbl_display.R +\name{empty_tbl} +\alias{empty_tbl} +\title{Return table if output is empty} +\usage{ +empty_tbl(text = "No participant meets the reporting criteria") +} +\arguments{ +\item{text}{Text to display under table creation} +} +\value{ +flextable output +} +\description{ +Return table if output is empty +} +\examples{ +empty_tbl() +} diff --git a/man/event_analysis_plot.Rd b/man/event_analysis_plot.Rd index 2ee6dde..20b1ef0 100644 --- a/man/event_analysis_plot.Rd +++ b/man/event_analysis_plot.Rd @@ -46,7 +46,8 @@ prep_ae <- adae |> ae_pre_processor( ae_filter = "ANY", obs_residual = 0, - fmq_data = FMQ_Consolidated_List + fmq_data = FMQ_Consolidated_List, + subset = "AOCCPFL == 'Y'" ) ## prepare data for plot @@ -60,7 +61,7 @@ prep_entry <- prep_ae[["data"]] |> ## prepare data for plot prep_event_analysis <- prep_entry |> process_event_analysis( - a_subset = glue::glue("AOCCPFL == 'Y' & {prep_ae$a_subset}"), + a_subset = prep_ae$a_subset, summary_by = "Events", hterm = "FMQ_NAM", ht_val = "ABDOMINAL PAIN", diff --git a/man/forest_display.Rd b/man/forest_display.Rd index 4596e08..bd89a98 100644 --- a/man/forest_display.Rd +++ b/man/forest_display.Rd @@ -9,7 +9,8 @@ forest_display( rel_widths = c(0.25, 0.38, 0.27, 0.1), interactive = "N", plot_height = NULL, - xpos = "top" + xpos = "top", + legend_opts = list(pos = "bottom", dir = "horizontal") ) } \arguments{ @@ -26,6 +27,9 @@ Values: "Y"/"N"} \item{xpos}{Where should X xaxis for \code{splot} and \code{fplot} be displayed in interactive plot? Values: "top"/"bottom". Value for static output is decided prior to passing in this function.} + +\item{legend_opts}{Legend styling option, a \code{list} containing \code{pos}(position) and +\code{dir} (direction).} } \value{ plot_grid object or plotly forest plot object @@ -34,7 +38,33 @@ plot_grid object or plotly forest plot object Display combined Forest Plot } \examples{ -data(ae_risk) +data("adae") +ae_pre_process <- ae_pre_processor( + datain = adae, + obs_residual = 0 +) + +ae_entry <- mentry( + datain = ae_pre_process$data, + byvar = "AEBODSYS", + trtvar = "TRTA", + trtsort = "TRTAN", + pop_fil = "SAFFL" +) + +ae_risk <- risk_stat( + datain = ae_entry, + a_subset = ae_pre_process$a_subset, + summary_by = "Patients", + eventvar = "AEDECOD", + ctrlgrp = "Placebo", + trtgrp = "Xanomeline High Dose", + statistics = "Risk Ratio", + alpha = 0.05, + cutoff_where = "PCT > 2", + hoveryn = "Y" +) |> +dplyr::mutate(key = dplyr::row_number()) splot <- forest_plot_scatter( datain = ae_risk, xvar = "PCT", @@ -45,7 +75,7 @@ splot <- forest_plot_scatter( shape = g_seriessym(ae_risk, NA, "TRTVAR"), size = rep(1, 2) ), - hovervar = "HOVER_PCT", + hovervar = "HOVER_TEXT", xaxis_pos = "top", legend_opts = list(pos = "bottom", dir = "horizontal"), axis_opts = list(xsize = 8, xtsize = 6, xaxis_label = "Percentage") @@ -56,7 +86,7 @@ fplot <- forest_plot_base( yvar = "DPTVAL", xminvar = "RISKCIL", xmaxvar = "RISKCIU", - hovervar = "HOVER_RISK", + hovervar = "HOVER_TEXT", series_var = "TRTPAIR", xrefline = 1, axis_opts = plot_axis_opts( diff --git a/man/forest_plot_base.Rd b/man/forest_plot_base.Rd index 2f26d2b..ed26e26 100644 --- a/man/forest_plot_base.Rd +++ b/man/forest_plot_base.Rd @@ -57,14 +57,40 @@ a ggplot of statistic with interval bars. Forest Plot - base with errorbars } \examples{ -data(ae_risk) +data("adae") +ae_pre_process <- ae_pre_processor( + datain = adae, + obs_residual = 0 +) + +ae_entry <- mentry( + datain = ae_pre_process$data, + byvar = "AEBODSYS", + trtvar = "TRTA", + trtsort = "TRTAN", + pop_fil = "SAFFL" +) + +ae_risk <- risk_stat( + datain = ae_entry, + a_subset = ae_pre_process$a_subset, + summary_by = "Patients", + eventvar = "AEDECOD", + ctrlgrp = "Placebo", + trtgrp = "Xanomeline High Dose", + statistics = "Risk Ratio", + alpha = 0.05, + cutoff_where = "PCT > 2", + hoveryn = "Y" +) |> +dplyr::mutate(key = dplyr::row_number()) forest_plot_base( ae_risk, xvar = "RISK", yvar = "DPTVAL", xminvar = "RISKCIL", xmaxvar = "RISKCIU", - hovervar = "HOVER_RISK", + hovervar = "HOVER_TEXT", series_var = "TRTPAIR", xrefline = 1, axis_opts = plot_axis_opts( diff --git a/man/forest_plot_scatter.Rd b/man/forest_plot_scatter.Rd index d05dc3d..f366823 100644 --- a/man/forest_plot_scatter.Rd +++ b/man/forest_plot_scatter.Rd @@ -54,7 +54,33 @@ a ggplot scatterplot, fit for combining with forest plot. Scatter plot to be included within forest plot } \examples{ -data(ae_risk) +data("adae") +ae_pre_process <- ae_pre_processor( + datain = adae, + obs_residual = 0 +) + +ae_entry <- mentry( + datain = ae_pre_process$data, + byvar = "AEBODSYS", + trtvar = "TRTA", + trtsort = "TRTAN", + pop_fil = "SAFFL" +) + +ae_risk <- risk_stat( + datain = ae_entry, + a_subset = ae_pre_process$a_subset, + summary_by = "Patients", + eventvar = "AEDECOD", + ctrlgrp = "Placebo", + trtgrp = "Xanomeline High Dose", + statistics = "Risk Ratio", + alpha = 0.05, + cutoff_where = "PCT > 2", + hoveryn = "Y" +) |> +dplyr::mutate(key = dplyr::row_number()) forest_plot_scatter( datain = ae_risk, xvar = "PCT", @@ -65,7 +91,7 @@ forest_plot_scatter( shape = g_seriessym(ae_risk, NA, "TRTVAR"), size = rep(1, 2) ), - hovervar = "HOVER_PCT", + hovervar = "HOVER_TEXT", xaxis_pos = "top" ) diff --git a/man/km_plot.Rd b/man/km_plot.Rd deleted file mode 100644 index 667a79c..0000000 --- a/man/km_plot.Rd +++ /dev/null @@ -1,111 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/km_plot.R -\name{km_plot} -\alias{km_plot} -\title{Kaplan Meir Plot} -\usage{ -km_plot( - datain, - disp_conf.int = "N", - disp_risk.table = "Y", - risktab_stats = "n.risk", - risktab_height = NULL, - disp_pair.stat = "Y", - trt_colors, - axis_opts = plot_axis_opts(xlinearopts = list(breaks = 5), ylinearopts = list(breaks = - 0.1), xaxis_label = "Progression-Free Survival Time (Months)", yaxis_label = - "Probability of Progression Free Survival"), - legend_opts = list(pos = "bottom", dir = "vertical"), - time_unit = "Months" -) -} -\arguments{ -\item{datain}{Pre-processed input data from \code{surv_pre_processor()}.} - -\item{disp_conf.int}{Display confidence interval. Must be one of \code{"Y"} or \code{"N"}. -Default is \code{"N"}.} - -\item{disp_risk.table}{Display risk table. Must be one of \code{"Y"} or \code{"N"}. Default is \code{"Y"}.} - -\item{risktab_stats}{String of statistics to show in the risk table. Must be one or -more of \code{"n.risk"}, \code{"cum.event"}, \code{"cum.censor"}, \code{"n.event"} and \code{"n.censor"}. Default is -\code{"n.risk"}. See what each option means here \link[ggsurvfit]{add_risktable}).} - -\item{risktab_height}{A numeric value between \code{0} and \code{1} to indicate the proportion of final -plot and risk table. Default is \code{NULL}.} - -\item{disp_pair.stat}{Display paired prop-hazard statistics. Must be one of \verb{"Y", "N"}. -Default is \code{"Y"}.} - -\item{trt_colors}{String of \code{hex} colors. Must be of the same length of unique \code{TRTVAR}.} - -\item{axis_opts}{A \code{list} of axis specific options retrieved from \code{plot_axis_opts()}} - -\item{legend_opts}{A \code{list} of legend specific options. Default is -\code{list(pos = "bottom", dir = "vertical")}.} - -\item{time_unit}{Unit of \code{timevar} in \code{datain}. Default is \code{"Months"}.} -} -\value{ -Kaplan-Meir Plot -} -\description{ -Kaplan Meir Plot -} -\examples{ -data("survival") - -km_df <- survival[["adsl"]] |> - surv_pre_processor( - dataset_analysis = survival[["adtte"]], - analysis_subset = "PARAMCD == 'PFS_P'" - ) - -km_df |> - km_plot( - trt_colors = "#F8766D~#00BA38~#619CFF" - ) - -## with confidence interval and multiple `risk table` statistics -km_df |> - km_plot( - disp_conf.int = "Y", - risktab_stats = "n.risk~n.censor", - risktab_height = 0.25, - trt_colors = "#F8766D~#00BA38~#619CFF", - axis_opts = plot_axis_opts( - xlinearopts = list(breaks = 3), - ylinearopts = list(breaks = 0.1), - xaxis_label = "Progression-Free Survival Time (Months)", - yaxis_label = "Probability of Progression Free Survival" - ) - ) - -## with `{pharmaverseadam}` test data sets -## run `install.packages("pharmaverseadam")` prior running this example -\dontrun{ -km_df <- pharmaverseadam::adsl |> - surv_pre_processor( - adsl_subset = "SAFFL == 'Y'", - dataset_analysis = pharmaverseadam::adtte_onco, - analysis_subset = "PARAMCD == 'OS'", - trtvar = "TRT01P", - trtsort = NA_character_, - censor_val = 0 - ) - -km_df |> - km_plot( - trt_colors = "#F8766D~#00BA38~#619CFF", - disp_conf.int = "Y", - time_unit = "Days", - axis_opts = plot_axis_opts( - xlinearopts = list(breaks = 25), - ylinearopts = list(breaks = 0.1), - xaxis_label = "Overall Survival Time (Days)", - yaxis_label = "Probability of Overall Survival" - ) - ) -} - -} diff --git a/man/lab_abnormality_summary.Rd b/man/lab_abnormality_summary.Rd index 8684674..682ecaf 100644 --- a/man/lab_abnormality_summary.Rd +++ b/man/lab_abnormality_summary.Rd @@ -1,15 +1,19 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/adlb_r301.R +% Please edit documentation in R/lab_abnormality.R \name{lab_abnormality_summary} \alias{lab_abnormality_summary} \title{Incidence of Laboratory Test Abnormalities (Without Regard to Baseline Abnormality)} \usage{ lab_abnormality_summary( datain, - crit_vars = "CRIT3~CRIT4", + crit_vars = "CRIT1~CRIT2", pctdisp = "SUBGRP", a_subset = NA_character_, - denom_subset = NA_character_ + denom_subset = NA_character_, + sigdec = 2, + sparseyn = "Y", + pctsyn = "N", + stathead = "n (\%)" ) } \arguments{ @@ -17,12 +21,22 @@ lab_abnormality_summary( \item{crit_vars}{Criteria variables} -\item{pctdisp}{Denominator to calculate percentages by. -Values: \verb{"TRT", "VAR","COL", "SUBGRP", "SGRPN", "CAT", "NONE", "NO", "DPTVAR"}} +\item{pctdisp}{Method to calculate denominator (for \%) by. +Possible values: \code{"TRT"}, \code{"VAR"}, \code{"COL"}, \code{"SUBGRP"}, \code{"CAT"}, \code{"NONE"}, \code{"NO"}, \code{"DPTVAR"}, +\code{"BYVARxyN"}} + +\item{a_subset}{Analysis Subset condition specific to categorical analysis.} + +\item{denom_subset}{Subset condition to be applied to data set for calculating denominator.} + +\item{sigdec}{Number of decimal places for \% displayed in output} -\item{a_subset}{Subset conditions for analysis of dependent variable.} +\item{sparseyn}{To sparse missing categories/treatments or not? \code{"Y"/"N"}} -\item{denom_subset}{Subset conditions for denominator eg. \code{"APSBLFL == 'Y'"}} +\item{pctsyn}{Display Percentage Sign in table or not. Values: \code{"Y"/"N"}} + +\item{stathead}{Column label to display \code{n} in the output. Default is \verb{n (\%)} +Values: \verb{"TRT", "VAR","COL", "SUBGRP", "SGRPN", "CAT", "NONE", "NO", "DPTVAR"}} } \value{ \code{data.frame} with summary of laboratory abnormality incidence counts @@ -31,9 +45,9 @@ Values: \verb{"TRT", "VAR","COL", "SUBGRP", "SGRPN", "CAT", "NONE", "NO", "DPTVA Incidence of Laboratory Test Abnormalities (Without Regard to Baseline Abnormality) } \examples{ -data("lab_data") +data("adlb") -lb_entry <- lab_data$adlb |> +lb_entry <- adlb |> mentry( subset = NA_character_, byvar = "PARCAT1~PARAM", @@ -49,15 +63,14 @@ lb_entry <- lab_data$adlb |> out <- lb_entry |> lab_abnormality_summary( - crit_vars = "CRIT3~CRIT4", + crit_vars = "CRIT1~CRIT2", pctdisp = "SUBGRP", a_subset = NA_character_, - denom_subset = NA_character_ + denom_subset = NA_character_, + sigdec = 1 ) |> display_bign_head(mentry_data = lb_entry) |> - tbl_processor( - dptlabel = "" - ) + tbl_processor() out diff --git a/man/line_plot.Rd b/man/line_plot.Rd index fffeb93..2576ec8 100644 --- a/man/line_plot.Rd +++ b/man/line_plot.Rd @@ -8,11 +8,12 @@ line_plot( datain, series_var = "TRTVAR", series_labelvar = series_var, - series_opts, + series_opts = plot_aes_opts(datain, "TRTVAR"), axis_opts = plot_axis_opts(), legend_opts = list(label = "", pos = "bottom", dir = "horizontal"), griddisplay = "N", - plot_title = NULL + plot_title = NULL, + dodge_width = NULL ) } \arguments{ @@ -35,6 +36,8 @@ should be a factor variable with levels corresponding to \code{series_var}, also \item{griddisplay}{Display Grid \code{(Y/N)}.} \item{plot_title}{Text to use as plot title, if required} + +\item{dodge_width}{Width to dodge points/lines by, IF required.} } \value{ plot - Line plot. @@ -43,43 +46,40 @@ plot - Line plot. Utility for Line Plot } \examples{ -data("vx_line_data") - -lineplot_df <- process_line_plot_data( - dataset_adsl = vx_line_data$adsl, - dataset_analysis = vx_line_data$adva, - adsl_subset = "SAFFL == 'Y'", - analysis_subset = 'PARAMN==2 & TRTARN!=""& (AVISITN \%in\% c(1,3,4,5,6,7))', - trtvar = "TRTP", - trtsort = "TRTPN", - xvar = "AVISIT", - yvar = "AVAL" +data("adsl") +adsl_entry <- mentry( + datain = adsl, + subset = "EFFFL=='Y'", + byvar = "RACE", + trtvar = "TRT01A", + trtsort = "TRT01AN", + pop_fil = NA ) -plot <- line_plot( - datain = lineplot_df, - series_var = "TRTVAR", - series_labelvar = "TRTVAR", - series_opts = list( - color = g_seriescol(lineplot_df, NA, "TRTVAR") - ), - axis_opts = plot_axis_opts( - ylinearopts = list( - breaks = c(100, 1000, 10000, 100000), - limits = c(100, 100000) - ), - xaxis_label = "Visit", - yaxis_label = "Geometric Mean Titer" - ), +adsl_sum <- msumstat( + datain = adsl_entry, + dptvar = "AGE", + statvar = "mean" +) +adsl_sum$gsum <- adsl_sum$gsum |> + dplyr::mutate( + XVAR = forcats::fct_reorder(.data[["BYVAR1"]], .data[["BYVAR1N"]]), + YVAR = as.numeric(.data[["mean"]]) + ) +line_plot( + datain = adsl_sum$gsum, + axis_opts = plot_axis_opts(xaxis_label = "Race", yaxis_label = "Mean Age"), legend_opts = list( - label = "", - pos = "bottom", + label = "Treatment", pos = "bottom", dir = "horizontal" ), - griddisplay = "N", - plot_title = "Line Plot" + series_opts = plot_aes_opts( + adsl_sum$gsum, + "TRTVAR", + series_color = "firebrick~forestgreen~dodgerblue", + series_shape = "triangle~square~circle" + ), + griddisplay = "Y" ) -plot - } diff --git a/man/mcatstat.Rd b/man/mcatstat.Rd index 985205d..927d6f9 100644 --- a/man/mcatstat.Rd +++ b/man/mcatstat.Rd @@ -18,7 +18,11 @@ mcatstat( total_catlabel = "Total", dptvarn = 1, pctsyn = "Y", - denomyn = "N" + sigdec = 2, + denomyn = "N", + sparseyn = "N", + sparsebyvalyn = "N", + return_zero = "N" ) } \arguments{ @@ -29,7 +33,7 @@ category} \item{denom_subset}{Subset condition to be applied to data set for calculating denominator.} -\item{uniqid}{Variable to calculate unique counts of. Expected values: \code{"USUBJID"}, \code{"SITEID"}, +\item{uniqid}{Variable(s) to calculate unique counts of. eg. \code{"USUBJID"}, \code{"SITEID"}, \code{"ALLCT"}} \item{dptvar}{Categorical Analysis variable and ordering variable if exists, @@ -57,7 +61,16 @@ multiple \code{mcatstat()} outputs are created to be combined.} \item{pctsyn}{Display Percentage Sign in table or not. Values: \code{"Y"/"N"}} +\item{sigdec}{Number of decimal places for \% displayed in output} + \item{denomyn}{Display denominator in output or not. Values: \code{"Y"/"N"}} + +\item{sparseyn}{To sparse missing categories/treatments or not? \code{"Y"/"N"}} + +\item{sparsebyvalyn}{Sparse missing categories within by groups. \code{"Y"/"N"}} + +\item{return_zero}{Return rows with zero counts if analysis subset/ non-missing does not +exist in data. \code{"Y"/"N"}} } \value{ a data.frame with counts and/or percentages, passed to diff --git a/man/mentry.Rd b/man/mentry.Rd index d76eb09..6ef6532 100644 --- a/man/mentry.Rd +++ b/man/mentry.Rd @@ -2,7 +2,7 @@ % Please edit documentation in R/mentry.R \name{mentry} \alias{mentry} -\title{Function to read in and process data with subsets and variables.} +\title{Read and process data with subsets and variables} \usage{ mentry( datain, @@ -13,6 +13,7 @@ mentry( trtsort = NA, trttotalyn = "N", trttotlabel = "Total", + trtmissyn = "N", sgtotalyn = "N", add_grpmiss = "N", pop_fil = "Overall Population" @@ -40,6 +41,9 @@ table or category in plot (\code{"Y"/"N"}).} \item{trttotlabel}{Label for total Treatment column/group} +\item{trtmissyn}{Retain Missing treatment counts in Total (if \code{trttotalyn} = Y). Missing +treatment will not be considered as a column in analysis in any case.} + \item{sgtotalyn}{Add total subgroup values to be displayed as column in table or category in plot (\code{"Y"/"N"}).} diff --git a/man/msumstat.Rd b/man/msumstat.Rd index 29a3b01..93ffaaf 100644 --- a/man/msumstat.Rd +++ b/man/msumstat.Rd @@ -9,8 +9,10 @@ msumstat( a_subset = NA_character_, dptvar = NULL, statvar = "", - sigdec = 1, - dptvarn = 1 + sigdec = "", + dptvarn = 1, + sparsebyvalyn = "N", + figyn = "N" ) } \arguments{ @@ -23,10 +25,14 @@ msumstat( \item{statvar}{\code{Tilde} (\code{~})-separated list of statistics to be computed. eg: \code{"mean~median"}} \item{sigdec}{Number of base decimal places to retain in output -Applies to mean, min, max etc and \code{+ 1} for sd} +Applies to mean, min, max, sd etc} \item{dptvarn}{Number to assign as \code{'DPTVARN'}, used for block sorting when multiple blocks are created to be combined.} + +\item{sparsebyvalyn}{Sparse missing categories within by groups. \code{"Y"/"N"}} + +\item{figyn}{Determine if output is for figure or not \code{"Y"/"N"}} } \value{ a list containing 2 elements @@ -42,10 +48,9 @@ Summary statistics for numeric data variable Current available statistics (values for \code{statvar}) : n (count per group), mean, median, sd (standard deviation), min, max, iqr (interquartile range), var (variance), sum, range ("min, max") -meansd ("mean (sd)"), medianrange ("median (range)"), -q25/q1 (25 \% quantile), q75/q3 (75 \% quantile) , p10 (10\% quantile), p5, p1, -p90, p95, p99, q1q3 ("q25, q75"), whiskerlow, whiskerup (box lower/upper -whiskers), outliers (boxplot outliers, tilde-separated output), +mean(sd), median(minmax), q25/q1 (25 \% quantile), q75/q3 (75 \% quantile) , p10 (10\% quantile), +p5, p1, p90, p95, p99, q1q3 ("q25, q75"), whiskerlow, whiskerup (box lower/upper +whiskers), outliers (boxplot outliers, tilde-separated output), geometric mean/sd/CI box = median~q25~q75~whiskerlow~whiskerup~outliers (Tukey's method) } \examples{ @@ -63,9 +68,10 @@ adsl_entry <- mentry( adsl_sum <- adsl_entry |> msumstat( dptvar = "AGE", - a_subset = "BYVAR1 == 'M'", - statvar = "mean", - sigdec = 2 + a_subset = "SEX == 'F'", + statvar = "mean(sd)~median(minmaxc)~q3", + sigdec = "3(2)~2(0)~1", + sparsebyvalyn = "N" ) adsl_sum$tsum diff --git a/man/multi_interval.Rd b/man/multi_interval.Rd index f7650ea..160741e 100644 --- a/man/multi_interval.Rd +++ b/man/multi_interval.Rd @@ -25,7 +25,6 @@ with the corresponding dataframes} Aligned Interval Plot for Adverse Events and Concomitant Medication } \examples{ -library(carver) data(adae) data(cm) multi_interval( diff --git a/man/occ_tier_summary.Rd b/man/occ_tier_summary.Rd index 84cad3f..8fdef26 100644 --- a/man/occ_tier_summary.Rd +++ b/man/occ_tier_summary.Rd @@ -10,11 +10,19 @@ occ_tier_summary( summary_by = "Patients", hterm = "AEBODSYS", lterm = "AEDECOD", + htermctyn = "Y", pctdisp = "TRT", - cutoff = 2, + cutoff_where = NA, + sum_row = "N", + sum_row_label = "Number of Participants with Any AE", apply_hrow_cutoff = "N", sort_opt = "Ascending", - sort_var = "Count" + sort_var = "Count", + sort_col = 1, + nolwrtierdispyn = "N", + sigdec_cat = 2, + pctsyn = "Y", + stathead = "n (\%)" ) } \arguments{ @@ -24,28 +32,48 @@ occ_tier_summary( \item{summary_by}{Measure to construct the summary by. Values: \verb{'Patients' or 'Events'}.} -\item{hterm}{High Level Event term variable, used for analysis} +\item{hterm}{High Level Event term variable, used for analysis (tilde-separated)} \item{lterm}{Low Level Event term variable, used for analysis} +\item{htermctyn}{To show count of high term rows or not. Should correspond to and be same number +of terms passed in \code{hterm} (tilde-separated). To suppress showing counts for any term pass "N"} + \item{pctdisp}{Method to calculate denominator (for \%) by. Possible values: \code{"TRT"}, \code{"VAR"}, \code{"COL"}, \code{"SUBGRP"}, \code{"CAT"}, \code{"NONE"}, \code{"NO"}, \code{"DPTVAR"}, \code{"BYVARxyN"}} -\item{cutoff}{Incidence Cutoff Value; consider only terms with \verb{incidence percentage > cutoff}.} +\item{cutoff_where}{Filter condition for incidence/pct. Consider only terms with +eg: "FREQ > 5" or "PCT <3". Must contain FREQ or PCT (count or percent)} + +\item{sum_row}{To show summary/any term row or not. 'Y'/'N'} + +\item{sum_row_label}{Label for Summary Row to be displayed, if Y.} -\item{apply_hrow_cutoff}{To apply cutoff value to high terms in addition to low term. +\item{apply_hrow_cutoff}{To apply \code{cutoff_where} value to high terms in addition to low term. If set to "Y" same cutoff is applied to remove both high and low level terms that don't meet the criteria. If set to "N" (default), cutoff is applied only to Lower Level term. The terms that do not fit the criteria are then excluded from the counts for High Level term. This does not happen in case -of "N" - all counts are included in high term which is displayed as long as it meets the criteria -as well.} +of "N" - all low terms are included in high term which is displayed as long as it meets the +criteria as well.} \item{sort_opt}{How to sort terms, only for table/forest plot. Values: \verb{'Ascending','Descending','Alphabetical'}.} \item{sort_var}{Metric to sort by. Values: \verb{'Count','Percent','RiskValue'}.} + +\item{sort_col}{Which treatment column to sort by. (Depends on trt levels) eg: 1, 2, 3} + +\item{nolwrtierdispyn}{When\code{apply_hrow_cutoff} = Y, to display high level terms with zero low +level terms satisfying the cutoff threshold or not? If Y, high terms will be displayed even with +no corresponding lower levels in the table.} + +\item{sigdec_cat}{Number of decimal places for \% displayed in output} + +\item{pctsyn}{Display Percentage Sign in table or not. Values: \code{"Y"/"N"}} + +\item{stathead}{Label for sub-column header in output. eg. "n (\%)"} } \value{ Summarized data frame for Adverse Events based on high and lower terms. @@ -53,7 +81,35 @@ Summarized data frame for Adverse Events based on high and lower terms. \description{ Generic Occurrence Summary Tiered Table } +\details{ +\itemize{ +\item \code{cutoff_where} is applied to event lower term only, unless \code{apply_hrow_cutoff} is given. +\item If \code{apply_hrow_cutoff} is Y, cutoff_where is applied to higher terms as well. If it is N, +lower terms which do not meet criteria are removed from higher term count. eg: if \code{cutoff_where} +is set to "PCT >= 2" and \code{hterm} and \code{lterm} are AEBODSYS and AEDECOD: + +EYE DISORDERS 9 (3.1) +Dry eye 3 (1.4) +Wet eye 6 (2.4) + +Here if \code{apply_hrow_cutoff} is set to N then 'Dry eye' row will be excluded and the 3 excluded +from count of EYE DISORDERS as well (9). If Y, then 'Dry eye' will be excluded but EYE DISORDERS +not impacted as it is 4.4\% and its PCT >= 2. + +\item If \code{cutoff_where} is PCT >= 3 and \code{nolwrtierdispyn} set to Y, then +neither Dry eye nor Wet eye will be shown, but EYE DISORDERS will still be displayed. + +If \code{nolwrtierdispyn} is N in this case, EYE DISORDERS will also be removed as no low terms meet +the criteria. +} +} \examples{ +data("adae") +ae_pre_process <- ae_pre_processor( + datain = adae, + obs_residual = 0, + fmq_data = NA +) ae_entry <- ae_pre_process[["data"]] |> mentry( subset = NA, @@ -72,7 +128,7 @@ output <- occ_tier_summary( hterm = "AEBODSYS", lterm = "AEDECOD", pctdisp = "TRT", - cutoff = 2, + cutoff_where = "PCT > 2", apply_hrow_cutoff = "N", sort_opt = "Ascending", sort_var = "Count" @@ -80,5 +136,85 @@ output <- occ_tier_summary( output |> tbl_processor() |> tbl_display() +# Example 2: ADAE table with max sev/ctc grade: +ae_pre <- ae_pre_processor( + adae, + subset = "TRTEMFL == 'Y'", + max_sevctc = "SEV", + sev_ctcvar = "AESEVN", + pt_total = "Y" +) +ae_entry_max <- adsl_merge( + adsl, + adsl_subset = 'SAFFL == "Y"', + ae_pre[["data"]] +) |> + mentry( + subset = NA, + byvar = "AEBODSYS", + trtvar = "TRTA", + trtsort = "TRTAN", + trttotalyn = "N", + add_grpmiss = "N", + subgrpvar = "AESEV", + sgtotalyn = "N", + pop_fil = "Overall Population" + ) +rpt_data <- occ_tier_summary( + ae_entry_max, + a_subset = ae_pre[["a_subset"]], + summary_by = "Patients", + hterm = "AEBODSYS", + lterm = "AEDECOD", + cutoff_where = "FREQ > 2", + pctdisp = "TRT", + sum_row = "Y", + sum_row_label = "Any Adverse Event", + nolwrtierdispyn = "N", + sort_opt = "Alphabetical", + stathead = "n (\%)" +) +rpt_data |> + tbl_processor() |> + tbl_display(dpthead = "No. of Adverse Events_SOC and PT") |> + flextable::autofit() +## ADPR Example: +\dontrun{ +pr_entry <- adsl |> + adsl_merge( + adsl_subset = "SAFFL == 'Y'", + dataset_add = adpr + ) |> + mentry( + subset = NA, + byvar = "PRSOC", + trtvar = "TRT01A", + trtsort = "TRT01AN", + trttotalyn = "N", + add_grpmiss = "N", + sgtotalyn = "N", + pop_fil = "Overall Population" + ) +output <- occ_tier_summary( + pr_entry, + a_subset = "ONPERFL == 'Y' & PRDECOD != ''", + summary_by = "Patients", + hterm = "PRSOC", + lterm = "PRDECOD", + pctdisp = "TRT", + apply_hrow_cutoff = "N", + sort_opt = "Ascending", + sort_var = "Count", + sum_row = "Y", + sum_row_label = "Participants with 1 term", + htermctyn = "N" +) +output |> + display_bign_head( + mentry_data = pr_entry + ) |> + tbl_processor() |> + tbl_display() +} } diff --git a/man/plot_axis_opts.Rd b/man/plot_axis_opts.Rd index 27e8ea7..4edd526 100644 --- a/man/plot_axis_opts.Rd +++ b/man/plot_axis_opts.Rd @@ -41,8 +41,6 @@ Combined list of X and Y axis options Plot Axes Options } \examples{ -library(carver) - plot_axis_opts( xlinearopts = list( breaks = c(0.001, 0.01, 0.1, 1, 10, 100), diff --git a/man/plot_display_bign.Rd b/man/plot_display_bign.Rd index deda4b6..3ef9ccc 100644 --- a/man/plot_display_bign.Rd +++ b/man/plot_display_bign.Rd @@ -32,7 +32,7 @@ adsl_entry <- adsl |> msumstat( adsl_entry, dptvar = "AGE", - statvar = "meansd" + statvar = "mean" )$gsum |> plot_display_bign(adsl_entry) } diff --git a/man/process_edish_data.Rd b/man/process_edish_data.Rd index eef09d1..8e13d12 100644 --- a/man/process_edish_data.Rd +++ b/man/process_edish_data.Rd @@ -7,9 +7,10 @@ process_edish_data( datain, xvar = "both", - alt_paramcd = "L00030S", - ast_paramcd = "L00028S", - bili_paramcd = "L00021S" + alt_paramcd = "ALT", + ast_paramcd = "AST", + bili_paramcd = "BILI", + legendbign = "Y" ) } \arguments{ @@ -26,6 +27,8 @@ variable.} \item{ast_paramcd}{\code{PARAMCD} value for \verb{ASPARTATE AMINOTRANSFERASE} in \code{datain}.} \item{bili_paramcd}{\code{PARAMCD} value for \code{BILIRUBIN} in \code{datain}.} + +\item{legendbign}{(\code{string}) Display BIGN in Legend (\code{Y/N}).} } \value{ A \code{data.frame} required for \code{edish_plot}. diff --git a/man/process_tornado_data.Rd b/man/process_tornado_data.Rd index 977d2ca..199805e 100644 --- a/man/process_tornado_data.Rd +++ b/man/process_tornado_data.Rd @@ -9,8 +9,9 @@ process_tornado_data( dataset_analysis, adsl_subset = NA_character_, analysis_subset = NA_character_, - ae_filter = "Any Event", obs_residual = NA_real_, + ae_filter = "Any Event", + pop_fil = NA_character_, fmq_data = NULL, split_by = NA_character_, ae_catvar, @@ -18,11 +19,11 @@ process_tornado_data( trt_left, trt_right, trtsort = NA_character_, - pop_fil = "Overall Population", + subset = NA_character_, pctdisp = "TRT", denom_subset = NA_character_, legendbign = "N", - yvar + yvar = "AESOC" ) } \arguments{ @@ -32,22 +33,25 @@ process_tornado_data( \item{adsl_subset}{(\code{string}) Subset condition to be applied on \code{dataset_adsl}.} -\item{analysis_subset}{Subset conditions for overall data.} +\item{analysis_subset}{Subset conditions for \code{dataset_analysis}} + +\item{obs_residual}{If not NA, use this argument to pass a period (numeric) to extend the +observation period. If passed as NA, overall study duration is considered for analysis. +eg. if 5, only events occurring upto 5 days past the TRTEDT are considered.} \item{ae_filter}{Vector of adverse event types to be used as filter conditions. Permissible Values: "ANY", "ANY EVENT", "TREATMENT EMERGENT", "SERIOUS", "DRUG-RELATED", "RELATED", "MILD", "MODERATE", "SEVERE", "RECOVERED/RESOLVED", "RECOVERING/RESOLVING", "NOT RECOVERING/NOT RESOLVING", "FATAL", "GRADE N"} -\item{obs_residual}{If not NA, use this argument to pass a period (numeric) to extend the -observation period. If passed as NA, overall study duration is considered for analysis. -eg. if 5, only events occurring upto 5 days past the TRTEDT are considered.} +\item{pop_fil}{Population Filter for data set: Name of flag variable. +eg: \code{"SAFFL"}, \code{"EFFFL"} or \code{NA} for Overall Population.} \item{fmq_data}{FMQ table dataframe, if passed, will be merged to adae date by PT.} \item{split_by}{(\code{string}) By variable for stratification.} -\item{ae_catvar}{Categorical variable for severity analysis.} +\item{ae_catvar}{Categorical variable for severity analysis and order variable. eg; "ASEV/ASEVN"} \item{trtvar}{(\code{string}) Treatment Variable to be created for analysis.} @@ -57,7 +61,7 @@ eg. if 5, only events occurring upto 5 days past the TRTEDT are considered.} \item{trtsort}{(\code{string}) Variable to sort treatment variable by.} -\item{pop_fil}{Population Filter for data set: Name of flag variable. +\item{subset}{Overall subset for data set. eg: "EFFFL == 'Y'" eg: \code{"SAFFL"}, \code{"EFFFL"} or \code{NA} for Overall Population.} \item{pctdisp}{Method to calculate denominator (for \%) by @@ -79,7 +83,8 @@ Pre-process data for tornado plot \details{ \itemize{ \item ae_catvar grouping variable for severity like AESEV(MILD, MODERATE, -SEVERE). It must also have it's numeric variable in the dataset. +SEVERE). It must be passed "/" separated with its numeric variable. +eg: ASEV/ASEVN; ATOXGR/ATOXGRN \item yvar(dptvar) Adverse Event category, derived term from AE. Possible Values: AEBODSYS, AEDECOD, AEHLT, AEHLGT. } @@ -88,18 +93,16 @@ Possible Values: AEBODSYS, AEDECOD, AEHLT, AEHLGT. data(tornado_plot_data) process_tornado_data( - dataset_adsl = tornado_plot_data[["adsl"]], - dataset_analysis = tornado_plot_data[["adae"]], + dataset_adsl = adsl, + dataset_analysis = adae, adsl_subset = "SAFFL == 'Y'", - analysis_subset = NA_character_, - ae_filter = "Treatment emergent", + analysis_subset = "TRTEMFL == 'Y'", obs_residual = "30", fmq_data = NA, - ae_catvar = "AESEV", - trtvar = "ARMCD", - trt_left = "A", - trt_right = "A", - pop_fil = "Overall Population", + ae_catvar = "AESEV/AESEVN", + trtvar = "ARM", + trt_left = "Xanomeline High Dose", + trt_right = "Xanomeline Low Dose", pctdisp = "TRT", denom_subset = NA_character_, legendbign = "N", diff --git a/man/process_vx_bar_plot.Rd b/man/process_vx_bar_plot.Rd deleted file mode 100644 index aea69c5..0000000 --- a/man/process_vx_bar_plot.Rd +++ /dev/null @@ -1,92 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/process_vx_bar_plot.R -\name{process_vx_bar_plot} -\alias{process_vx_bar_plot} -\title{Pre-Process data for Bar Plot} -\usage{ -process_vx_bar_plot( - dataset_adsl, - adsl_subset = "SAFFL=='Y'", - dataset_analysis, - analysis_subset = NA_character_, - overall_subset = NA_character_, - denom_subset = NA_character_, - split_by = NA_character_, - trtvar = "TRT01A", - trtsort = "TRT01AN", - xvar = "ATPTN", - yvar = "PCT", - pctdisp = "DPTVAR", - legendbign = "Y" -) -} -\arguments{ -\item{dataset_adsl}{(\code{data.frame}) ADSL dataset.} - -\item{adsl_subset}{(\code{string}) Subset condition to be applied on \code{dataset_adsl}.} - -\item{dataset_analysis}{(\code{data.frame}) Analysis Dataset.} - -\item{analysis_subset}{Subset conditions for analysis of dependent variable -Applicable only to numerator calculation for \%} - -\item{overall_subset}{Subset conditions for overall data.} - -\item{denom_subset}{Subset condition to be applied to data set for -calculating denominator.} - -\item{split_by}{(\code{string}) By variable for stratification.} - -\item{trtvar}{(\code{string}) Treatment Variable to be created for analysis.} - -\item{trtsort}{(\code{string}) Variable to sort treatment variable by.} - -\item{xvar}{Categorical Analysis variable for X axis} - -\item{yvar}{Y axis variable/statistic. Possible Values: "FREQ"/"PCT"} - -\item{pctdisp}{Method to calculate denominator (for \%) by -Possible values: "TRT","VAR","COL","SUBGRP","CAT","NONE","NO","DPTVAR"} - -\item{legendbign}{(\code{string}) Display count as (N = ..) in Treatment legend? Values: "Y"/"N"} -} -\value{ -mcatstat dataset as data frame. -} -\description{ -Pre-Process data for Bar Plot -} -\details{ -\itemize{ -\item Subset Processing -Applying population subset selected -Applying denominator/overall subset condition passed by the user -Applying analysis/numerator subset condition passed by the user. -\item pctdisp has possible values for method to get denominator to calculate -percentage, passed to \code{mcatstat()}. The commonly passed value for vaccine -bar plot is: -DPTVAR: Percentage within each Treatment-By group(s)-Subgroup(s)-dptvar -combination. -} -} -\examples{ -data(vx_bar_data) - -process_vx_bar_plot( - dataset_adsl = vx_bar_data$adsl, - adsl_subset = "SAFFL=='Y'", - dataset_analysis = vx_bar_data$adfacevd, - analysis_subset = "ATPTN <= 14 & toupper(FAOBJ) == 'PAIN AT INJECTION SITE' & - !(AVAL \%in\% c(0, 0.5)) & FATESTCD != 'OCCUR' & !is.na(AVAL)", - denom_subset = "ATPTN <= 14 & toupper(FAOBJ) == 'PAIN AT INJECTION SITE' & - !(AVAL \%in\% c(0, 0.5))", - overall_subset = NA, - split_by = "SEX", - trtvar = "TRT01A", - trtsort = "TRT01AN", - xvar = "ATPTN", - yvar = "PCT", - pctdisp = "DPTVAR" -) - -} diff --git a/man/process_vx_box_data.Rd b/man/process_vx_box_data.Rd deleted file mode 100644 index 79577e6..0000000 --- a/man/process_vx_box_data.Rd +++ /dev/null @@ -1,72 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/vx_boxplot.R -\name{process_vx_box_data} -\alias{process_vx_box_data} -\title{Process data for vaccine boxplot} -\usage{ -process_vx_box_data( - dataset_adsl, - dataset_analysis, - adsl_subset = "SAFFL == 'Y'", - analysis_subset = "((ANL08FL == 'Y')|(ANL09FL=='Y'))&(ARMCD!='')", - split_by = NA_character_, - trtvar = "TRT01A", - trtsort = "TRT01AN", - xvar = "AVISIT", - yvar = "AVAL", - ystat = "mean", - legendbign = "Y", - ada_nab_opts = list(N = "1~2", LAB = "ADA Titer (log2)~NAb Titer (log2)", REF = - "6.23~1.58", DIL = "75~3") -) -} -\arguments{ -\item{dataset_adsl}{(\code{data.frame}) ADSL dataset.} - -\item{dataset_analysis}{(\code{data.frame}) Analysis Dataset.} - -\item{adsl_subset}{(\code{string}) Subset condition to be applied on \code{dataset_adsl}.} - -\item{analysis_subset}{(\code{string}) Subset Condition to be applied on \code{dataset_analysis}.} - -\item{split_by}{(\code{string}) By variable for stratification.} - -\item{trtvar}{(\code{string}) Treatment Variable to be created for analysis.} - -\item{trtsort}{(\code{string}) Variable to sort treatment variable by.} - -\item{xvar}{(\code{string}) Values for X axis, determined by filter condition for -analysis visit.} - -\item{yvar}{(\code{string}) Values for Y axis, determined by filter condition for -analysis visit.} - -\item{ystat}{Additional Statistic to be calculated and plotted as markers. -Values: 'mean', 'sum', 'sd' etc} - -\item{legendbign}{(\code{string}) Display count as (N = ..) in Treatment legend? Values: "Y"/"N"} - -\item{ada_nab_opts}{List of values of : \emph{PARAMN}, Y axis Label, Reference -line value and Dilution (for footnote) corresponding to ADA and NAb titers -respectively. Format: list(N = "1~2", -LAB = "ADA Titer (log2)~NAb Titer (log2)", REF = "6.23~1.58", DIL = "75~3")} -} -\value{ -Dataframe containing analysis values for requisite box plot statistics -} -\description{ -Process data for vaccine boxplot -} -\examples{ -data(vx_box_data) -process_vx_box_data( - dataset_adsl = vx_box_data$adsl, - dataset_analysis = vx_box_data$adisda, - adsl_subset = "RANDFL == 'Y'", - analysis_subset = "((ANL08FL == 'Y')|(ANL09FL=='Y'))&(ARMCD!='')&(PARAMN \%in\% c(1, 2))", - trtvar = "TRTA", - trtsort = "TRTAN", - xvar = "AVISIT", - ystat = "mean" -) -} diff --git a/man/process_vx_scatter_data.Rd b/man/process_vx_scatter_data.Rd deleted file mode 100644 index 270eb9e..0000000 --- a/man/process_vx_scatter_data.Rd +++ /dev/null @@ -1,65 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/scatter_plot.R -\name{process_vx_scatter_data} -\alias{process_vx_scatter_data} -\title{Process data for Vaccines Scatter Plot} -\usage{ -process_vx_scatter_data( - dataset_adsl, - dataset_analysis, - adsl_subset, - analysis_subset = NA_character_, - split_by = NA_character_, - trtvar, - trtsort = NA, - xvar = "AVISITN == 1", - yvar = "AVISITN == 2", - legendbign = "Y" -) -} -\arguments{ -\item{dataset_adsl}{(\code{data.frame}) ADSL dataset.} - -\item{dataset_analysis}{(\code{data.frame}) Analysis Dataset.} - -\item{adsl_subset}{(\code{string}) Subset condition to be applied on \code{dataset_adsl}.} - -\item{analysis_subset}{(\code{string}) Subset Condition to be applied on \code{dataset_analysis}.} - -\item{split_by}{(\code{string}) By variable for stratification.} - -\item{trtvar}{(\code{string}) Treatment Variable to be created for analysis.} - -\item{trtsort}{(\code{string}) Variable to sort treatment variable by.} - -\item{xvar}{(\code{string}) Values for X axis, determined by filter condition for -analysis visit.} - -\item{yvar}{(\code{string}) Values for Y axis, determined by filter condition for -analysis visit.} - -\item{legendbign}{(\code{string}) Display count as (N = ..) in Treatment legend? Values: "Y"/"N"} -} -\value{ -Grouped Data Frames within a list -} -\description{ -Process data for Vaccines Scatter Plot -} -\examples{ -data("vx_scatter_data") - -process_vx_scatter_data( - dataset_adsl = vx_scatter_data[["adsl"]], - dataset_analysis = vx_scatter_data[["adva"]], - adsl_subset = 'EVALFL=="Y"', - analysis_subset = 'ANL01FL=="Y" & PARAMN==23 & -((AVISITN ==1 & EVALFL=="Y")|(AVISITN==2 & EVALFL=="Y" & EXCL5FL=="N")) & - TRTA!="" & DTYPE=="LLOQIMP" & !is.na(AVAL)', # nolint - split_by = "SEX", - trtvar = "ACTARM", - xvar = "AVISITN == 1", - yvar = "AVISITN == 2" -) - -} diff --git a/man/reverselog_trans.Rd b/man/reverselog_trans.Rd index 1049e80..d8612a4 100644 --- a/man/reverselog_trans.Rd +++ b/man/reverselog_trans.Rd @@ -16,7 +16,6 @@ Transformation object per given base Reverse Log transformation of value to pass to scale options } \examples{ -library(carver) library(ggplot2) ggplot(data = mtcars, mapping = aes(x = mpg, y = hp)) + geom_point() + diff --git a/man/risk_stat.Rd b/man/risk_stat.Rd index e7fceca..11f30e7 100644 --- a/man/risk_stat.Rd +++ b/man/risk_stat.Rd @@ -13,14 +13,19 @@ risk_stat( trtgrp, statistics = "Risk Ratio", alpha = 0.05, - cutoff = 2, - sort_opt, - sort_var, - g_sort_by_ht = "N" + cutoff_where = NA, + sort_opt = "Ascending", + sort_var = "Count", + g_sort_by_ht = "N", + riskdiff_pct = "N", + sigdec = 1, + pctsyn = "Y", + hoveryn = "Y" ) } \arguments{ -\item{datain}{Input dataset after pre_processing and running \code{mentry()} to \emph{ADAE} data} +\item{datain}{Input data from \code{mentry()} output to get counts for each +category} \item{a_subset}{Analysis Subset condition specific to categorical analysis.} @@ -37,7 +42,8 @@ for \code{forest_plot()}.} \item{alpha}{Alpha value to determine confidence interval for risk calculation. Default: \code{0.05}} -\item{cutoff}{Incidence Cutoff Value; consider only terms with \verb{incidence percentage > cutoff}.} +\item{cutoff_where}{Filter condition for incidence/pct. Consider only terms with +eg: "FREQ > 5" or "PCT <3". Must contain FREQ or PCT (count or percent)} \item{sort_opt}{How to sort terms, only for table/forest plot. Values: \verb{'Ascending','Descending','Alphabetical'}.} @@ -47,6 +53,14 @@ Values: \verb{'Ascending','Descending','Alphabetical'}.} \item{g_sort_by_ht}{For Forest Plot only - include sorting by high term/\emph{BYVAR1}? Values: "Y"/"N". In the output, terms will be sorted by group first, then term. To be used along with \code{ht_dispyn} = Y in \code{ae_forest_plot()}} + +\item{riskdiff_pct}{To display risk and CI as \% if \code{statistic} = risk difference (Y/N)} + +\item{sigdec}{Number of decimal places for \% displayed in output} + +\item{pctsyn}{Display Percentage Sign in table or not. Values: \code{"Y"/"N"}} + +\item{hoveryn}{Include hover information (for graphs) Y/N} } \value{ A dataset containing risk statistic calculations for given treatment pair(s). @@ -80,7 +94,7 @@ risk_stat( trtgrp = "Xanomeline High Dose", statistics = "Risk Ratio", alpha = 0.05, - cutoff = 2, + cutoff_where = "PCT > 2", sort_opt = "Ascending", sort_var = "Count" ) diff --git a/man/riskdiff_wald.Rd b/man/riskdiff_wald.Rd index 0f01e24..13d17e8 100644 --- a/man/riskdiff_wald.Rd +++ b/man/riskdiff_wald.Rd @@ -1,26 +1,10 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/risk_stat.R, R/riskdiff_wald.R +% Please edit documentation in R/risk_stat.R \name{riskdiff_wald} \alias{riskdiff_wald} \title{Calculate Risk difference} \usage{ -riskdiff_wald( - x, - y = NULL, - conf.level = 0.95, - rev = c("neither", "rows", "columns", "both"), - correction = FALSE, - verbose = FALSE -) - -riskdiff_wald( - x, - y = NULL, - conf.level = 0.95, - rev = c("neither", "rows", "columns", "both"), - correction = FALSE, - verbose = FALSE -) +riskdiff_wald(x, conf.level = 0.95) } \arguments{ \item{x}{input data @@ -28,26 +12,12 @@ input data can be one of the following: r x 2 table, vector of numbers from a contigency table (will be transformed into r x 2 table in row-wise order), or single factor or character vector that will be combined with y into a table.} -\item{y}{single factor or character vector that will be combined with x into a table -(default is NULL)} - \item{conf.level}{confidence level (default is 0.95)} - -\item{rev}{reverse order of "rows", "colums", "both", or "neither" (default)} - -\item{correction}{Yate's continuity correction} - -\item{verbose}{To return more detailed results} } \value{ -a list containg a data,measure,p.value,correction - a list containg a data,measure,p.value,correction } \description{ -Function to calculate risk difference by unconditional maximum likelihood estimation (Wald) -for any given treatment pairs. - Function to calculate risk difference by unconditional maximum likelihood estimation (Wald) for any given treatment pairs. } @@ -56,11 +26,4 @@ riskdiff_wald( x = matrix(c(178, 79, 1411, 1486), 2, 2), conf.level = 0.95 ) -riskdiff_wald( - x = matrix(c(178, 79, 1411, 1486), 2, 2), - conf.level = 0.95, - rev = c("neither", "rows", "columns", "both"), - correction = FALSE, - verbose = FALSE -) } diff --git a/man/scatter_plot.Rd b/man/scatter_plot.Rd index 9f2761a..7c02b1c 100644 --- a/man/scatter_plot.Rd +++ b/man/scatter_plot.Rd @@ -16,7 +16,7 @@ scatter_plot( ) } \arguments{ -\item{datain}{\code{data.frame} retrieved from \code{process_vx_scatter_data()}.} +\item{datain}{Input \code{data.frame}.} \item{axis_opts}{A \code{list} of axis specific options retrieved from \code{plot_axis_opts()}.} @@ -44,73 +44,46 @@ Create Scatter Plot } \examples{ library(dplyr) -library(purrr) # Example 1 -data("vx_scatter_data") - -## process data for plotting -scatter_df <- - process_vx_scatter_data( - dataset_adsl = vx_scatter_data[["adsl"]], - adsl_subset = 'EVALFL=="Y"', - dataset_analysis = vx_scatter_data[["adva"]], - analysis_subset = 'ANL01FL=="Y" & PARAMN==23 & -((AVISITN ==1 & EVALFL=="Y")|(AVISITN==2 & EVALFL=="Y" & EXCL5FL=="N")) & # nolint - TRTA!="" & DTYPE=="LLOQIMP" & !is.na(AVAL)', # nolint - split_by = "SEX", - trtvar = "ACTARM", - xvar = "AVISITN == 1", - yvar = "AVISITN == 2", - legendbign = "Y" - ) - -## shape, color and symbols -series_opts <- plot_aes_opts( - datain = scatter_df, - series_color = "#F8766D~#619CFF", - series_shape = "circle~triangle", - series_size = as.numeric(str_to_vec("2~2")) -) - -## splitting data to generate scatter plots of each subgroup (only if `split_by` is specified in -## `process_vx_scatter_data`) -data_list <- split_data_by_var( - datain = scatter_df, - split_by_prefix = "SUBGRPVAR" -) - -## map over `scatter_plot` on split data -purrr::map(data_list, \(p) { +data(adsl) + +mentry_df <- adsl |> + mentry( + subset = "AGE < 60", + byvar = NA_character_, + trtvar = "TRT01A", + trtsort = "TRT01AN", + subgrpvar = NA_character_, + trttotalyn = "N", + add_grpmiss = "N", + pop_fil = "SAFFL" + ) |> + dplyr::mutate(XVAR = as.integer(factor(USUBJID)), YVAR = AGE) +mentry_df |> scatter_plot( - datain = p, axis_opts = plot_axis_opts( xlinearopts = list( - breaks = c(0.001, 0.01, 0.1, 1, 10, 100), - limits = c(0.001, 100) + breaks = sort(unique(mentry_df$XVAR)), + labels = sort(unique(mentry_df$USUBJID)) ), - ylinearopts = list( - breaks = c(0.001, 0.01, 0.1, 1, 10, 100, 1000), - limits = c(0.001, 1000) - ), - xaxis_scale = "log10", - yaxis_scale = "log10", - xaxis_label = "Before Vaccination 1", - yaxis_label = "1 Month after Vaccination 1" + xopts = list(angle = 15) ), series_var = "TRTVAR", series_labelvar = "TRTVAR", - series_opts = series_opts, + series_opts = list( + shape = c(16, 17, 18), + color = scales::hue_pal()(3), + size = c(2, 2, 3) + ), legend_opts = list( - label = "", + label = "Treatment", pos = "bottom", dir = "horizontal" ), - plot_title = paste("Number of Participants = ", length(unique(p$SUBJID))), - griddisplay = "Y" + plot_title = "Scatter Plot of Subject vs Age" ) -}) # Example 2 diff --git a/man/split_section_headers.Rd b/man/split_section_headers.Rd index 631172f..48e2a8d 100644 --- a/man/split_section_headers.Rd +++ b/man/split_section_headers.Rd @@ -8,7 +8,7 @@ split_section_headers( datain, split_by = "", split_by_prefix = "", - split_lab = "", + split_lab = " ", sep = "~" ) } diff --git a/man/summary_functions.Rd b/man/summary_functions.Rd index f89f763..23b4176 100644 --- a/man/summary_functions.Rd +++ b/man/summary_functions.Rd @@ -1,21 +1,25 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/utils.R +% Please edit documentation in R/stat_utils.R \name{summary_functions} \alias{summary_functions} -\title{Create summary stats function for use within \code{msumstat()}} +\title{List of Summary Functions} \usage{ -summary_functions(sigdec = 2) +summary_functions(statvar, statdec) } \arguments{ -\item{sigdec}{Number of significant decimal places (base)} +\item{statvar}{Input statistics} + +\item{statdec}{Corresponding number of decimal places for each statistic} } \value{ -a named list containing function definition for all defined summary -statistics - mean, min, max, median, iqr, var, sum, sd, q25, q75, p1, p5, -p10, p90, p95, p99 (where last digits represent \% of quantile), meansd, -range, q1q3, medianrange (concatenation of indicated names), whiskerlow, -whiskerup, outliers in the Tukey method for box statistics +A named list containing function definition for all defined summary +statistics - mean, min, max, median, mode iqr, var, sum, sd, q25, q75, p1, p5, +p10, p90, p95, p99 (where last digits represent \% of quantile), whiskerlow, +whiskerup, outliers in the Tukey method for box statistics, geometric mean/sd/CI } \description{ -Create summary stats function for use within \code{msumstat()} +List of Summary Functions +} +\examples{ +summary_functions(c("mean", "mode"), c(2, 1)) } diff --git a/man/summary_row_cat.Rd b/man/summary_row_cat.Rd new file mode 100644 index 0000000..1cce857 --- /dev/null +++ b/man/summary_row_cat.Rd @@ -0,0 +1,54 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/occ_tier_summary.R +\name{summary_row_cat} +\alias{summary_row_cat} +\title{Insert Overall/Summary Row} +\usage{ +summary_row_cat( + datain, + sum_row_label = "Any Term", + byvaryn = "N", + a_subset = NA, + pctdisp = "TRT", + sigdec = 2, + pctsyn = "Y", + var = "ANY", + uniqid = "USUBJID" +) +} +\arguments{ +\item{datain}{Input dataset \code{ADAM} or intermediate within summary function} + +\item{sum_row_label}{Label for Summary Row to be displayed, if Y.} + +\item{byvaryn}{Include by variable or not? For single overally row, "N"} + +\item{a_subset}{Analysis Subset condition specific to categorical analysis.} + +\item{pctdisp}{Method to calculate denominator (for \%) by. +Possible values: \code{"TRT"}, \code{"VAR"}, \code{"COL"}, \code{"SUBGRP"}, \code{"CAT"}, \code{"NONE"}, \code{"NO"}, \code{"DPTVAR"}, +\code{"BYVARxyN"}} + +\item{sigdec}{Number of decimal places for \% displayed in output} + +\item{pctsyn}{Display Percentage Sign in table or not. Values: \code{"Y"/"N"}} + +\item{var}{Flag Variable to identify Any/Summary Rows} + +\item{uniqid}{Variable(s) to calculate unique counts of. eg. \code{"USUBJID"}, \code{"SITEID"}, +\code{"ALLCT"}} +} +\value{ +dataframe with single overall row count +} +\description{ +Insert Overall/Summary Row +} +\examples{ +data("adae") +summary_row_cat( + adae, + a_subset = "TRTEMFL == 'Y'" +) + +} diff --git a/man/surv_pre_processor.Rd b/man/surv_pre_processor.Rd deleted file mode 100644 index fad806f..0000000 --- a/man/surv_pre_processor.Rd +++ /dev/null @@ -1,66 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/surv_utils.R -\name{surv_pre_processor} -\alias{surv_pre_processor} -\title{Process data for Survival Analysis} -\usage{ -surv_pre_processor( - dataset_adsl, - dataset_analysis, - adsl_subset = "RANDFL=='Y'", - analysis_subset = NA_character_, - split_by = NA_character_, - trtvar = "TRT01P", - trtsort = "TRT01PN", - censor_var = "CNSR", - censor_val = 1, - time_var = "AVAL" -) -} -\arguments{ -\item{dataset_adsl}{(\code{data.frame}) ADSL dataset.} - -\item{dataset_analysis}{(\code{data.frame}) Analysis Dataset.} - -\item{adsl_subset}{(\code{string}) Subset condition to be applied on \code{dataset_adsl}.} - -\item{analysis_subset}{(\code{string}) Subset Condition to be applied on \code{dataset_analysis}.} - -\item{split_by}{(\code{string}) By variable for stratification.} - -\item{trtvar}{(\code{string}) Treatment Variable to be created for analysis.} - -\item{trtsort}{(\code{string}) Variable to sort treatment variable by.} - -\item{censor_var}{Censoring Variable in the input dataset to be used in -ph reg model.Default: \code{"CNSR"}} - -\item{censor_val}{Value within \code{CNSR} variable to be considered as Censor -value.Default: \code{1}} - -\item{time_var}{Duration variable in the input dataset to be used in -proportional hazard regression model. Default: \code{"AVAL"}} -} -\value{ -Data frame with added variables for survival analysis -} -\description{ -Process data for Survival Analysis -} -\examples{ -data("survival") - -survival$adsl |> - surv_pre_processor( - dataset_analysis = survival$adtte, - adsl_subset = "RANDFL=='Y'", - analysis_subset = "PARAMCD=='OS' & FASFL=='Y'", - split_by = NA_character_, - trtvar = "TRT01P", - trtsort = "TRT01PN", - censor_var = "CNSR", - censor_val = 1, - time_var = "AVAL" - ) - -} diff --git a/man/tbl_display.Rd b/man/tbl_display.Rd index 9385032..4384b70 100644 --- a/man/tbl_display.Rd +++ b/man/tbl_display.Rd @@ -4,7 +4,14 @@ \alias{tbl_display} \title{Create flextable output from display templates} \usage{ -tbl_display(datain, bylabel, dpthead = " ", font = "Arial", fontsize = 10) +tbl_display( + datain, + bylabel = NA, + dpthead = " ", + font = "Arial", + fontsize = 10, + boldheadyn = "N" +) } \arguments{ \item{datain}{Input dataframe} @@ -16,6 +23,8 @@ tbl_display(datain, bylabel, dpthead = " ", font = "Arial", fontsize = 10) \item{font}{Font face for text inside table} \item{fontsize}{Font size for text inside table} + +\item{boldheadyn}{Y/N to determine if table header should be bold} } \value{ flextable object diff --git a/man/tbl_risk_labels.Rd b/man/tbl_risk_labels.Rd new file mode 100644 index 0000000..a34f9c6 --- /dev/null +++ b/man/tbl_risk_labels.Rd @@ -0,0 +1,17 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/adae_risk_summary.R +\name{tbl_risk_labels} +\alias{tbl_risk_labels} +\title{Labels for AE risk table} +\usage{ +tbl_risk_labels(statistic) +} +\arguments{ +\item{statistic}{Required Statistic: Risk Ratio or Risk Difference} +} +\value{ +list of labels +} +\description{ +Labels for AE risk table +} diff --git a/man/tbl_to_plot.Rd b/man/tbl_to_plot.Rd index 6b1fdd0..94f6807 100644 --- a/man/tbl_to_plot.Rd +++ b/man/tbl_to_plot.Rd @@ -40,7 +40,6 @@ ggplot object Convert dataframe into ggplot object table } \examples{ -library(carver) MPG <- ggplot2::mpg MPG[["cyl"]] <- as.character(MPG[["cyl"]]) tbl_to_plot( diff --git a/man/tornado_plot.Rd b/man/tornado_plot.Rd index 915ea3c..22c44d0 100644 --- a/man/tornado_plot.Rd +++ b/man/tornado_plot.Rd @@ -43,21 +43,20 @@ Plot object Tornado Plot } \examples{ -data(tornado_plot_data) +data("adsl") +data("adae") tornado_df <- process_tornado_data( - dataset_adsl = tornado_plot_data[["adsl"]], - dataset_analysis = tornado_plot_data[["adae"]], + dataset_adsl = adsl, + dataset_analysis = adae, adsl_subset = "SAFFL == 'Y'", - analysis_subset = NA_character_, - ae_filter = "Treatment emergent", + analysis_subset = "TRTEMFL == 'Y'", obs_residual = "30", fmq_data = NA, - ae_catvar = "AESEV", - trtvar = "ARMCD", - trt_left = "A", - trt_right = "A", - pop_fil = "Overall Population", + ae_catvar = "AESEV/AESEVN", + trtvar = "ARM", + trt_left = "Xanomeline High Dose", + trt_right = "Xanomeline Low Dose", pctdisp = "TRT", denom_subset = NA_character_, legendbign = "N", diff --git a/man/vx_box_plot.Rd b/man/vx_box_plot.Rd deleted file mode 100644 index f339ea4..0000000 --- a/man/vx_box_plot.Rd +++ /dev/null @@ -1,93 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/vx_boxplot.R -\name{vx_box_plot} -\alias{vx_box_plot} -\title{Generate Vaccine Boxplots for antibody titer using analysed data} -\usage{ -vx_box_plot( - datalist, - axis_opts, - series_opts, - legend_opts = list(lab = "", pos = "bottom", dir = "horizontal"), - box_opts = c(0.7, 0.9), - ystat = "mean", - griddisplay = "N" -) -} -\arguments{ -\item{datalist}{List of Input datasets, retrieved from -\code{process_vx_box_data()} and \code{split_data_by_var()}} - -\item{axis_opts}{A \code{list} of axis specific options retrieved from \code{plot_axis_opts()}.} - -\item{series_opts}{Series Variable styling options, a \code{list} containing -\code{shape}, \code{color} and \code{size}.} - -\item{legend_opts}{Legend styling option, a \code{list} containing \code{label}, \code{pos}(position) and -\code{dir} (direction).} - -\item{box_opts}{Vector containing: -\enumerate{ -\item Width of individual boxes in plot and -\item Width of the interval between box-groups of X axis. eg. c(0.9, 0.9) -}} - -\item{ystat}{Additional statistic to be plotted as markers. Default: \emph{mean}} - -\item{griddisplay}{Display Grid \code{(Y/N)}.} -} -\value{ -a list of lists, each of 2 elements: -\itemize{ -\item \code{plot} Plot output -\item \code{footnote} Text to be considered as first line of footnote in report -} -} -\description{ -Creates 2 similar plots with slightly different specifications according to -parameter i.e., ADA or NaB titer values are plotted in 2 separate graphs -} -\details{ -Input data should come from output of \code{process_vx_box_data()} and -is expected to have the standardised variable XVAR and ada_nab_opts -} -\examples{ -data(vx_box_data) -plot_data <- process_vx_box_data( - dataset_adsl = vx_box_data$adsl, - dataset_analysis = vx_box_data$adisda, - adsl_subset = "RANDFL == 'Y'", - analysis_subset = "((ANL08FL == 'Y')|(ANL09FL=='Y'))&(ARMCD!='')&(PARAMN \%in\% c(1, 2))", - trtvar = "TRTA", - trtsort = "TRTAN", - xvar = "AVISIT", - ystat = "mean", - legendbign = "Y" -) -series_opts <- plot_aes_opts( - datain = plot_data, - series_color = c("red", "blue", "green"), - series_shape = c("circlefilled", "trianglefilled", "squarefilled"), - series_size = c(2, 2, 2) -) - -# Splitting data to generate separate plots by `split_by` variable -data_list <- split_data_by_var( - datain = plot_data, - split_by_prefix = "SUBGRPVAR" -) - -vx_box_plot( - datalist = data_list, - axis_opts = plot_axis_opts( - xaxis_label = "Visits" - ), - series_opts = series_opts, - legend_opts = list( - lab = "Treatment", - pos = "bottom", - dir = "horizontal" - ), - ystat = "mean" -)[[1]][[1]] -} diff --git a/tests/testthat/_snaps/adae_risk_summary.md b/tests/testthat/_snaps/adae_risk_summary.md index b6ac995..31c2087 100644 --- a/tests/testthat/_snaps/adae_risk_summary.md +++ b/tests/testthat/_snaps/adae_risk_summary.md @@ -1,46 +1,98 @@ -# Standard Inputs work +# Test Case 1: adae_summary with standard inputs works + + Code + ae_risk + Output + # A tibble: 48 x 30 + TRTVAR DPTVAR DPTVAL CVALUE DENOMN FREQ PCT CPCT XVAR CN PVALUE + + 1 Placebo TIER CARDI~ 1 ( 1~ 62 1 1.61 " 1.~ CARD~ C 0.236 + 2 Placebo TIER RESPI~ 1 ( 1~ 62 1 1.61 " 1.~ RESP~ C 0.141 + 3 Xanomeline ~ TIER CARDI~ 4 ( 5~ 73 4 5.48 " 5.~ CARD~ C 0.236 + 4 Xanomeline ~ TIER RESPI~ 5 ( 6~ 73 5 6.85 " 6.~ RESP~ C 0.141 + 5 Placebo TIER NERVO~ 2 ( 3~ 62 2 3.23 " 3.~ NERV~ C 0.221 + 6 Xanomeline ~ TIER NERVO~ 6 ( 8~ 73 6 8.22 " 8.~ NERV~ C 0.221 + 7 Placebo TIER INFEC~ 8 (12~ 62 8 12.9 "12.~ INFE~ C 0.235 + 8 Xanomeline ~ TIER INFEC~ 5 ( 6~ 73 5 6.85 " 6.~ INFE~ C 0.235 + 9 Placebo TIER GASTR~ 9 (14~ 62 9 14.5 "14.~ GAST~ C 0.0342 + 10 Xanomeline ~ TIER GASTR~ 3 ( 4~ 73 3 4.11 " 4.~ GAST~ C 0.0342 + # i 38 more rows + # i 19 more variables: RISK , RISKCIL , RISKCIU , + # ADJPVALUE , RISK_CI , TRTPAIR , CTRL , ACTIVE , + # TOTAL_N , DPTVARN , DPTVALN , SUBGRPVARX , + # SUBGRPVARXN , `Risk Difference (CI)` , `Risk Difference` , + # `P-value` , `Lower Limit` , `Upper Limit` , + # `(Lower-Upper)` + +--- Code output Output - # A tibble: 58 x 24 - DPTVAL PVALUE ADJPVALUE RISK RISKCIL RISKCIU RISK_CI TRTPAIR TRTVAR FREQ - - 1 INJURY, ~ 0.591 0.591 0.672 0.16 2.9 0.672 ~ Placeb~ Place~ 4 - 2 INJURY, ~ 0.591 0.591 0.672 0.16 2.9 0.672 ~ Placeb~ Xanom~ 3 - 3 MUSCULOS~ 0.452 0.452 1.57 0.48 5.13 1.568 ~ Placeb~ Place~ 4 - 4 MUSCULOS~ 0.452 0.452 1.57 0.48 5.13 1.568 ~ Placeb~ Xanom~ 7 - 5 RENAL AN~ 0.331 0.331 0.448 0.08 2.37 0.448 ~ Placeb~ Place~ 4 - 6 RENAL AN~ 0.331 0.331 0.448 0.08 2.37 0.448 ~ Placeb~ Xanom~ 2 - 7 METABOLI~ 0.0707 0.0707 0.179 0.02 1.5 0.179 ~ Placeb~ Place~ 5 - 8 METABOLI~ 0.0707 0.0707 0.179 0.02 1.5 0.179 ~ Placeb~ Xanom~ 1 - 9 NERVOUS ~ 0.0521 0.0521 2.18 0.96 4.93 2.176 ~ Placeb~ Place~ 7 - 10 NERVOUS ~ 0.0521 0.0521 2.18 0.96 4.93 2.176 ~ Placeb~ Xanom~ 17 - # i 48 more rows - # i 14 more variables: PCT , TOTAL_N , HOVER_PCT , - # HOVER_RISK , HOVER_TEXT , DPTVAR , CN , DPTVARN , - # DPTVALN , SUBGRPVARX , SUBGRPVARXN , - # `Risk Ratio (CI)` , `P-value` , CVALUE + a flextable object. + col_keys: ` `, `Placebo_n (%) `, `Xanomeline Low Dose_n (%) ` + header has 2 row(s) + body has 24 row(s) + original dataset sample: + DPTVARN DPTVALN CN + 1 CARDIAC DISORDERS 1 0 C + 2 \t\t\tSINUS BRADYCARDIA 1 1 C + 3 RESPIRATORY, THORACIC AND MEDIASTINAL DISORDERS 2 0 C + 4 \t\t\tCOUGH 2 1 C + 5 NERVOUS SYSTEM DISORDERS 3 0 C + Placebo_n (%) Xanomeline Low Dose_n (%) + 1 1 ( 1.6%) 4 ( 5.5%) + 2 1 ( 1.6%) 4 ( 5.5%) + 3 1 ( 1.6%) 5 ( 6.8%) + 4 1 ( 1.6%) 5 ( 6.8%) + 5 2 ( 3.2%) 6 ( 8.2%) + +# Test Case 2: adae_summary with summary row + + Code + ae_risk + Output + # A tibble: 48 x 32 + TRTVAR DPTVAR DPTVAL CVALUE DENOMN FREQ PCT CPCT XVAR CN PVALUE RISK + + 1 Place~ TIER CARDI~ 1 ( 1~ 62 1 1.61 " 1.~ CARD~ C 0.466 3.40 + 2 Xanom~ TIER CARDI~ 4 ( 5~ 73 4 5.48 " 5.~ CARD~ C 0.466 3.40 + 3 Place~ TIER GASTR~ 9 (14~ 62 9 14.5 "14.~ GAST~ C 0.0697 0.283 + 4 Xanom~ TIER GASTR~ 3 ( 4~ 73 3 4.11 " 4.~ GAST~ C 0.0697 0.283 + 5 Place~ TIER GENER~ 16 (2~ 62 16 25.8 "25.~ GENE~ C 0.0034 2.02 + 6 Xanom~ TIER GENER~ 38 (5~ 73 38 52.1 "52.~ GENE~ C 0.0034 2.02 + 7 Place~ TIER INFEC~ 8 (12~ 62 8 12.9 "12.~ INFE~ C 0.370 0.531 + 8 Xanom~ TIER INFEC~ 5 ( 6~ 73 5 6.85 " 6.~ INFE~ C 0.370 0.531 + 9 Place~ TIER NERVO~ 2 ( 3~ 62 2 3.23 " 3.~ NERV~ C 0.390 2.55 + 10 Xanom~ TIER NERVO~ 6 ( 8~ 73 6 8.22 " 8.~ NERV~ C 0.390 2.55 + # i 38 more rows + # i 20 more variables: RISKCIL , RISKCIU , ADJPVALUE , + # RISK_CI , TRTPAIR , CTRL , ACTIVE , TOTAL_N , + # DPTVARN , DPTVALN , CTRL_N , CTRL_PCT , + # SUBGRPVARX , SUBGRPVARXN , `Risk Ratio (CI)` , + # `Risk Ratio` , `P-value` , `Lower Limit` , + # `Upper Limit` , `(Lower-Upper)` --- Code - out_table + output Output - # A tibble: 29 x 8 - DPTVAL DPTVARN DPTVALN CN `Placebo_n (%) ` Xanomeline Low Dose_~1 - - 1 "INJURY, POISO~ 1 0 C 4 (5.8%) 3 (3.9%) - 2 "MUSCULOSKELET~ 2 0 C 4 (5.8%) 7 (9.09%) - 3 "RENAL AND URI~ 3 0 C 4 (5.8%) 2 (2.6%) - 4 "METABOLISM AN~ 4 0 C 5 (7.25%) 1 (1.3%) - 5 "NERVOUS SYSTE~ 5 0 C 7 (10.14%) 17 (22.08%) - 6 "\t\t\tDizzine~ 5 1 C 2 (2.9%) 6 (7.79%) - 7 "RESPIRATORY, ~ 6 0 C 7 (10.14%) 9 (11.69%) - 8 "\t\t\tCough" 6 1 C 1 (1.45%) 5 (6.49%) - 9 "INVESTIGATION~ 7 0 C 8 (11.59%) 5 (6.49%) - 10 "CARDIAC DISOR~ 8 0 C 9 (13.04%) 10 (12.99%) - # i 19 more rows - # i abbreviated name: 1: `Xanomeline Low Dose_n (%) ` - # i 2 more variables: `Risk Ratio (CI)` , `P-value` + a flextable object. + col_keys: ` `, `Placebo_n (%) `, `Xanomeline Low Dose_n (%) `, `Risk Ratio (CI)` + header has 2 row(s) + body has 24 row(s) + original dataset sample: + DPTVARN DPTVALN CN Placebo_n (%) + 1 Any AE 0 0 C 42 (67.7%) + 2 CARDIAC DISORDERS 1 0 C 1 ( 1.6%) + 3 \t\t\tSINUS BRADYCARDIA 1 1 C 1 ( 1.6%) + 4 GASTROINTESTINAL DISORDERS 2 0 C 9 (14.5%) + 5 \t\t\tDIARRHOEA 2 1 C 9 (14.5%) + Xanomeline Low Dose_n (%) Risk Ratio (CI) + 1 64 (87.7%) 1.294 (1.07, 1.57) + 2 4 ( 5.5%) 3.397 (0.39, 29.61) + 3 4 ( 5.5%) 3.397 (0.39, 29.61) + 4 3 ( 4.1%) 0.283 (0.08, 1) + 5 3 ( 4.1%) 0.283 (0.08, 1) diff --git a/tests/testthat/_snaps/adsl_summary.md b/tests/testthat/_snaps/adsl_summary.md new file mode 100644 index 0000000..ee34625 --- /dev/null +++ b/tests/testthat/_snaps/adsl_summary.md @@ -0,0 +1,318 @@ +# adsl_summary works as expected + + Code + print(tibble::as_tibble(dataf), n = Inf, width = Inf) + Output + # A tibble: 21 x 9 + BYVAR1 DPTVAR DPTVAL DPTVARN DPTVALN CN + + 1 F Age Group <65 1 1 C + 2 F Age Group 65-80 1 2 C + 3 F Age Group >80 1 3 C + 4 F Age N 2 1 N + 5 F Age Range 2 2 N + 6 F Age Mean (SD) 2 3 N + 7 F Age Median 2 4 N + 8 F Age Interquartile Range 2 5 N + 9 F Race WHITE 3 1 C + 10 F Race BLACK OR AFRICAN AMERICAN 3 2 C + 11 M Age Group <65 1 1 C + 12 M Age Group 65-80 1 2 C + 13 M Age Group >80 1 3 C + 14 M Age N 2 1 N + 15 M Age Range 2 2 N + 16 M Age Mean (SD) 2 3 N + 17 M Age Median 2 4 N + 18 M Age Interquartile Range 2 5 N + 19 M Race WHITE 3 1 C + 20 M Race BLACK OR AFRICAN AMERICAN 3 2 C + 21 M Race AMERICAN INDIAN OR ALASKA NATIVE 3 6 C + `Placebo (N=86)` `Xanomeline Low Dose (N=84)` `Xanomeline High Dose (N=84)` + + 1 9 (10.47%) 5 ( 5.95%) 5 ( 5.95%) + 2 22 (25.58%) 28 (33.33%) 28 (33.33%) + 3 22 (25.58%) 17 (20.24%) 7 ( 8.33%) + 4 53 50 40 + 5 (59.00,89.00) (54.00,87.00) (56.00,88.00) + 6 76.36 (8.73) 75.68 (8.09) 74.67 (7.67) + 7 78.00 77.50 76.00 + 8 (70.00, 84.00) (72.00, 81.00) (72.00, 79.00) + 9 48 (55.81%) 44 (52.38%) 34 (40.48%) + 10 5 ( 5.81%) 6 ( 7.14%) 6 ( 7.14%) + 11 5 ( 5.81%) 3 ( 3.57%) 6 ( 7.14%) + 12 20 (23.26%) 19 (22.62%) 27 (32.14%) + 13 8 ( 9.30%) 12 (14.29%) 11 (13.10%) + 14 33 34 44 + 15 (52.00,85.00) (51.00,88.00) (56.00,86.00) + 16 73.36 (8.15) 75.65 (8.69) 74.11 (8.16) + 17 74.00 77.50 77.00 + 18 (69.00, 80.00) (68.00, 82.00) (69.00, 80.50) + 19 30 (34.88%) 34 (40.48%) 40 (47.62%) + 20 3 ( 3.49%) 0 3 ( 3.57%) + 21 0 0 1 ( 1.19%) + +--- + + Code + print(tibble::as_tibble(dataf_), n = Inf, width = Inf) + Output + # A tibble: 74 x 9 + BYVAR1 DPTVAR DPTVAL DPTVARN DPTVALN CN + + 1 F Age Group <65 1 1 C + 2 F Age Group 65-80 1 2 C + 3 F Age Group >80 1 3 C + 4 F Age 54 2 3 C + 5 F Age 56 2 4 C + 6 F Age 57 2 5 C + 7 F Age 59 2 6 C + 8 F Age 60 2 7 C + 9 F Age 61 2 8 C + 10 F Age 62 2 9 C + 11 F Age 63 2 10 C + 12 F Age 64 2 11 C + 13 F Age 66 2 13 C + 14 F Age 67 2 14 C + 15 F Age 68 2 15 C + 16 F Age 69 2 16 C + 17 F Age 70 2 17 C + 18 F Age 71 2 18 C + 19 F Age 72 2 19 C + 20 F Age 73 2 20 C + 21 F Age 74 2 21 C + 22 F Age 75 2 22 C + 23 F Age 76 2 23 C + 24 F Age 77 2 24 C + 25 F Age 78 2 25 C + 26 F Age 79 2 26 C + 27 F Age 80 2 27 C + 28 F Age 81 2 28 C + 29 F Age 82 2 29 C + 30 F Age 83 2 30 C + 31 F Age 84 2 31 C + 32 F Age 85 2 32 C + 33 F Age 86 2 33 C + 34 F Age 87 2 34 C + 35 F Age 88 2 35 C + 36 F Age 89 2 36 C + 37 F Race WHITE 3 1 C + 38 F Race BLACK OR AFRICAN AMERICAN 3 2 C + 39 M Age Group <65 1 1 C + 40 M Age Group 65-80 1 2 C + 41 M Age Group >80 1 3 C + 42 M Age 51 2 1 C + 43 M Age 52 2 2 C + 44 M Age 56 2 4 C + 45 M Age 57 2 5 C + 46 M Age 61 2 8 C + 47 M Age 62 2 9 C + 48 M Age 63 2 10 C + 49 M Age 64 2 11 C + 50 M Age 65 2 12 C + 51 M Age 67 2 14 C + 52 M Age 68 2 15 C + 53 M Age 69 2 16 C + 54 M Age 70 2 17 C + 55 M Age 71 2 18 C + 56 M Age 72 2 19 C + 57 M Age 73 2 20 C + 58 M Age 74 2 21 C + 59 M Age 75 2 22 C + 60 M Age 77 2 24 C + 61 M Age 78 2 25 C + 62 M Age 79 2 26 C + 63 M Age 80 2 27 C + 64 M Age 81 2 28 C + 65 M Age 82 2 29 C + 66 M Age 83 2 30 C + 67 M Age 84 2 31 C + 68 M Age 85 2 32 C + 69 M Age 86 2 33 C + 70 M Age 87 2 34 C + 71 M Age 88 2 35 C + 72 M Race WHITE 3 1 C + 73 M Race BLACK OR AFRICAN AMERICAN 3 2 C + 74 M Race AMERICAN INDIAN OR ALASKA NATIVE 3 6 C + `Placebo (N=86)` `Xanomeline Low Dose (N=84)` `Xanomeline High Dose (N=84)` + + 1 9 (10.47%) 5 ( 5.95%) 5 ( 5.95%) + 2 22 (25.58%) 28 (33.33%) 28 (33.33%) + 3 22 (25.58%) 17 (20.24%) 7 ( 8.33%) + 4 0 1 (1.19%) 0 + 5 0 2 (2.38%) 2 (2.38%) + 6 0 1 (1.19%) 0 + 7 2 (2.33%) 0 0 + 8 1 (1.16%) 1 (1.19%) 1 (1.19%) + 9 0 0 1 (1.19%) + 10 1 (1.16%) 0 0 + 11 2 (2.33%) 0 1 (1.19%) + 12 3 (3.49%) 0 0 + 13 1 (1.16%) 0 0 + 14 1 (1.16%) 1 (1.19%) 2 (2.38%) + 15 1 (1.16%) 2 (2.38%) 0 + 16 1 (1.16%) 0 1 (1.19%) + 17 1 (1.16%) 0 0 + 18 1 (1.16%) 3 (3.57%) 1 (1.19%) + 19 1 (1.16%) 3 (3.57%) 3 (3.57%) + 20 2 (2.33%) 1 (1.19%) 2 (2.38%) + 21 2 (2.33%) 3 (3.57%) 2 (2.38%) + 22 0 2 (2.38%) 2 (2.38%) + 23 4 (4.65%) 4 (4.76%) 4 (4.76%) + 24 1 (1.16%) 1 (1.19%) 3 (3.57%) + 25 3 (3.49%) 2 (2.38%) 3 (3.57%) + 26 1 (1.16%) 3 (3.57%) 3 (3.57%) + 27 2 (2.33%) 3 (3.57%) 2 (2.38%) + 28 6 (6.98%) 6 (7.14%) 1 (1.19%) + 29 0 1 (1.19%) 0 + 30 2 (2.33%) 3 (3.57%) 1 (1.19%) + 31 3 (3.49%) 5 (5.95%) 2 (2.38%) + 32 2 (2.33%) 0 1 (1.19%) + 33 3 (3.49%) 1 (1.19%) 1 (1.19%) + 34 3 (3.49%) 1 (1.19%) 0 + 35 2 (2.33%) 0 1 (1.19%) + 36 1 (1.16%) 0 0 + 37 48 (55.81%) 44 (52.38%) 34 (40.48%) + 38 5 ( 5.81%) 6 ( 7.14%) 6 ( 7.14%) + 39 5 ( 5.81%) 3 ( 3.57%) 6 ( 7.14%) + 40 20 (23.26%) 19 (22.62%) 27 (32.14%) + 41 8 ( 9.30%) 12 (14.29%) 11 (13.10%) + 42 0 1 (1.19%) 0 + 43 1 (1.16%) 0 0 + 44 0 0 2 (2.38%) + 45 1 (1.16%) 0 1 (1.19%) + 46 1 (1.16%) 1 (1.19%) 2 (2.38%) + 47 0 1 (1.19%) 0 + 48 0 0 1 (1.19%) + 49 2 (2.33%) 0 0 + 50 1 (1.16%) 1 (1.19%) 2 (2.38%) + 51 1 (1.16%) 1 (1.19%) 2 (2.38%) + 52 0 4 (4.76%) 0 + 53 2 (2.33%) 1 (1.19%) 2 (2.38%) + 54 3 (3.49%) 0 1 (1.19%) + 55 1 (1.16%) 2 (2.38%) 1 (1.19%) + 56 1 (1.16%) 0 1 (1.19%) + 57 1 (1.16%) 0 3 (3.57%) + 58 3 (3.49%) 1 (1.19%) 2 (2.38%) + 59 2 (2.33%) 1 (1.19%) 1 (1.19%) + 60 1 (1.16%) 3 (3.57%) 5 (5.95%) + 61 2 (2.33%) 2 (2.38%) 1 (1.19%) + 62 1 (1.16%) 2 (2.38%) 4 (4.76%) + 63 1 (1.16%) 1 (1.19%) 2 (2.38%) + 64 2 (2.33%) 1 (1.19%) 3 (3.57%) + 65 2 (2.33%) 3 (3.57%) 4 (4.76%) + 66 1 (1.16%) 1 (1.19%) 0 + 67 1 (1.16%) 3 (3.57%) 2 (2.38%) + 68 2 (2.33%) 1 (1.19%) 0 + 69 0 0 2 (2.38%) + 70 0 2 (2.38%) 0 + 71 0 1 (1.19%) 0 + 72 30 (34.88%) 34 (40.48%) 40 (47.62%) + 73 3 ( 3.49%) 0 3 ( 3.57%) + 74 0 0 1 ( 1.19%) + +# adsl_summary works with subsets + + Code + print(actual, n = Inf, width = Inf) + Output + # A tibble: 19 x 9 + BYVAR1 DPTVAR DPTVAL DPTVARN DPTVALN CN + + 1 F Age Group <65 1 1 C + 2 F Age N 2 1 N + 3 F Age Range 2 2 N + 4 F Age Meansd 2 3 N + 5 F Age Median 2 4 N + 6 F Age IQR 2 5 N + 7 F Sex F 3 1 C + 8 F Race WHITE 4 1 C + 9 F Race BLACK OR AFRICAN AMERICAN 4 2 C + 10 M Age Group <65 1 1 C + 11 M Age N 2 1 N + 12 M Age Range 2 2 N + 13 M Age Meansd 2 3 N + 14 M Age Median 2 4 N + 15 M Age IQR 2 5 N + 16 M Sex M 3 2 C + 17 M Race WHITE 4 1 C + 18 M Race BLACK OR AFRICAN AMERICAN 4 2 C + 19 M Race AMERICAN INDIAN OR ALASKA NATIVE 4 6 C + `Placebo (N=86)` `Xanomeline Low Dose (N=84)` `Xanomeline High Dose (N=84)` + + 1 9 (10.47%) 5 ( 5.95%) 5 ( 5.95%) + 2 22 17 7 + 3 (81.00,89.00) (81.00,87.00) (81.00,88.00) + 4 84.45 (2.67) 82.94 (1.85) 84.43 (2.23) + 5 84.50 83.00 84.00 + 6 (81.00, 87.00) (81.00, 84.00) (83.00, 86.00) + 7 53 (61.63%) 50 (59.52%) 40 (47.62%) + 8 48 (55.81%) 44 (52.38%) 34 (40.48%) + 9 5 ( 5.81%) 6 ( 7.14%) 6 ( 7.14%) + 10 5 ( 5.81%) 3 ( 3.57%) 6 ( 7.14%) + 11 8 12 11 + 12 (81.00,85.00) (81.00,88.00) (81.00,86.00) + 13 82.88 (1.64) 84.08 (2.27) 82.82 (1.89) + 14 82.50 84.00 82.00 + 15 (81.50, 84.50) (82.00, 86.00) (81.00, 84.00) + 16 33 (38.37%) 34 (40.48%) 44 (52.38%) + 17 30 (34.88%) 34 (40.48%) 40 (47.62%) + 18 3 ( 3.49%) 0 3 ( 3.57%) + 19 0 0 1 ( 1.19%) + +--- + + Code + print(tibble::as_tibble(actual_), n = Inf, width = Inf) + Output + # A tibble: 23 x 9 + BYVAR1 DPTVAR DPTVAL DPTVARN DPTVALN CN + + 1 F Age Group <65 1 1 C + 2 F Age Group 65-80 1 2 C + 3 F Age Group >80 1 3 C + 4 F Age N 2 1 N + 5 F Age Range 2 2 N + 6 F Age Meansd 2 3 N + 7 F Age Median 2 4 N + 8 F Age IQR 2 5 N + 9 F Sex F 3 1 C + 10 F Race WHITE 4 1 C + 11 F Race BLACK OR AFRICAN AMERICAN 4 2 C + 12 M Age Group <65 1 1 C + 13 M Age Group 65-80 1 2 C + 14 M Age Group >80 1 3 C + 15 M Age N 2 1 N + 16 M Age Range 2 2 N + 17 M Age Meansd 2 3 N + 18 M Age Median 2 4 N + 19 M Age IQR 2 5 N + 20 M Sex M 3 2 C + 21 M Race WHITE 4 1 C + 22 M Race BLACK OR AFRICAN AMERICAN 4 2 C + 23 M Race AMERICAN INDIAN OR ALASKA NATIVE 4 6 C + `Placebo (N=86)` `Xanomeline Low Dose (N=84)` `Xanomeline High Dose (N=84)` + + 1 9 (11.54%) 5 ( 6.41%) 5 ( 6.76%) + 2 22 (28.21%) 28 (35.90%) 28 (37.84%) + 3 22 (28.21%) 17 (21.79%) 7 ( 9.46%) + 4 53 50 40 + 5 (59.00,89.00) (54.00,87.00) (56.00,88.00) + 6 76.36 (8.73) 75.68 (8.09) 74.67 (7.67) + 7 78.00 77.50 76.00 + 8 (70.00, 84.00) (72.00, 81.00) (72.00, 79.00) + 9 53 (61.63%) 50 (59.52%) 40 (47.62%) + 10 48 (55.81%) 44 (52.38%) 34 (40.48%) + 11 5 ( 5.81%) 6 ( 7.14%) 6 ( 7.14%) + 12 5 ( 6.41%) 3 ( 3.85%) 6 ( 8.11%) + 13 20 (25.64%) 19 (24.36%) 27 (36.49%) + 14 8 (10.26%) 12 (15.38%) 11 (14.86%) + 15 33 34 44 + 16 (52.00,85.00) (51.00,88.00) (56.00,86.00) + 17 73.36 (8.15) 75.65 (8.69) 74.11 (8.16) + 18 74.00 77.50 77.00 + 19 (69.00, 80.00) (68.00, 82.00) (69.00, 80.50) + 20 33 (38.37%) 34 (40.48%) 44 (52.38%) + 21 30 (34.88%) 34 (40.48%) 40 (47.62%) + 22 3 ( 3.49%) 0 3 ( 3.57%) + 23 0 0 1 ( 1.19%) + diff --git a/tests/testthat/_snaps/ae_forestplot.md b/tests/testthat/_snaps/ae_forestplot.md new file mode 100644 index 0000000..a8b313a --- /dev/null +++ b/tests/testthat/_snaps/ae_forestplot.md @@ -0,0 +1,90 @@ +# Test Case 2: Standard Inputs 1 + + Code + x[["geom_params"]][-1] + Output + $xmin + [1] 0 + + $xmax + [1] 1 + + $ymin + [1] 0.15 + + $ymax + [1] 1 + + $scale + [1] 1 + + $clip + [1] "inherit" + + $halign + [1] 0.5 + + $valign + [1] 0.5 + + +--- + + Code + x[["geom_params"]][-1] + Output + $xmin + [1] 0 + + $xmax + [1] 1 + + $ymin + [1] 0.075 + + $ymax + [1] 0.15 + + $scale + [1] 1 + + $clip + [1] "inherit" + + $halign + [1] 0.5 + + $valign + [1] 0.5 + + +--- + + Code + x[["geom_params"]][-1] + Output + $xmin + [1] 0 + + $xmax + [1] 1 + + $ymin + [1] 0 + + $ymax + [1] 0.075 + + $scale + [1] 1 + + $clip + [1] "inherit" + + $halign + [1] 0.5 + + $valign + [1] 0.5 + + diff --git a/tests/testthat/_snaps/ae_volcano_plot.md b/tests/testthat/_snaps/ae_volcano_plot.md new file mode 100644 index 0000000..fd78b35 --- /dev/null +++ b/tests/testthat/_snaps/ae_volcano_plot.md @@ -0,0 +1,90 @@ +# Test 1: Volcano plot with standard inputs + + Code + volcano_test[["mapping"]] + Output + Aesthetic mapping: + * `x` -> `.data[["RISK"]]` + * `y` -> `.data[["PVALUE"]]` + * `text` -> `.data[["HOVER_TEXT"]]` + * `fill` -> `.data[["BYVAR1"]]` + * `key` -> `.data[["key"]]` + +--- + + Code + volcano_test[["labels"]] + Output + $x + [1] "RISK" + + $y + [1] "PVALUE" + + $text + [1] "HOVER_TEXT" + + $fill + [1] "BYVAR1" + + $key + [1] "key" + + $size + [1] "CTRL_N" + + $yintercept + [1] "yintercept" + + $xintercept + [1] "xintercept" + + +--- + + Code + x$aes_params + Output + $shape + [1] 21 + + $alpha + [1] 0.5 + + +--- + + Code + x$aes_params + Output + $colour + [1] "grey30" + + $linetype + [1] "dashed" + + +--- + + Code + x$aes_params + Output + $colour + [1] "grey30" + + $linetype + [1] "dashed" + + +--- + + Code + x$aes_params + Output + $colour + [1] "grey30" + + $linetype + [1] "dotted" + + diff --git a/tests/testthat/_snaps/bar_plot.md b/tests/testthat/_snaps/bar_plot.md new file mode 100644 index 0000000..6ac714e --- /dev/null +++ b/tests/testthat/_snaps/bar_plot.md @@ -0,0 +1,32 @@ +# Test Case 1: bar_plot works with expected inputs + + Code + bar_out[[x]] + Output + Aesthetic mapping: + * `x` -> `.data[["XVAR"]]` + * `y` -> `.data[["YVAR"]]` + * `fill` -> `.data[["TRTVAR"]]` + * `group` -> `.data[["TRTVAR"]]` + +--- + + Code + bar_out[[x]] + Output + $x + [1] "" + + $y + [1] "" + + $title + NULL + + $fill + [1] "TRTVAR" + + $group + [1] "TRTVAR" + + diff --git a/tests/testthat/_snaps/box_plot.md b/tests/testthat/_snaps/box_plot.md new file mode 100644 index 0000000..3b3f513 --- /dev/null +++ b/tests/testthat/_snaps/box_plot.md @@ -0,0 +1,168 @@ +# Standard box plot outputs + + Code + p[[x]] + Output + Aesthetic mapping: + * `colour` -> `.data[["TRTVAR"]]` + * `x` -> `.data[["XVAR"]]` + * `ymin` -> `.data[["whiskerlow"]]` + * `ymax` -> `.data[["whiskerup"]]` + * `lower` -> `.data[["q25"]]` + * `upper` -> `.data[["q75"]]` + * `middle` -> `.data[["median"]]` + +--- + + Code + p[[x]] + Output + $x + [1] "Race" + + $y + [1] "Age" + + $title + NULL + + $colour + [1] "TRTVAR" + + $ymin + [1] "whiskerlow" + + $ymax + [1] "whiskerup" + + $lower + [1] "q25" + + $upper + [1] "q75" + + $middle + [1] "median" + + $group + [1] "TRTVAR" + + $shape + [1] "TRTVAR" + + $size + [1] "TRTVAR" + + +--- + + Code + p[[x]] + Output + Aesthetic mapping: + * `fill` -> `.data[["TRTVAR"]]` + * `x` -> `.data[["XVAR"]]` + * `ymin` -> `.data[["whiskerlow"]]` + * `ymax` -> `.data[["whiskerup"]]` + * `lower` -> `.data[["q25"]]` + * `upper` -> `.data[["q75"]]` + * `middle` -> `.data[["median"]]` + +--- + + Code + p[[x]] + Output + $x + [1] "Race" + + $y + [1] "Age" + + $title + NULL + + $fill + [1] "TRTVAR" + + $ymin + [1] "whiskerlow" + + $ymax + [1] "whiskerup" + + $lower + [1] "q25" + + $upper + [1] "q75" + + $middle + [1] "median" + + $group + [1] "TRTVAR" + + $shape + [1] "TRTVAR" + + $size + [1] "TRTVAR" + + +--- + + Code + p[[x]] + Output + Aesthetic mapping: + * `fill` -> `.data[["TRTVAR"]]` + * `x` -> `.data[["XVAR"]]` + * `ymin` -> `.data[["min"]]` + * `ymax` -> `.data[["max"]]` + * `lower` -> `.data[["q25"]]` + * `upper` -> `.data[["q75"]]` + * `middle` -> `.data[["median"]]` + +--- + + Code + p[[x]] + Output + $x + [1] "Race" + + $y + [1] "Age" + + $title + NULL + + $fill + [1] "TRTVAR" + + $ymin + [1] "min" + + $ymax + [1] "max" + + $lower + [1] "q25" + + $upper + [1] "q75" + + $middle + [1] "median" + + $group + [1] "TRTVAR" + + $shape + [1] "TRTVAR" + + $size + [1] "TRTVAR" + + diff --git a/tests/testthat/_snaps/edish_plot.md b/tests/testthat/_snaps/edish_plot.md new file mode 100644 index 0000000..6a064b2 --- /dev/null +++ b/tests/testthat/_snaps/edish_plot.md @@ -0,0 +1,13 @@ +# snapshot comparison + + Code + e_plot[[x]] + Output + Aesthetic mapping: + * `text` -> `.data[["text"]]` + * `x` -> `.data[["XVAR"]]` + * `y` -> `.data[["YVAR"]]` + * `shape` -> `.data[["TRTVAR"]]` + * `colour` -> `.data[["TRTVAR"]]` + * `size` -> `.data[["TRTVAR"]]` + diff --git a/tests/testthat/_snaps/event_analysis.md b/tests/testthat/_snaps/event_analysis.md new file mode 100644 index 0000000..174f5f3 --- /dev/null +++ b/tests/testthat/_snaps/event_analysis.md @@ -0,0 +1,378 @@ +# Test Case 1: process_event_analysis works with expected inputs + + Code + print(tibble::as_tibble(x), n = Inf, width = Inf) + Output + # A tibble: 9 x 20 + BYVAR1 TRTVAR DPTVAR + + 1 Abdominal Pain/Narrow "Placebo" AEDECOD + 2 Abdominal Pain/Narrow~~Dyspepsia/Broad "Placebo" AEDECOD + 3 Abdominal Pain/Narrow "Placebo" AEDECOD + 4 Abdominal Pain/Narrow "Xanomeline Low\nDose" AEDECOD + 5 Abdominal Pain/Narrow~~Dyspepsia/Broad "Xanomeline Low\nDose" AEDECOD + 6 Abdominal Pain/Narrow "Xanomeline Low\nDose" AEDECOD + 7 Abdominal Pain/Narrow "Xanomeline High\nDose" AEDECOD + 8 Abdominal Pain/Narrow "Xanomeline High\nDose" AEDECOD + 9 Abdominal Pain/Narrow~~Dyspepsia/Broad "Xanomeline High\nDose" AEDECOD + DPTVAL CVALUE DENOMN FREQ DPTVALN BYVAR1N PCT CPCT + + 1 ABDOMINAL PAIN 1 ( 0.70%) 142 1 2 1 0.704 " 0.70" + 2 ABDOMINAL DISCOMFORT 0 142 0 1 2 0 " 0.00" + 3 STOMACH DISCOMFORT 0 142 0 130 1 0 " 0.00" + 4 ABDOMINAL PAIN 3 ( 1.45%) 207 3 2 1 1.45 " 1.45" + 5 ABDOMINAL DISCOMFORT 0 207 0 1 2 0 " 0.00" + 6 STOMACH DISCOMFORT 0 207 0 130 1 0 " 0.00" + 7 ABDOMINAL PAIN 1 ( 0.45%) 222 1 2 1 0.450 " 0.45" + 8 STOMACH DISCOMFORT 1 ( 0.45%) 222 1 130 1 0.450 " 0.45" + 9 ABDOMINAL DISCOMFORT 1 ( 0.45%) 222 1 1 2 0.450 " 0.45" + XVAR DPTVARN CN HTERM HVAL LVAL + + 1 ABDOMINAL PAIN 1 C FMQ_NAM ABDOMINAL PAIN ABDOMINAL DISCOMFORT + 2 ABDOMINAL DISCOMFORT 1 C FMQ_NAM ABDOMINAL PAIN ABDOMINAL DISCOMFORT + 3 STOMACH DISCOMFORT 1 C FMQ_NAM ABDOMINAL PAIN ABDOMINAL DISCOMFORT + 4 ABDOMINAL PAIN 1 C FMQ_NAM ABDOMINAL PAIN ABDOMINAL DISCOMFORT + 5 ABDOMINAL DISCOMFORT 1 C FMQ_NAM ABDOMINAL PAIN ABDOMINAL DISCOMFORT + 6 STOMACH DISCOMFORT 1 C FMQ_NAM ABDOMINAL PAIN ABDOMINAL DISCOMFORT + 7 ABDOMINAL PAIN 1 C FMQ_NAM ABDOMINAL PAIN ABDOMINAL DISCOMFORT + 8 STOMACH DISCOMFORT 1 C FMQ_NAM ABDOMINAL PAIN ABDOMINAL DISCOMFORT + 9 ABDOMINAL DISCOMFORT 1 C FMQ_NAM ABDOMINAL PAIN ABDOMINAL DISCOMFORT + Percent PCT_N DECODh + + 1 " 0.70 % \n Low Term: ABDOMINAL PAIN" 0.704 3 + 2 " 0.00 % \n Low Term: ABDOMINAL DISCOMFORT" 0 9999 + 3 " 0.00 % \n Low Term: STOMACH DISCOMFORT" 0 1.5 + 4 " 1.45 % \n Low Term: ABDOMINAL PAIN" 1.45 3 + 5 " 0.00 % \n Low Term: ABDOMINAL DISCOMFORT" 0 9999 + 6 " 0.00 % \n Low Term: STOMACH DISCOMFORT" 0 1.5 + 7 " 0.45 % \n Low Term: ABDOMINAL PAIN" 0.450 2 + 8 " 0.45 % \n Low Term: STOMACH DISCOMFORT" 0.450 2 + 9 " 0.45 % \n Low Term: ABDOMINAL DISCOMFORT" 0.450 9999 + +--- + + Code + print(tibble::as_tibble(x), n = Inf, width = Inf) + Output + # A tibble: 3 x 16 + BYVAR1 TRTVAR DPTVAR + + 1 Abdominal Pain/Narrow~~Dyspepsia/Broad "Placebo" AEDECOD + 2 Abdominal Pain/Narrow~~Dyspepsia/Broad "Xanomeline Low\nDose" AEDECOD + 3 Abdominal Pain/Narrow~~Dyspepsia/Broad "Xanomeline High\nDose" AEDECOD + DPTVAL CVALUE DENOMN FREQ DPTVALN BYVAR1N PCT CPCT + + 1 ABDOMINAL DISCOMFORT 0 142 0 1 2 0 " 0.00" + 2 ABDOMINAL DISCOMFORT 0 207 0 1 2 0 " 0.00" + 3 ABDOMINAL DISCOMFORT 1 ( 0.45%) 222 1 1 2 0.450 " 0.45" + XVAR DPTVARN CN PCT_N Percent + + 1 ABDOMINAL DISCOMFORT 1 C 0 " 0.00 %" + 2 ABDOMINAL DISCOMFORT 1 C 0 " 0.00 %" + 3 ABDOMINAL DISCOMFORT 1 C 0.450 " 0.45 %" + +# Test Case 2: event_analysis_plot works with expected inputs + + Code + plot$x$data + Output + [[1]] + [[1]]$orientation + [1] "v" + + [[1]]$width + [1] 0.4 0.4 0.4 + attr(,"class") + [1] "mapped_discrete" "numeric" + attr(,"apiSrc") + [1] TRUE + + [[1]]$base + [1] 0 0 0 + attr(,"apiSrc") + [1] TRUE + + [[1]]$x + [1] 1 2 3 + attr(,"class") + [1] "mapped_discrete" "numeric" + attr(,"apiSrc") + [1] TRUE + + [[1]]$y + [1] 0.0000000 0.0000000 0.4504505 + attr(,"apiSrc") + [1] TRUE + + [[1]]$text + [1] " 0.00 %" " 0.00 %" " 0.45 %" + attr(,"apiSrc") + [1] TRUE + + [[1]]$type + [1] "bar" + + [[1]]$textposition + [1] "none" + + [[1]]$marker + [[1]]$marker$autocolorscale + [1] FALSE + + [[1]]$marker$color + [1] "rgba(58,95,205,1)" + + [[1]]$marker$line + [[1]]$marker$line$width + [1] 1.511811 + + [[1]]$marker$line$color + [1] "rgba(96,96,96,1)" + + + + [[1]]$showlegend + [1] FALSE + + [[1]]$xaxis + [1] "x" + + [[1]]$yaxis + [1] "y" + + [[1]]$hoverinfo + [1] "text" + + [[1]]$name + [1] "" + + + [[2]] + [[2]]$orientation + [1] "v" + + [[2]]$width + [1] 0.4 0.4 0.4 + attr(,"class") + [1] "mapped_discrete" "numeric" + attr(,"apiSrc") + [1] TRUE + + [[2]]$base + [1] 0 0 0 + attr(,"apiSrc") + [1] TRUE + + [[2]]$x + [1] 1 2 3 + attr(,"class") + [1] "mapped_discrete" "numeric" + attr(,"apiSrc") + [1] TRUE + + [[2]]$y + [1] 0.0000000 0.0000000 0.4504505 + attr(,"apiSrc") + [1] TRUE + + [[2]]$text + [1] " 0.00 %
Low Term: ABDOMINAL DISCOMFORT" + [2] " 0.00 %
Low Term: ABDOMINAL DISCOMFORT" + [3] " 0.45 %
Low Term: ABDOMINAL DISCOMFORT" + attr(,"apiSrc") + [1] TRUE + + [[2]]$type + [1] "bar" + + [[2]]$textposition + [1] "none" + + [[2]]$marker + [[2]]$marker$autocolorscale + [1] FALSE + + [[2]]$marker$color + [1] "rgba(58,95,205,1)" + + [[2]]$marker$line + [[2]]$marker$line$width + [1] 1.511811 + + [[2]]$marker$line$color + [1] "rgba(96,96,96,1)" + + + + [[2]]$name + [1] "ABDOMINAL DISCOMFORT" + + [[2]]$legendgroup + [1] "ABDOMINAL DISCOMFORT" + + [[2]]$showlegend + [1] TRUE + + [[2]]$xaxis + [1] "x2" + + [[2]]$yaxis + [1] "y2" + + [[2]]$hoverinfo + [1] "text" + + + [[3]] + [[3]]$orientation + [1] "v" + + [[3]]$width + [1] 0.4 0.4 0.4 + attr(,"class") + [1] "mapped_discrete" "numeric" + attr(,"apiSrc") + [1] TRUE + + [[3]]$base + [1] 0.0000000 0.0000000 0.4504505 + attr(,"apiSrc") + [1] TRUE + + [[3]]$x + [1] 1 2 3 + attr(,"class") + [1] "mapped_discrete" "numeric" + attr(,"apiSrc") + [1] TRUE + + [[3]]$y + [1] 0.7042254 1.4492754 0.4504505 + attr(,"apiSrc") + [1] TRUE + + [[3]]$text + [1] " 0.70 %
Low Term: ABDOMINAL PAIN" + [2] " 1.45 %
Low Term: ABDOMINAL PAIN" + [3] " 0.45 %
Low Term: ABDOMINAL PAIN" + attr(,"apiSrc") + [1] TRUE + + [[3]]$type + [1] "bar" + + [[3]]$textposition + [1] "none" + + [[3]]$marker + [[3]]$marker$autocolorscale + [1] FALSE + + [[3]]$marker$color + [1] "rgba(248,118,109,1)" + + [[3]]$marker$line + [[3]]$marker$line$width + [1] 1.511811 + + [[3]]$marker$line$color + [1] "rgba(96,96,96,1)" + + + + [[3]]$name + [1] "ABDOMINAL PAIN" + + [[3]]$legendgroup + [1] "ABDOMINAL PAIN" + + [[3]]$showlegend + [1] TRUE + + [[3]]$xaxis + [1] "x2" + + [[3]]$yaxis + [1] "y2" + + [[3]]$hoverinfo + [1] "text" + + + [[4]] + [[4]]$orientation + [1] "v" + + [[4]]$width + [1] 0.4 0.4 0.4 + attr(,"class") + [1] "mapped_discrete" "numeric" + attr(,"apiSrc") + [1] TRUE + + [[4]]$base + [1] 0.7042254 1.4492754 0.9009009 + attr(,"apiSrc") + [1] TRUE + + [[4]]$x + [1] 1 2 3 + attr(,"class") + [1] "mapped_discrete" "numeric" + attr(,"apiSrc") + [1] TRUE + + [[4]]$y + [1] 0.0000000 0.0000000 0.4504505 + attr(,"apiSrc") + [1] TRUE + + [[4]]$text + [1] " 0.00 %
Low Term: STOMACH DISCOMFORT" + [2] " 0.00 %
Low Term: STOMACH DISCOMFORT" + [3] " 0.45 %
Low Term: STOMACH DISCOMFORT" + attr(,"apiSrc") + [1] TRUE + + [[4]]$type + [1] "bar" + + [[4]]$textposition + [1] "none" + + [[4]]$marker + [[4]]$marker$autocolorscale + [1] FALSE + + [[4]]$marker$color + [1] "rgba(0,191,196,1)" + + [[4]]$marker$line + [[4]]$marker$line$width + [1] 1.511811 + + [[4]]$marker$line$color + [1] "rgba(96,96,96,1)" + + + + [[4]]$name + [1] "STOMACH DISCOMFORT" + + [[4]]$legendgroup + [1] "STOMACH DISCOMFORT" + + [[4]]$showlegend + [1] TRUE + + [[4]]$xaxis + [1] "x2" + + [[4]]$yaxis + [1] "y2" + + [[4]]$hoverinfo + [1] "text" + + + diff --git a/tests/testthat/_snaps/forest_plot.md b/tests/testthat/_snaps/forest_plot.md new file mode 100644 index 0000000..b47f113 --- /dev/null +++ b/tests/testthat/_snaps/forest_plot.md @@ -0,0 +1,1331 @@ +# Test case 1: Forest Plot Base Works with standard inputs + + Code + fp[[x]] + Output + Aesthetic mapping: + * `x` -> `.data[["RISK"]]` + * `y` -> `.data[["DPTVAL"]]` + * `xmin` -> `.data[["RISKCIL"]]` + * `xmax` -> `.data[["RISKCIU"]]` + * `text` -> `.data[["HOVER_RISK"]]` + * `group` -> `.data[["TRTPAIR"]]` + * `colour` -> `.data[["TRTPAIR"]]` + * `key` -> `.data[["key"]]` + +--- + + Code + fp[[x]] + Output + [[1]] + geom_errorbarh: na.rm = FALSE, width = 0.1 + stat_identity: na.rm = FALSE + position_dodgev + + [[2]] + geom_point: na.rm = FALSE + stat_identity: na.rm = FALSE + position_dodgev + + [[3]] + mapping: xintercept = ~xintercept + geom_vline: na.rm = FALSE + stat_identity: na.rm = FALSE + position_identity + + [[4]] + mapping: yintercept = ~yintercept + geom_hline: na.rm = FALSE + stat_identity: na.rm = FALSE + position_identity + + +--- + + Code + fp[[x]] + Output + $axis.title.x + List of 11 + $ family : NULL + $ face : NULL + $ colour : NULL + $ size : num 8 + $ hjust : NULL + $ vjust : NULL + $ angle : NULL + $ lineheight : NULL + $ margin : NULL + $ debug : NULL + $ inherit.blank: logi FALSE + - attr(*, "class")= chr [1:2] "element_text" "element" + + $axis.title.y + list() + - attr(*, "class")= chr [1:2] "element_blank" "element" + + $axis.text.x + List of 11 + $ family : NULL + $ face : NULL + $ colour : NULL + $ size : num 8 + $ hjust : NULL + $ vjust : NULL + $ angle : NULL + $ lineheight : NULL + $ margin : NULL + $ debug : NULL + $ inherit.blank: logi FALSE + - attr(*, "class")= chr [1:2] "element_text" "element" + + $axis.text.y + list() + - attr(*, "class")= chr [1:2] "element_blank" "element" + + $axis.ticks + list() + - attr(*, "class")= chr [1:2] "element_blank" "element" + + $axis.line + List of 6 + $ colour : chr "black" + $ linewidth : NULL + $ linetype : NULL + $ lineend : NULL + $ arrow : logi FALSE + $ inherit.blank: logi FALSE + - attr(*, "class")= chr [1:2] "element_line" "element" + + $legend.position + [1] "bottom" + + $legend.direction + [1] "horizontal" + + $panel.background + list() + - attr(*, "class")= chr [1:2] "element_blank" "element" + + $panel.border + List of 5 + $ fill : logi NA + $ colour : chr "black" + $ linewidth : num 1 + $ linetype : NULL + $ inherit.blank: logi FALSE + - attr(*, "class")= chr [1:2] "element_rect" "element" + + $panel.grid.major + list() + - attr(*, "class")= chr [1:2] "element_blank" "element" + + $panel.grid.minor + list() + - attr(*, "class")= chr [1:2] "element_blank" "element" + + $plot.title + List of 11 + $ family : NULL + $ face : NULL + $ colour : NULL + $ size : num 10 + $ hjust : num 0.1 + $ vjust : NULL + $ angle : NULL + $ lineheight : NULL + $ margin : NULL + $ debug : NULL + $ inherit.blank: logi FALSE + - attr(*, "class")= chr [1:2] "element_text" "element" + + $plot.margin + [1] 0cm 0cm 0cm 0cm + + attr(,"complete") + [1] FALSE + attr(,"validate") + [1] TRUE + +# Test case 1: Forest Plot Scatter Works with standard inputs + + Code + sp[[x]] + Output + Aesthetic mapping: + * `x` -> `.data[["PCT"]]` + * `y` -> `.data[["DPTVAL"]]` + * `colour` -> `.data[["TRTVAR"]]` + * `shape` -> `.data[["TRTVAR"]]` + * `size` -> `.data[["TRTVAR"]]` + * `text` -> `.data[["HOVER_PCT"]]` + * `key` -> `.data[["key"]]` + +--- + + Code + sp[[x]] + Output + [[1]] + geom_point: na.rm = FALSE + stat_identity: na.rm = FALSE + position_identity + + [[2]] + mapping: yintercept = ~yintercept + geom_hline: na.rm = FALSE + stat_identity: na.rm = FALSE + position_identity + + +--- + + Code + sp[[x]] + Output + $axis.title.x + List of 11 + $ family : NULL + $ face : NULL + $ colour : NULL + $ size : num 8 + $ hjust : NULL + $ vjust : NULL + $ angle : NULL + $ lineheight : NULL + $ margin : NULL + $ debug : NULL + $ inherit.blank: logi FALSE + - attr(*, "class")= chr [1:2] "element_text" "element" + + $axis.title.y + List of 11 + $ family : NULL + $ face : NULL + $ colour : NULL + $ size : NULL + $ hjust : NULL + $ vjust : NULL + $ angle : NULL + $ lineheight : NULL + $ margin : NULL + $ debug : NULL + $ inherit.blank: logi FALSE + - attr(*, "class")= chr [1:2] "element_text" "element" + + $axis.text.x + List of 11 + $ family : NULL + $ face : NULL + $ colour : NULL + $ size : num 4 + $ hjust : NULL + $ vjust : NULL + $ angle : NULL + $ lineheight : NULL + $ margin : NULL + $ debug : NULL + $ inherit.blank: logi FALSE + - attr(*, "class")= chr [1:2] "element_text" "element" + + $axis.text.y + List of 11 + $ family : NULL + $ face : NULL + $ colour : NULL + $ size : NULL + $ hjust : NULL + $ vjust : NULL + $ angle : NULL + $ lineheight : NULL + $ margin : NULL + $ debug : NULL + $ inherit.blank: logi FALSE + - attr(*, "class")= chr [1:2] "element_text" "element" + + $legend.background + List of 5 + $ fill : NULL + $ colour : chr "black" + $ linewidth : NULL + $ linetype : chr "solid" + $ inherit.blank: logi FALSE + - attr(*, "class")= chr [1:2] "element_rect" "element" + + $legend.position + [1] "bottom" + + $legend.direction + [1] "horizontal" + + $panel.background + List of 5 + $ fill : chr "white" + $ colour : chr "black" + $ linewidth : NULL + $ linetype : NULL + $ inherit.blank: logi FALSE + - attr(*, "class")= chr [1:2] "element_rect" "element" + + $panel.border + List of 5 + $ fill : logi NA + $ colour : chr "black" + $ linewidth : num 1 + $ linetype : NULL + $ inherit.blank: logi FALSE + - attr(*, "class")= chr [1:2] "element_rect" "element" + + $plot.title + List of 11 + $ family : NULL + $ face : NULL + $ colour : NULL + $ size : NULL + $ hjust : num 0.5 + $ vjust : NULL + $ angle : NULL + $ lineheight : NULL + $ margin : NULL + $ debug : NULL + $ inherit.blank: logi FALSE + - attr(*, "class")= chr [1:2] "element_text" "element" + + attr(,"complete") + [1] FALSE + attr(,"validate") + [1] TRUE + +# Test Case 1: forest_display interactive works correctly + + Code + actual$x$layout + Output + $xaxis + $xaxis$domain + [1] 0.050 0.297 + + $xaxis$automargin + [1] TRUE + + $xaxis$type + [1] "linear" + + $xaxis$autorange + [1] FALSE + + $xaxis$range + [1] 0.4 1.6 + + $xaxis$tickmode + [1] "array" + + $xaxis$ticktext + [1] "HT" + + $xaxis$tickvals + [1] 1 + attr(,"class") + [1] "mapped_discrete" "numeric" + + $xaxis$categoryorder + [1] "array" + + $xaxis$categoryarray + [1] "HT" + + $xaxis$nticks + [1] NA + + $xaxis$ticks + [1] "" + + $xaxis$tickcolor + [1] NA + + $xaxis$ticklen + [1] 3.652968 + + $xaxis$tickwidth + [1] 0 + + $xaxis$showticklabels + [1] FALSE + + $xaxis$tickfont + $xaxis$tickfont$color + [1] NA + + $xaxis$tickfont$family + [1] NA + + $xaxis$tickfont$size + [1] 0 + + + $xaxis$tickangle + [1] 0 + + $xaxis$showline + [1] TRUE + + $xaxis$linecolor + [1] "rgba(255,255,255,1)" + + $xaxis$linewidth + [1] 0.664176 + + $xaxis$showgrid + [1] FALSE + + $xaxis$gridcolor + [1] NA + + $xaxis$gridwidth + [1] 0 + + $xaxis$zeroline + [1] FALSE + + $xaxis$anchor + [1] "y" + + $xaxis$title + $xaxis$title$text + [1] "" + + $xaxis$title$font + $xaxis$title$font$color + [1] "rgba(0,0,0,1)" + + $xaxis$title$font$family + [1] "" + + $xaxis$title$font$size + [1] 10.62682 + + + + $xaxis$hoverformat + [1] ".2f" + + $xaxis$side + [1] "top" + + + $xaxis2 + $xaxis2$domain + [1] 0.303 0.677 + + $xaxis2$automargin + [1] TRUE + + $xaxis2$type + [1] "linear" + + $xaxis2$autorange + [1] FALSE + + $xaxis2$range + [1] -1.73913 36.52174 + + $xaxis2$tickmode + [1] "array" + + $xaxis2$ticktext + [1] "0" "10" "20" "30" + + $xaxis2$tickvals + [1] 0 10 20 30 + + $xaxis2$categoryorder + [1] "array" + + $xaxis2$categoryarray + [1] "0" "10" "20" "30" + + $xaxis2$nticks + [1] NA + + $xaxis2$ticks + [1] "outside" + + $xaxis2$tickcolor + [1] "rgba(51,51,51,1)" + + $xaxis2$ticklen + [1] 3.652968 + + $xaxis2$tickwidth + [1] 0.664176 + + $xaxis2$showticklabels + [1] TRUE + + $xaxis2$tickfont + $xaxis2$tickfont$color + [1] "rgba(77,77,77,1)" + + $xaxis2$tickfont$family + [1] "" + + $xaxis2$tickfont$size + [1] 5.313408 + + + $xaxis2$tickangle + [1] 0 + + $xaxis2$showline + [1] FALSE + + $xaxis2$linecolor + [1] NA + + $xaxis2$linewidth + [1] 0 + + $xaxis2$showgrid + [1] TRUE + + $xaxis2$gridcolor + [1] "rgba(255,255,255,1)" + + $xaxis2$gridwidth + [1] 0.664176 + + $xaxis2$zeroline + [1] FALSE + + $xaxis2$anchor + [1] "y2" + + $xaxis2$title + $xaxis2$title$text + [1] "Percentage" + + $xaxis2$title$font + $xaxis2$title$font$color + [1] "rgba(0,0,0,1)" + + $xaxis2$title$font$family + [1] "" + + $xaxis2$title$font$size + [1] 10.62682 + + + + $xaxis2$hoverformat + [1] ".2f" + + $xaxis2$side + [1] "top" + + + $xaxis3 + $xaxis3$domain + [1] 0.683 0.950 + + $xaxis3$automargin + [1] TRUE + + $xaxis3$type + [1] "linear" + + $xaxis3$autorange + [1] FALSE + + $xaxis3$range + [1] -1.8705 39.2805 + + $xaxis3$tickmode + [1] "array" + + $xaxis3$ticktext + [1] "0" "10" "20" "30" + + $xaxis3$tickvals + [1] 0 10 20 30 + + $xaxis3$categoryorder + [1] "array" + + $xaxis3$categoryarray + [1] "0" "10" "20" "30" + + $xaxis3$nticks + [1] NA + + $xaxis3$ticks + [1] "" + + $xaxis3$tickcolor + [1] NA + + $xaxis3$ticklen + [1] 3.652968 + + $xaxis3$tickwidth + [1] 0 + + $xaxis3$showticklabels + [1] TRUE + + $xaxis3$tickfont + $xaxis3$tickfont$color + [1] "rgba(77,77,77,1)" + + $xaxis3$tickfont$family + [1] "" + + $xaxis3$tickfont$size + [1] 10.62682 + + + $xaxis3$tickangle + [1] 0 + + $xaxis3$showline + [1] TRUE + + $xaxis3$linecolor + [1] "rgba(0,0,0,1)" + + $xaxis3$linewidth + [1] 0.664176 + + $xaxis3$showgrid + [1] FALSE + + $xaxis3$gridcolor + [1] NA + + $xaxis3$gridwidth + [1] 0 + + $xaxis3$zeroline + [1] FALSE + + $xaxis3$anchor + [1] "y3" + + $xaxis3$title + $xaxis3$title$text + [1] "Risk Ratio" + + $xaxis3$title$font + $xaxis3$title$font$color + [1] "rgba(0,0,0,1)" + + $xaxis3$title$font$family + [1] "" + + $xaxis3$title$font$size + [1] 10.62682 + + + + $xaxis3$hoverformat + [1] ".2f" + + $xaxis3$side + [1] "top" + + + $yaxis3 + $yaxis3$domain + [1] 0 1 + + $yaxis3$automargin + [1] TRUE + + $yaxis3$type + [1] "linear" + + $yaxis3$autorange + [1] FALSE + + $yaxis3$range + [1] 0.4 36.6 + + $yaxis3$tickmode + [1] "array" + + $yaxis3$ticktext + [1] "AGITATION" + [2] "APPLICATION SITE DERMATITIS" + [3] "APPLICATION SITE ERYTHEMA" + [4] "APPLICATION SITE IRRITATION" + [5] "APPLICATION SITE PRURITUS" + [6] "APPLICATION SITE VESICLES" + [7] "BACK PAIN" + [8] "CONFUSIONAL STATE" + [9] "CONTUSION" + [10] "COUGH" + [11] "DIARRHOEA" + [12] "DIZZINESS" + [13] "EAR INFECTION" + [14] "ELECTROCARDIOGRAM ST SEGMENT DEPRESSION" + [15] "ELECTROCARDIOGRAM T WAVE INVERSION" + [16] "ERYTHEMA" + [17] "EXCORIATION" + [18] "FATIGUE" + [19] "HEADACHE" + [20] "HYPERHIDROSIS" + [21] "HYPOTENSION" + [22] "INSOMNIA" + [23] "MYOCARDIAL INFARCTION" + [24] "NASAL CONGESTION" + [25] "NASOPHARYNGITIS" + [26] "NAUSEA" + [27] "OEDEMA PERIPHERAL" + [28] "PRURITUS" + [29] "PYREXIA" + [30] "RASH" + [31] "SINUS BRADYCARDIA" + [32] "SKIN IRRITATION" + [33] "SOMNOLENCE" + [34] "UPPER RESPIRATORY TRACT INFECTION" + [35] "URINARY TRACT INFECTION" + [36] "VOMITING" + + $yaxis3$tickvals + [1] 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 + [26] 26 27 28 29 30 31 32 33 34 35 36 + attr(,"class") + [1] "mapped_discrete" "numeric" + + $yaxis3$categoryorder + [1] "array" + + $yaxis3$categoryarray + [1] "AGITATION" + [2] "APPLICATION SITE DERMATITIS" + [3] "APPLICATION SITE ERYTHEMA" + [4] "APPLICATION SITE IRRITATION" + [5] "APPLICATION SITE PRURITUS" + [6] "APPLICATION SITE VESICLES" + [7] "BACK PAIN" + [8] "CONFUSIONAL STATE" + [9] "CONTUSION" + [10] "COUGH" + [11] "DIARRHOEA" + [12] "DIZZINESS" + [13] "EAR INFECTION" + [14] "ELECTROCARDIOGRAM ST SEGMENT DEPRESSION" + [15] "ELECTROCARDIOGRAM T WAVE INVERSION" + [16] "ERYTHEMA" + [17] "EXCORIATION" + [18] "FATIGUE" + [19] "HEADACHE" + [20] "HYPERHIDROSIS" + [21] "HYPOTENSION" + [22] "INSOMNIA" + [23] "MYOCARDIAL INFARCTION" + [24] "NASAL CONGESTION" + [25] "NASOPHARYNGITIS" + [26] "NAUSEA" + [27] "OEDEMA PERIPHERAL" + [28] "PRURITUS" + [29] "PYREXIA" + [30] "RASH" + [31] "SINUS BRADYCARDIA" + [32] "SKIN IRRITATION" + [33] "SOMNOLENCE" + [34] "UPPER RESPIRATORY TRACT INFECTION" + [35] "URINARY TRACT INFECTION" + [36] "VOMITING" + + $yaxis3$nticks + [1] NA + + $yaxis3$ticks + [1] "" + + $yaxis3$tickcolor + [1] NA + + $yaxis3$ticklen + [1] 3.652968 + + $yaxis3$tickwidth + [1] 0 + + $yaxis3$showticklabels + [1] FALSE + + $yaxis3$tickfont + $yaxis3$tickfont$color + [1] NA + + $yaxis3$tickfont$family + [1] NA + + $yaxis3$tickfont$size + [1] 0 + + + $yaxis3$tickangle + [1] 0 + + $yaxis3$showline + [1] TRUE + + $yaxis3$linecolor + [1] "rgba(0,0,0,1)" + + $yaxis3$linewidth + [1] 0.664176 + + $yaxis3$showgrid + [1] FALSE + + $yaxis3$gridcolor + [1] NA + + $yaxis3$gridwidth + [1] 0 + + $yaxis3$zeroline + [1] FALSE + + $yaxis3$anchor + [1] "x3" + + $yaxis3$hoverformat + [1] ".2f" + + + $yaxis2 + $yaxis2$domain + [1] 0 1 + + $yaxis2$automargin + [1] TRUE + + $yaxis2$type + [1] "linear" + + $yaxis2$autorange + [1] FALSE + + $yaxis2$range + [1] 0.4 36.6 + + $yaxis2$tickmode + [1] "array" + + $yaxis2$ticktext + [1] "AGITATION" + [2] "APPLICATION SITE DERMATITIS" + [3] "APPLICATION SITE ERYTHEMA" + [4] "APPLICATION SITE IRRITATION" + [5] "APPLICATION SITE PRURITUS" + [6] "APPLICATION SITE VESICLES" + [7] "BACK PAIN" + [8] "CONFUSIONAL STATE" + [9] "CONTUSION" + [10] "COUGH" + [11] "DIARRHOEA" + [12] "DIZZINESS" + [13] "EAR INFECTION" + [14] "ELECTROCARDIOGRAM ST SEGMENT DEPRESSION" + [15] "ELECTROCARDIOGRAM T WAVE INVERSION" + [16] "ERYTHEMA" + [17] "EXCORIATION" + [18] "FATIGUE" + [19] "HEADACHE" + [20] "HYPERHIDROSIS" + [21] "HYPOTENSION" + [22] "INSOMNIA" + [23] "MYOCARDIAL INFARCTION" + [24] "NASAL CONGESTION" + [25] "NASOPHARYNGITIS" + [26] "NAUSEA" + [27] "OEDEMA PERIPHERAL" + [28] "PRURITUS" + [29] "PYREXIA" + [30] "RASH" + [31] "SINUS BRADYCARDIA" + [32] "SKIN IRRITATION" + [33] "SOMNOLENCE" + [34] "UPPER RESPIRATORY TRACT INFECTION" + [35] "URINARY TRACT INFECTION" + [36] "VOMITING" + + $yaxis2$tickvals + [1] 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 + [26] 26 27 28 29 30 31 32 33 34 35 36 + attr(,"class") + [1] "mapped_discrete" "numeric" + + $yaxis2$categoryorder + [1] "array" + + $yaxis2$categoryarray + [1] "AGITATION" + [2] "APPLICATION SITE DERMATITIS" + [3] "APPLICATION SITE ERYTHEMA" + [4] "APPLICATION SITE IRRITATION" + [5] "APPLICATION SITE PRURITUS" + [6] "APPLICATION SITE VESICLES" + [7] "BACK PAIN" + [8] "CONFUSIONAL STATE" + [9] "CONTUSION" + [10] "COUGH" + [11] "DIARRHOEA" + [12] "DIZZINESS" + [13] "EAR INFECTION" + [14] "ELECTROCARDIOGRAM ST SEGMENT DEPRESSION" + [15] "ELECTROCARDIOGRAM T WAVE INVERSION" + [16] "ERYTHEMA" + [17] "EXCORIATION" + [18] "FATIGUE" + [19] "HEADACHE" + [20] "HYPERHIDROSIS" + [21] "HYPOTENSION" + [22] "INSOMNIA" + [23] "MYOCARDIAL INFARCTION" + [24] "NASAL CONGESTION" + [25] "NASOPHARYNGITIS" + [26] "NAUSEA" + [27] "OEDEMA PERIPHERAL" + [28] "PRURITUS" + [29] "PYREXIA" + [30] "RASH" + [31] "SINUS BRADYCARDIA" + [32] "SKIN IRRITATION" + [33] "SOMNOLENCE" + [34] "UPPER RESPIRATORY TRACT INFECTION" + [35] "URINARY TRACT INFECTION" + [36] "VOMITING" + + $yaxis2$nticks + [1] NA + + $yaxis2$ticks + [1] "outside" + + $yaxis2$tickcolor + [1] "rgba(51,51,51,1)" + + $yaxis2$ticklen + [1] 3.652968 + + $yaxis2$tickwidth + [1] 0.664176 + + $yaxis2$showticklabels + [1] TRUE + + $yaxis2$tickfont + $yaxis2$tickfont$color + [1] "rgba(77,77,77,1)" + + $yaxis2$tickfont$family + [1] "" + + $yaxis2$tickfont$size + [1] 11.6895 + + + $yaxis2$tickangle + [1] 0 + + $yaxis2$showline + [1] FALSE + + $yaxis2$linecolor + [1] NA + + $yaxis2$linewidth + [1] 0 + + $yaxis2$showgrid + [1] TRUE + + $yaxis2$gridcolor + [1] "rgba(255,255,255,1)" + + $yaxis2$gridwidth + [1] 0.664176 + + $yaxis2$zeroline + [1] FALSE + + $yaxis2$anchor + [1] "x2" + + $yaxis2$hoverformat + [1] ".2f" + + + $yaxis + $yaxis$domain + [1] 0 1 + + $yaxis$automargin + [1] TRUE + + $yaxis$type + [1] "linear" + + $yaxis$autorange + [1] FALSE + + $yaxis$range + [1] 0.4 36.6 + + $yaxis$tickmode + [1] "array" + + $yaxis$ticktext + [1] "AGITATION" + [2] "APPLICATION SITE DERMATITIS" + [3] "APPLICATION SITE ERYTHEMA" + [4] "APPLICATION SITE IRRITATION" + [5] "APPLICATION SITE PRURITUS" + [6] "APPLICATION SITE VESICLES" + [7] "BACK PAIN" + [8] "CONFUSIONAL STATE" + [9] "CONTUSION" + [10] "COUGH" + [11] "DIARRHOEA" + [12] "DIZZINESS" + [13] "EAR INFECTION" + [14] "ELECTROCARDIOGRAM ST SEGMENT DEPRESSION" + [15] "ELECTROCARDIOGRAM T WAVE INVERSION" + [16] "ERYTHEMA" + [17] "EXCORIATION" + [18] "FATIGUE" + [19] "HEADACHE" + [20] "HYPERHIDROSIS" + [21] "HYPOTENSION" + [22] "INSOMNIA" + [23] "MYOCARDIAL INFARCTION" + [24] "NASAL CONGESTION" + [25] "NASOPHARYNGITIS" + [26] "NAUSEA" + [27] "OEDEMA PERIPHERAL" + [28] "PRURITUS" + [29] "PYREXIA" + [30] "RASH" + [31] "SINUS BRADYCARDIA" + [32] "SKIN IRRITATION" + [33] "SOMNOLENCE" + [34] "UPPER RESPIRATORY TRACT INFECTION" + [35] "URINARY TRACT INFECTION" + [36] "VOMITING" + + $yaxis$tickvals + [1] 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 + [26] 26 27 28 29 30 31 32 33 34 35 36 + attr(,"class") + [1] "mapped_discrete" "numeric" + + $yaxis$categoryorder + [1] "array" + + $yaxis$categoryarray + [1] "AGITATION" + [2] "APPLICATION SITE DERMATITIS" + [3] "APPLICATION SITE ERYTHEMA" + [4] "APPLICATION SITE IRRITATION" + [5] "APPLICATION SITE PRURITUS" + [6] "APPLICATION SITE VESICLES" + [7] "BACK PAIN" + [8] "CONFUSIONAL STATE" + [9] "CONTUSION" + [10] "COUGH" + [11] "DIARRHOEA" + [12] "DIZZINESS" + [13] "EAR INFECTION" + [14] "ELECTROCARDIOGRAM ST SEGMENT DEPRESSION" + [15] "ELECTROCARDIOGRAM T WAVE INVERSION" + [16] "ERYTHEMA" + [17] "EXCORIATION" + [18] "FATIGUE" + [19] "HEADACHE" + [20] "HYPERHIDROSIS" + [21] "HYPOTENSION" + [22] "INSOMNIA" + [23] "MYOCARDIAL INFARCTION" + [24] "NASAL CONGESTION" + [25] "NASOPHARYNGITIS" + [26] "NAUSEA" + [27] "OEDEMA PERIPHERAL" + [28] "PRURITUS" + [29] "PYREXIA" + [30] "RASH" + [31] "SINUS BRADYCARDIA" + [32] "SKIN IRRITATION" + [33] "SOMNOLENCE" + [34] "UPPER RESPIRATORY TRACT INFECTION" + [35] "URINARY TRACT INFECTION" + [36] "VOMITING" + + $yaxis$nticks + [1] NA + + $yaxis$ticks + [1] "" + + $yaxis$tickcolor + [1] NA + + $yaxis$ticklen + [1] 3.652968 + + $yaxis$tickwidth + [1] 0 + + $yaxis$showticklabels + [1] FALSE + + $yaxis$tickfont + $yaxis$tickfont$color + [1] NA + + $yaxis$tickfont$family + [1] NA + + $yaxis$tickfont$size + [1] 0 + + + $yaxis$tickangle + [1] 0 + + $yaxis$showline + [1] TRUE + + $yaxis$linecolor + [1] "rgba(255,255,255,1)" + + $yaxis$linewidth + [1] 0.664176 + + $yaxis$showgrid + [1] FALSE + + $yaxis$gridcolor + [1] NA + + $yaxis$gridwidth + [1] 0 + + $yaxis$zeroline + [1] FALSE + + $yaxis$anchor + [1] "x" + + $yaxis$hoverformat + [1] ".2f" + + + $annotations + list() + + $shapes + $shapes[[1]] + $shapes[[1]]$type + [1] "rect" + + $shapes[[1]]$fillcolor + [1] "transparent" + + $shapes[[1]]$line + $shapes[[1]]$line$color + [1] "rgba(255,255,255,1)" + + $shapes[[1]]$line$width + [1] 1.328352 + + $shapes[[1]]$line$linetype + [1] "solid" + + + $shapes[[1]]$yref + [1] "paper" + + $shapes[[1]]$xref + [1] "paper" + + $shapes[[1]]$x0 + [1] 0.05 + + $shapes[[1]]$x1 + [1] 0.297 + + $shapes[[1]]$y0 + [1] 0 + + $shapes[[1]]$y1 + [1] 1 + + + $shapes[[2]] + $shapes[[2]]$type + [1] "rect" + + $shapes[[2]]$fillcolor + [1] "transparent" + + $shapes[[2]]$line + $shapes[[2]]$line$color + [1] "rgba(0,0,0,1)" + + $shapes[[2]]$line$width + [1] 1.328352 + + $shapes[[2]]$line$linetype + [1] "solid" + + + $shapes[[2]]$yref + [1] "paper" + + $shapes[[2]]$xref + [1] "paper" + + $shapes[[2]]$x0 + [1] 0.303 + + $shapes[[2]]$x1 + [1] 0.677 + + $shapes[[2]]$y0 + [1] 0 + + $shapes[[2]]$y1 + [1] 1 + + + $shapes[[3]] + $shapes[[3]]$type + [1] "rect" + + $shapes[[3]]$fillcolor + [1] "transparent" + + $shapes[[3]]$line + $shapes[[3]]$line$color + [1] "rgba(0,0,0,1)" + + $shapes[[3]]$line$width + [1] 1.328352 + + $shapes[[3]]$line$linetype + [1] "solid" + + + $shapes[[3]]$yref + [1] "paper" + + $shapes[[3]]$xref + [1] "paper" + + $shapes[[3]]$x0 + [1] 0.683 + + $shapes[[3]]$x1 + [1] 0.95 + + $shapes[[3]]$y0 + [1] 0 + + $shapes[[3]]$y1 + [1] 1 + + + + $images + list() + + $margin + $margin$t + [1] 16 + + $margin$r + [1] 0 + + $margin$b + [1] 24.9066 + + $margin$l + [1] 3.652968 + + + $paper_bgcolor + [1] "rgba(255,255,255,1)" + + $font + $font$color + [1] "rgba(0,0,0,1)" + + $font$family + [1] "" + + $font$size + [1] 14.61187 + + + $showlegend + [1] TRUE + + $legend + $legend$bgcolor + [1] "rgba(255,255,255,1)" + + $legend$bordercolor + [1] "transparent" + + $legend$borderwidth + [1] 1.889764 + + $legend$font + $legend$font$color + [1] "rgba(0,0,0,1)" + + $legend$font$family + [1] "" + + $legend$font$size + [1] 8 + + + $legend$orientation + [1] "h" + + $legend$x + [1] 0.3 + + $legend$y + [1] -0.2 + + $legend$size + [1] 8 + + $legend$xanchor + [1] "left" + + $legend$yanchor + [1] "top" + + + $hovermode + [1] "closest" + + $height + [1] 800 + + $barmode + [1] "relative" + + $plot_bgcolor + [1] "rgba(255,255,255,1)" + + diff --git a/tests/testthat/_snaps/graph_utils.md b/tests/testthat/_snaps/graph_utils.md new file mode 100644 index 0000000..5210530 --- /dev/null +++ b/tests/testthat/_snaps/graph_utils.md @@ -0,0 +1,161 @@ +# empty_plot works as expected + + Code + exp_ptly_obj + Output + [[1]] + [[1]]$x + [1] 1 + + [[1]]$y + [1] 1 + + [[1]]$text + [1] "No data available for these values" + + [[1]]$hovertext + [1] "x: 1
y: 1" + + [[1]]$textfont + [[1]]$textfont$size + [1] 30.23622 + + [[1]]$textfont$color + [1] "rgba(0,0,0,1)" + + + [[1]]$type + [1] "scatter" + + [[1]]$mode + [1] "text" + + [[1]]$hoveron + [1] "points" + + [[1]]$showlegend + [1] FALSE + + [[1]]$xaxis + [1] "x" + + [[1]]$yaxis + [1] "y" + + [[1]]$hoverinfo + [1] "text" + + [[1]]$name + [1] "" + + + +# theme_cleany works as expected + + Code + actual + Output + List of 14 + $ axis.title.x :List of 11 + ..$ family : NULL + ..$ face : NULL + ..$ colour : NULL + ..$ size : num 8 + ..$ hjust : NULL + ..$ vjust : NULL + ..$ angle : NULL + ..$ lineheight : NULL + ..$ margin : NULL + ..$ debug : NULL + ..$ inherit.blank: logi FALSE + ..- attr(*, "class")= chr [1:2] "element_text" "element" + $ axis.title.y : list() + ..- attr(*, "class")= chr [1:2] "element_blank" "element" + $ axis.text.x :List of 11 + ..$ family : NULL + ..$ face : NULL + ..$ colour : NULL + ..$ size : num 6 + ..$ hjust : NULL + ..$ vjust : NULL + ..$ angle : NULL + ..$ lineheight : NULL + ..$ margin : NULL + ..$ debug : NULL + ..$ inherit.blank: logi FALSE + ..- attr(*, "class")= chr [1:2] "element_text" "element" + $ axis.text.y : list() + ..- attr(*, "class")= chr [1:2] "element_blank" "element" + $ axis.ticks : list() + ..- attr(*, "class")= chr [1:2] "element_blank" "element" + $ axis.line :List of 6 + ..$ colour : chr "black" + ..$ linewidth : NULL + ..$ linetype : NULL + ..$ lineend : NULL + ..$ arrow : logi FALSE + ..$ inherit.blank: logi FALSE + ..- attr(*, "class")= chr [1:2] "element_line" "element" + $ legend.position : chr "bottom" + $ legend.direction: chr "horizontal" + $ panel.background: list() + ..- attr(*, "class")= chr [1:2] "element_blank" "element" + $ panel.border :List of 5 + ..$ fill : logi NA + ..$ colour : chr "black" + ..$ linewidth : num 1 + ..$ linetype : NULL + ..$ inherit.blank: logi FALSE + ..- attr(*, "class")= chr [1:2] "element_rect" "element" + $ panel.grid.major: list() + ..- attr(*, "class")= chr [1:2] "element_blank" "element" + $ panel.grid.minor: list() + ..- attr(*, "class")= chr [1:2] "element_blank" "element" + $ plot.title :List of 11 + ..$ family : NULL + ..$ face : NULL + ..$ colour : NULL + ..$ size : num 10 + ..$ hjust : num 0.1 + ..$ vjust : NULL + ..$ angle : NULL + ..$ lineheight : NULL + ..$ margin : NULL + ..$ debug : NULL + ..$ inherit.blank: logi FALSE + ..- attr(*, "class")= chr [1:2] "element_text" "element" + $ plot.margin : 'simpleUnit' num [1:4] 0cm 0cm 0cm 0cm + ..- attr(*, "unit")= int 1 + - attr(*, "class")= chr [1:2] "theme" "gg" + - attr(*, "complete")= logi FALSE + - attr(*, "validate")= logi TRUE + +# tbl_to_plot works as expected + + Code + fig[[x]] + Output + Aesthetic mapping: + * `x` -> `.data[["CYL"]]` + * `y` -> `.data[["manufacturer"]]` + * `label` -> `.data[["HWY"]]` + * `colour` -> `.data[["CYL"]]` + +--- + + Code + fig[[x]] + Output + $x + [1] "CYL" + + $y + [1] "manufacturer" + + $label + [1] "HWY" + + $colour + [1] "CYL" + + diff --git a/tests/testthat/_snaps/lab_abnormality.md b/tests/testthat/_snaps/lab_abnormality.md new file mode 100644 index 0000000..1683bdf --- /dev/null +++ b/tests/testthat/_snaps/lab_abnormality.md @@ -0,0 +1,336 @@ +# lab_abnormality_summary works as expected with different options + + Code + x + Output + [1] "CHEM" "CHEM" + +--- + + Code + x + Output + [1] "Sodium (mmol/L)" "Cholesterol (mmol/L)" + +--- + + Code + x + Output + [1] "< 135x LLN" "> 5.17x ULN" + +--- + + Code + x + Output + [1] 1 1 + +--- + + Code + x + Output + [1] 1 2 + +--- + + Code + x + Output + [1] "C" "C" + +--- + + Code + x + Output + [1] "5" "61" + +--- + + Code + x + Output + [1] "7 (140.00)" "65 (106.56)" + +--- + + Code + x + Output + [1] "0" "7" + +--- + + Code + x + Output + [1] "0" "7 (100.00)" + +--- + + Code + x + Output + [1] "5" "68" + +--- + + Code + x + Output + [1] "7 (140.00)" "72 (105.88)" + +--- + + Code + x + Output + [1] "3" "59" + +--- + + Code + x + Output + [1] "5 (166.67)" "60 (101.69)" + +--- + + Code + x + Output + [1] "0" "3" + +--- + + Code + x + Output + [1] "0" "4 (133.33)" + +--- + + Code + x + Output + [1] "3" "62" + +--- + + Code + x + Output + [1] "5 (166.67)" "64 (103.23)" + +--- + + Code + x + Output + [1] "7" "50" + +--- + + Code + x + Output + [1] "8 (114.29)" "60 (120.00)" + +--- + + Code + x + Output + [1] "1" "7" + +--- + + Code + x + Output + [1] "1 (100.00)" "7 (100.00)" + +--- + + Code + x + Output + [1] "8" "57" + +--- + + Code + x + Output + [1] "9 (112.50)" "68 (119.30)" + +--- + + Code + x + Output + [1] "15" "170" + +--- + + Code + x + Output + [1] "20 (133.33)" "185 (108.82)" + +--- + + Code + x + Output + [1] "1" "17" + +--- + + Code + x + Output + [1] "1 (100.00)" "18 (105.88)" + +--- + + Code + x + Output + [1] "16" "187" + +--- + + Code + x + Output + [1] "21 (131.25)" "204 (109.09)" + +--- + + Code + x + Output + [1] "CHEM" "CHEM" + +--- + + Code + x + Output + [1] "Sodium (mmol/L)" "Cholesterol (mmol/L)" + +--- + + Code + x + Output + [1] "< 135x LLN" "> 5.17x ULN" + +--- + + Code + x + Output + [1] 1 1 + +--- + + Code + x + Output + [1] 1 2 + +--- + + Code + x + Output + [1] "C" "C" + +--- + + Code + x + Output + [1] "5" "61" + +--- + + Code + x + Output + [1] "7 (140.00)" "65 (106.56)" + +--- + + Code + x + Output + [1] "0" "7" + +--- + + Code + x + Output + [1] "0" "0" + +--- + + Code + x + Output + [1] "7" "50" + +--- + + Code + x + Output + [1] "8 (114.29)" "60 (120.00)" + +--- + + Code + x + Output + [1] "1" "7" + +--- + + Code + x + Output + [1] "0" "0" + +--- + + Code + x + Output + [1] "3" "59" + +--- + + Code + x + Output + [1] "5 (166.67)" "60 (101.69)" + +--- + + Code + x + Output + [1] "0" "3" + +--- + + Code + x + Output + [1] "0" "0" + diff --git a/tests/testthat/_snaps/line_plot.md b/tests/testthat/_snaps/line_plot.md new file mode 100644 index 0000000..bdab140 --- /dev/null +++ b/tests/testthat/_snaps/line_plot.md @@ -0,0 +1,40 @@ +# Standard line plot outputs + + Code + fig[[x]] + Output + Aesthetic mapping: + * `x` -> `.data[["XVAR"]]` + * `y` -> `.data[["YVAR"]]` + * `group` -> `.data[["TRTVAR"]]` + +--- + + Code + fig[[x]] + Output + $x + [1] "Race" + + $y + [1] "Mean Age" + + $fill + [1] "Treatment" + + $title + NULL + + $group + [1] "TRTVAR" + + $colour + [1] "TRTVAR" + + $shape + [1] "TRTVAR" + + $size + [1] "TRTVAR" + + diff --git a/tests/testthat/_snaps/occ_tier_summary.md b/tests/testthat/_snaps/occ_tier_summary.md index 3d06a81..583a84c 100644 --- a/tests/testthat/_snaps/occ_tier_summary.md +++ b/tests/testthat/_snaps/occ_tier_summary.md @@ -1,63 +1,944 @@ -# Standard inputs for occ_tier works +# occ_tier standard inputs works Code - output + print(output, n = Inf, width = Inf) Output - # A tibble: 84 x 13 - TRTVAR DPTVAR DPTVAL CVALUE DENOMN FREQ PCT XVAR CN DPTVARN DPTVALN - - 1 Placebo TIER RESPI~ 1 ( 1~ 52 1 1.92 RESP~ C 1 0 - 2 Placebo TIER CARDI~ 2 ( 3~ 52 2 3.85 CARD~ C 2 0 - 3 Placebo TIER NERVO~ 3 ( 5~ 52 3 5.77 NERV~ C 3 0 - 4 Placebo TIER INFEC~ 8 (15~ 52 8 15.4 INFE~ C 4 0 - 5 Placebo TIER GASTR~ 12 (2~ 52 12 23.1 GAST~ C 5 0 - 6 Placebo TIER GENER~ 16 (3~ 52 16 30.8 GENE~ C 6 0 - 7 Placebo TIER SKIN ~ 17 (3~ 52 17 32.7 SKIN~ C 7 0 - 8 Xanomeli~ TIER CARDI~ 5 ( 7~ 69 5 7.25 CARD~ C 2 0 - 9 Xanomeli~ TIER GASTR~ 6 ( 8~ 69 6 8.7 GAST~ C 5 0 - 10 Xanomeli~ TIER GENER~ 38 (5~ 69 38 55.1 GENE~ C 6 0 - # i 74 more rows - # i 2 more variables: SUBGRPVARX , SUBGRPVARXN + # A tibble: 12 x 14 + TRTVAR DPTVAR + + 1 Placebo TIER + 2 Placebo TIER + 3 Xanomeline Low Dose TIER + 4 Xanomeline Low Dose TIER + 5 Xanomeline High Dose TIER + 6 Xanomeline High Dose TIER + 7 Placebo TIER + 8 Placebo TIER + 9 Xanomeline Low Dose TIER + 10 Xanomeline Low Dose TIER + 11 Xanomeline High Dose TIER + 12 Xanomeline High Dose TIER + DPTVAL CVALUE DENOMN + + 1 "GENERAL DISORDERS AND ADMINISTRATION SITE CONDITIONS" 6 (17.14%) 35 + 2 "SKIN AND SUBCUTANEOUS TISSUE DISORDERS" 8 (22.86%) 35 + 3 "GENERAL DISORDERS AND ADMINISTRATION SITE CONDITIONS" 22 (32.35%) 68 + 4 "SKIN AND SUBCUTANEOUS TISSUE DISORDERS" 23 (33.82%) 68 + 5 "GENERAL DISORDERS AND ADMINISTRATION SITE CONDITIONS" 22 (31.88%) 69 + 6 "SKIN AND SUBCUTANEOUS TISSUE DISORDERS" 26 (37.68%) 69 + 7 "\t\t\tAPPLICATION SITE PRURITUS" 6 ( 8.70%) 69 + 8 "\t\t\tPRURITUS" 8 (11.59%) 69 + 9 "\t\t\tAPPLICATION SITE PRURITUS" 22 (28.57%) 77 + 10 "\t\t\tPRURITUS" 23 (29.87%) 77 + 11 "\t\t\tAPPLICATION SITE PRURITUS" 22 (27.85%) 79 + 12 "\t\t\tPRURITUS" 26 (32.91%) 79 + FREQ PCT CPCT XVAR + + 1 6 17.1 "17.14" GENERAL DISORDERS AND ADMINISTRATION SITE CONDITIONS + 2 8 22.9 "22.86" SKIN AND SUBCUTANEOUS TISSUE DISORDERS + 3 22 32.4 "32.35" GENERAL DISORDERS AND ADMINISTRATION SITE CONDITIONS + 4 23 33.8 "33.82" SKIN AND SUBCUTANEOUS TISSUE DISORDERS + 5 22 31.9 "31.88" GENERAL DISORDERS AND ADMINISTRATION SITE CONDITIONS + 6 26 37.7 "37.68" SKIN AND SUBCUTANEOUS TISSUE DISORDERS + 7 6 8.70 " 8.70" APPLICATION SITE PRURITUS + 8 8 11.6 "11.59" PRURITUS + 9 22 28.6 "28.57" APPLICATION SITE PRURITUS + 10 23 29.9 "29.87" PRURITUS + 11 22 27.8 "27.85" APPLICATION SITE PRURITUS + 12 26 32.9 "32.91" PRURITUS + CN DPTVARN DPTVALN SUBGRPVARX SUBGRPVARXN + + 1 C 1 0 "n (%) " 1 + 2 C 2 0 "n (%) " 1 + 3 C 1 0 "n (%) " 1 + 4 C 2 0 "n (%) " 1 + 5 C 1 0 "n (%) " 1 + 6 C 2 0 "n (%) " 1 + 7 C 1 1 "n (%) " 1 + 8 C 2 1 "n (%) " 1 + 9 C 1 1 "n (%) " 1 + 10 C 2 1 "n (%) " 1 + 11 C 1 1 "n (%) " 1 + 12 C 2 1 "n (%) " 1 ---- +# occ_tier modified inputs works Code - output + print(output, n = Inf, width = Inf) Output - # A tibble: 84 x 13 - TRTVAR DPTVAR DPTVAL CVALUE DENOMN FREQ PCT XVAR CN DPTVARN DPTVALN - - 1 Placebo TIER RESPI~ 1 ( 1~ 52 1 1.92 RESP~ C 1 0 - 2 Placebo TIER CARDI~ 2 ( 3~ 52 2 3.85 CARD~ C 2 0 - 3 Placebo TIER NERVO~ 3 ( 5~ 52 3 5.77 NERV~ C 3 0 - 4 Placebo TIER INFEC~ 8 (15~ 52 8 15.4 INFE~ C 4 0 - 5 Placebo TIER GASTR~ 12 (2~ 52 12 23.1 GAST~ C 5 0 - 6 Placebo TIER GENER~ 16 (3~ 52 16 30.8 GENE~ C 6 0 - 7 Placebo TIER SKIN ~ 17 (3~ 52 17 32.7 SKIN~ C 7 0 - 8 Xanomeli~ TIER CARDI~ 5 ( 7~ 69 5 7.25 CARD~ C 2 0 - 9 Xanomeli~ TIER GASTR~ 6 ( 8~ 69 6 8.7 GAST~ C 5 0 - 10 Xanomeli~ TIER GENER~ 38 (5~ 69 38 55.1 GENE~ C 6 0 - # i 74 more rows - # i 2 more variables: SUBGRPVARX , SUBGRPVARXN + # A tibble: 21 x 14 + TRTVAR DPTVAR + + 1 Placebo TIER + 2 Xanomeline Low Dose TIER + 3 Xanomeline High Dose TIER + 4 Placebo TIER + 5 Xanomeline Low Dose TIER + 6 Xanomeline High Dose TIER + 7 Placebo TIER + 8 Xanomeline Low Dose TIER + 9 Xanomeline High Dose TIER + 10 Placebo TIER + 11 Xanomeline Low Dose TIER + 12 Xanomeline High Dose TIER + 13 Placebo TIER + 14 Xanomeline Low Dose TIER + 15 Xanomeline High Dose TIER + 16 Placebo TIER + 17 Xanomeline Low Dose TIER + 18 Xanomeline High Dose TIER + 19 Placebo TIER + 20 Xanomeline Low Dose TIER + 21 Xanomeline High Dose TIER + DPTVAL CVALUE DENOMN + + 1 "GASTROINTESTINAL DISORDERS" "" 69 + 2 "GASTROINTESTINAL DISORDERS" "" 77 + 3 "GASTROINTESTINAL DISORDERS" "" 79 + 4 "GENERAL DISORDERS AND ADMINISTRATION SITE CONDITIONS" "" 69 + 5 "GENERAL DISORDERS AND ADMINISTRATION SITE CONDITIONS" "" 77 + 6 "GENERAL DISORDERS AND ADMINISTRATION SITE CONDITIONS" "" 79 + 7 "NERVOUS SYSTEM DISORDERS" "" 69 + 8 "NERVOUS SYSTEM DISORDERS" "" 77 + 9 "NERVOUS SYSTEM DISORDERS" "" 79 + 10 "SKIN AND SUBCUTANEOUS TISSUE DISORDERS" "" 69 + 11 "SKIN AND SUBCUTANEOUS TISSUE DISORDERS" "" 77 + 12 "SKIN AND SUBCUTANEOUS TISSUE DISORDERS" "" 79 + 13 "\t\t\tAPPLICATION SITE PRURITUS" "6 ( 8.70%)" 69 + 14 "\t\t\tAPPLICATION SITE PRURITUS" "22 (28.57%)" 77 + 15 "\t\t\tAPPLICATION SITE PRURITUS" "22 (27.85%)" 79 + 16 "\t\t\tPRURITUS" "8 (11.59%)" 69 + 17 "\t\t\tPRURITUS" "23 (29.87%)" 77 + 18 "\t\t\tPRURITUS" "26 (32.91%)" 79 + 19 "Any Adverse Event" "69 (100.00%)" 69 + 20 "Any Adverse Event" "77 (100.00%)" 77 + 21 "Any Adverse Event" "79 (100.00%)" 79 + FREQ PCT CPCT XVAR + + 1 17 24.6 "24.64" GASTROINTESTINAL DISORDERS + 2 15 19.5 "19.48" GASTROINTESTINAL DISORDERS + 3 21 26.6 "26.58" GASTROINTESTINAL DISORDERS + 4 21 30.4 "30.43" GENERAL DISORDERS AND ADMINISTRATION SITE CONDITIONS + 5 47 61.0 "61.04" GENERAL DISORDERS AND ADMINISTRATION SITE CONDITIONS + 6 40 50.6 "50.63" GENERAL DISORDERS AND ADMINISTRATION SITE CONDITIONS + 7 12 17.4 "17.39" NERVOUS SYSTEM DISORDERS + 8 20 26.0 "25.97" NERVOUS SYSTEM DISORDERS + 9 27 34.2 "34.18" NERVOUS SYSTEM DISORDERS + 10 21 30.4 "30.43" SKIN AND SUBCUTANEOUS TISSUE DISORDERS + 11 42 54.5 "54.55" SKIN AND SUBCUTANEOUS TISSUE DISORDERS + 12 42 53.2 "53.16" SKIN AND SUBCUTANEOUS TISSUE DISORDERS + 13 6 8.70 " 8.70" APPLICATION SITE PRURITUS + 14 22 28.6 "28.57" APPLICATION SITE PRURITUS + 15 22 27.8 "27.85" APPLICATION SITE PRURITUS + 16 8 11.6 "11.59" PRURITUS + 17 23 29.9 "29.87" PRURITUS + 18 26 32.9 "32.91" PRURITUS + 19 69 100 "100.00" 1 + 20 77 100 "100.00" 1 + 21 79 100 "100.00" 1 + CN DPTVARN DPTVALN SUBGRPVARX SUBGRPVARXN + + 1 C 1 0 "n (%) " 1 + 2 C 1 0 "n (%) " 1 + 3 C 1 0 "n (%) " 1 + 4 C 2 0 "n (%) " 1 + 5 C 2 0 "n (%) " 1 + 6 C 2 0 "n (%) " 1 + 7 C 3 0 "n (%) " 1 + 8 C 3 0 "n (%) " 1 + 9 C 3 0 "n (%) " 1 + 10 C 4 0 "n (%) " 1 + 11 C 4 0 "n (%) " 1 + 12 C 4 0 "n (%) " 1 + 13 C 2 1 "n (%) " 1 + 14 C 2 1 "n (%) " 1 + 15 C 2 1 "n (%) " 1 + 16 C 4 1 "n (%) " 1 + 17 C 4 1 "n (%) " 1 + 18 C 4 1 "n (%) " 1 + 19 C 0 0 "n (%) " 1 + 20 C 0 0 "n (%) " 1 + 21 C 0 0 "n (%) " 1 -# Cut off applied for occ_tier works +# occ_tier standard inputs works max severity Code - output + print(output, n = Inf, width = Inf) Output - # A tibble: 102 x 13 - TRTVAR DPTVAR DPTVAL CVALUE DENOMN FREQ PCT XVAR CN DPTVARN DPTVALN - - 1 Placebo TIER CARDI~ 9 (13~ 69 9 13.0 CARD~ C 1 0 - 2 Xanomeli~ TIER CARDI~ 10 (1~ 77 10 13.0 CARD~ C 1 0 - 3 Xanomeli~ TIER CARDI~ 10 (1~ 79 10 12.7 CARD~ C 1 0 - 4 Placebo TIER GASTR~ 16 (2~ 69 16 23.2 GAST~ C 2 0 - 5 Xanomeli~ TIER GASTR~ 13 (1~ 77 13 16.9 GAST~ C 2 0 - 6 Xanomeli~ TIER GASTR~ 15 (1~ 79 15 19.0 GAST~ C 2 0 - 7 Placebo TIER GENER~ 21 (3~ 69 21 30.4 GENE~ C 3 0 - 8 Xanomeli~ TIER GENER~ 45 (5~ 77 45 58.4 GENE~ C 3 0 - 9 Xanomeli~ TIER GENER~ 35 (4~ 79 35 44.3 GENE~ C 3 0 - 10 Placebo TIER INFEC~ 16 (2~ 69 16 23.2 INFE~ C 4 0 - # i 92 more rows - # i 2 more variables: SUBGRPVARX , SUBGRPVARXN + # A tibble: 153 x 16 + TRTVAR SUBGRPVAR1 DPTVAR + + 1 Placebo MILD TIER + 2 Placebo MODERATE TIER + 3 Placebo SEVERE TIER + 4 Xanomeline Low Dose MILD TIER + 5 Xanomeline Low Dose MODERATE TIER + 6 Xanomeline Low Dose SEVERE TIER + 7 Xanomeline High Dose MILD TIER + 8 Xanomeline High Dose MODERATE TIER + 9 Xanomeline High Dose SEVERE TIER + 10 Placebo MILD TIER + 11 Placebo MODERATE TIER + 12 Placebo SEVERE TIER + 13 Xanomeline Low Dose MILD TIER + 14 Xanomeline Low Dose MODERATE TIER + 15 Xanomeline Low Dose SEVERE TIER + 16 Xanomeline High Dose MILD TIER + 17 Xanomeline High Dose MODERATE TIER + 18 Xanomeline High Dose SEVERE TIER + 19 Placebo MILD TIER + 20 Placebo MODERATE TIER + 21 Placebo SEVERE TIER + 22 Xanomeline Low Dose MILD TIER + 23 Xanomeline Low Dose MODERATE TIER + 24 Xanomeline Low Dose SEVERE TIER + 25 Xanomeline High Dose MILD TIER + 26 Xanomeline High Dose MODERATE TIER + 27 Xanomeline High Dose SEVERE TIER + 28 Placebo MILD TIER + 29 Placebo MODERATE TIER + 30 Placebo SEVERE TIER + 31 Xanomeline Low Dose MILD TIER + 32 Xanomeline Low Dose MODERATE TIER + 33 Xanomeline Low Dose SEVERE TIER + 34 Xanomeline High Dose MILD TIER + 35 Xanomeline High Dose MODERATE TIER + 36 Xanomeline High Dose SEVERE TIER + 37 Placebo MILD TIER + 38 Placebo MODERATE TIER + 39 Placebo SEVERE TIER + 40 Xanomeline Low Dose MILD TIER + 41 Xanomeline Low Dose MODERATE TIER + 42 Xanomeline Low Dose SEVERE TIER + 43 Xanomeline High Dose MILD TIER + 44 Xanomeline High Dose MODERATE TIER + 45 Xanomeline High Dose SEVERE TIER + 46 Placebo MILD TIER + 47 Placebo MODERATE TIER + 48 Placebo SEVERE TIER + 49 Xanomeline Low Dose MILD TIER + 50 Xanomeline Low Dose MODERATE TIER + 51 Xanomeline Low Dose SEVERE TIER + 52 Xanomeline High Dose MILD TIER + 53 Xanomeline High Dose MODERATE TIER + 54 Xanomeline High Dose SEVERE TIER + 55 Placebo MILD TIER + 56 Placebo MODERATE TIER + 57 Placebo SEVERE TIER + 58 Xanomeline Low Dose MILD TIER + 59 Xanomeline Low Dose MODERATE TIER + 60 Xanomeline Low Dose SEVERE TIER + 61 Xanomeline High Dose MILD TIER + 62 Xanomeline High Dose MODERATE TIER + 63 Xanomeline High Dose SEVERE TIER + 64 Placebo MILD TIER + 65 Placebo MODERATE TIER + 66 Placebo SEVERE TIER + 67 Xanomeline Low Dose MILD TIER + 68 Xanomeline Low Dose MODERATE TIER + 69 Xanomeline Low Dose SEVERE TIER + 70 Xanomeline High Dose MILD TIER + 71 Xanomeline High Dose MODERATE TIER + 72 Xanomeline High Dose SEVERE TIER + 73 Placebo MILD TIER + 74 Placebo MODERATE TIER + 75 Placebo SEVERE TIER + 76 Xanomeline Low Dose MILD TIER + 77 Xanomeline Low Dose MODERATE TIER + 78 Xanomeline Low Dose SEVERE TIER + 79 Xanomeline High Dose MILD TIER + 80 Xanomeline High Dose MODERATE TIER + 81 Xanomeline High Dose SEVERE TIER + 82 Placebo MILD TIER + 83 Placebo MODERATE TIER + 84 Placebo SEVERE TIER + 85 Xanomeline Low Dose MILD TIER + 86 Xanomeline Low Dose MODERATE TIER + 87 Xanomeline Low Dose SEVERE TIER + 88 Xanomeline High Dose MILD TIER + 89 Xanomeline High Dose MODERATE TIER + 90 Xanomeline High Dose SEVERE TIER + 91 Placebo MILD TIER + 92 Placebo MODERATE TIER + 93 Placebo SEVERE TIER + 94 Xanomeline Low Dose MILD TIER + 95 Xanomeline Low Dose MODERATE TIER + 96 Xanomeline Low Dose SEVERE TIER + 97 Xanomeline High Dose MILD TIER + 98 Xanomeline High Dose MODERATE TIER + 99 Xanomeline High Dose SEVERE TIER + 100 Placebo MILD TIER + 101 Placebo MODERATE TIER + 102 Placebo SEVERE TIER + 103 Xanomeline Low Dose MILD TIER + 104 Xanomeline Low Dose MODERATE TIER + 105 Xanomeline Low Dose SEVERE TIER + 106 Xanomeline High Dose MILD TIER + 107 Xanomeline High Dose MODERATE TIER + 108 Xanomeline High Dose SEVERE TIER + 109 Placebo MILD TIER + 110 Placebo MODERATE TIER + 111 Placebo SEVERE TIER + 112 Xanomeline Low Dose MILD TIER + 113 Xanomeline Low Dose MODERATE TIER + 114 Xanomeline Low Dose SEVERE TIER + 115 Xanomeline High Dose MILD TIER + 116 Xanomeline High Dose MODERATE TIER + 117 Xanomeline High Dose SEVERE TIER + 118 Placebo MILD TIER + 119 Placebo MODERATE TIER + 120 Placebo SEVERE TIER + 121 Xanomeline Low Dose MILD TIER + 122 Xanomeline Low Dose MODERATE TIER + 123 Xanomeline Low Dose SEVERE TIER + 124 Xanomeline High Dose MILD TIER + 125 Xanomeline High Dose MODERATE TIER + 126 Xanomeline High Dose SEVERE TIER + 127 Placebo MILD TIER + 128 Placebo MODERATE TIER + 129 Placebo SEVERE TIER + 130 Xanomeline Low Dose MILD TIER + 131 Xanomeline Low Dose MODERATE TIER + 132 Xanomeline Low Dose SEVERE TIER + 133 Xanomeline High Dose MILD TIER + 134 Xanomeline High Dose MODERATE TIER + 135 Xanomeline High Dose SEVERE TIER + 136 Placebo MILD TIER + 137 Placebo MODERATE TIER + 138 Placebo SEVERE TIER + 139 Xanomeline Low Dose MILD TIER + 140 Xanomeline Low Dose MODERATE TIER + 141 Xanomeline Low Dose SEVERE TIER + 142 Xanomeline High Dose MILD TIER + 143 Xanomeline High Dose MODERATE TIER + 144 Xanomeline High Dose SEVERE TIER + 145 Placebo MILD TIER + 146 Placebo MODERATE TIER + 147 Xanomeline Low Dose MILD TIER + 148 Xanomeline Low Dose MODERATE TIER + 149 Xanomeline Low Dose SEVERE TIER + 150 Xanomeline High Dose MILD TIER + 151 Xanomeline High Dose MODERATE TIER + 152 Xanomeline High Dose SEVERE TIER + 153 Placebo SEVERE TIER + DPTVAL CVALUE DENOMN + + 1 "CARDIAC DISORDERS" 8 (15.09%) 53 + 2 "CARDIAC DISORDERS" 2 ( 3.77%) 53 + 3 "CARDIAC DISORDERS" 2 ( 3.77%) 53 + 4 "CARDIAC DISORDERS" 8 (10.81%) 74 + 5 "CARDIAC DISORDERS" 5 ( 6.76%) 74 + 6 "CARDIAC DISORDERS" 0 74 + 7 "CARDIAC DISORDERS" 9 (12.33%) 73 + 8 "CARDIAC DISORDERS" 5 ( 6.85%) 73 + 9 "CARDIAC DISORDERS" 1 ( 1.37%) 73 + 10 "GASTROINTESTINAL DISORDERS" 15 (28.30%) 53 + 11 "GASTROINTESTINAL DISORDERS" 2 ( 3.77%) 53 + 12 "GASTROINTESTINAL DISORDERS" 0 53 + 13 "GASTROINTESTINAL DISORDERS" 10 (13.51%) 74 + 14 "GASTROINTESTINAL DISORDERS" 4 ( 5.41%) 74 + 15 "GASTROINTESTINAL DISORDERS" 0 74 + 16 "GASTROINTESTINAL DISORDERS" 14 (19.18%) 73 + 17 "GASTROINTESTINAL DISORDERS" 4 ( 5.48%) 73 + 18 "GASTROINTESTINAL DISORDERS" 2 ( 2.74%) 73 + 19 "GENERAL DISORDERS AND ADMINISTRATION SITE CONDITIONS" 16 (30.19%) 53 + 20 "GENERAL DISORDERS AND ADMINISTRATION SITE CONDITIONS" 5 ( 9.43%) 53 + 21 "GENERAL DISORDERS AND ADMINISTRATION SITE CONDITIONS" 0 53 + 22 "GENERAL DISORDERS AND ADMINISTRATION SITE CONDITIONS" 19 (25.68%) 74 + 23 "GENERAL DISORDERS AND ADMINISTRATION SITE CONDITIONS" 21 (28.38%) 74 + 24 "GENERAL DISORDERS AND ADMINISTRATION SITE CONDITIONS" 7 ( 9.46%) 74 + 25 "GENERAL DISORDERS AND ADMINISTRATION SITE CONDITIONS" 19 (26.03%) 73 + 26 "GENERAL DISORDERS AND ADMINISTRATION SITE CONDITIONS" 21 (28.77%) 73 + 27 "GENERAL DISORDERS AND ADMINISTRATION SITE CONDITIONS" 0 73 + 28 "NERVOUS SYSTEM DISORDERS" 6 (11.32%) 53 + 29 "NERVOUS SYSTEM DISORDERS" 2 ( 3.77%) 53 + 30 "NERVOUS SYSTEM DISORDERS" 0 53 + 31 "NERVOUS SYSTEM DISORDERS" 10 (13.51%) 74 + 32 "NERVOUS SYSTEM DISORDERS" 7 ( 9.46%) 74 + 33 "NERVOUS SYSTEM DISORDERS" 3 ( 4.05%) 74 + 34 "NERVOUS SYSTEM DISORDERS" 13 (17.81%) 73 + 35 "NERVOUS SYSTEM DISORDERS" 8 (10.96%) 73 + 36 "NERVOUS SYSTEM DISORDERS" 4 ( 5.48%) 73 + 37 "SKIN AND SUBCUTANEOUS TISSUE DISORDERS" 12 (22.64%) 53 + 38 "SKIN AND SUBCUTANEOUS TISSUE DISORDERS" 8 (15.09%) 53 + 39 "SKIN AND SUBCUTANEOUS TISSUE DISORDERS" 0 53 + 40 "SKIN AND SUBCUTANEOUS TISSUE DISORDERS" 12 (16.22%) 74 + 41 "SKIN AND SUBCUTANEOUS TISSUE DISORDERS" 23 (31.08%) 74 + 42 "SKIN AND SUBCUTANEOUS TISSUE DISORDERS" 4 ( 5.41%) 74 + 43 "SKIN AND SUBCUTANEOUS TISSUE DISORDERS" 24 (32.88%) 73 + 44 "SKIN AND SUBCUTANEOUS TISSUE DISORDERS" 15 (20.55%) 73 + 45 "SKIN AND SUBCUTANEOUS TISSUE DISORDERS" 1 ( 1.37%) 73 + 46 "\t\t\tSINUS BRADYCARDIA" 1 ( 1.54%) 65 + 47 "\t\t\tSINUS BRADYCARDIA" 1 ( 1.54%) 65 + 48 "\t\t\tSINUS BRADYCARDIA" 0 65 + 49 "\t\t\tSINUS BRADYCARDIA" 6 ( 7.79%) 77 + 50 "\t\t\tSINUS BRADYCARDIA" 1 ( 1.30%) 77 + 51 "\t\t\tSINUS BRADYCARDIA" 0 77 + 52 "\t\t\tSINUS BRADYCARDIA" 4 ( 5.26%) 76 + 53 "\t\t\tSINUS BRADYCARDIA" 4 ( 5.26%) 76 + 54 "\t\t\tSINUS BRADYCARDIA" 0 76 + 55 "\t\t\tDIARRHOEA" 9 (13.85%) 65 + 56 "\t\t\tDIARRHOEA" 0 65 + 57 "\t\t\tDIARRHOEA" 0 65 + 58 "\t\t\tDIARRHOEA" 4 ( 5.19%) 77 + 59 "\t\t\tDIARRHOEA" 0 77 + 60 "\t\t\tDIARRHOEA" 0 77 + 61 "\t\t\tDIARRHOEA" 2 ( 2.63%) 76 + 62 "\t\t\tDIARRHOEA" 2 ( 2.63%) 76 + 63 "\t\t\tDIARRHOEA" 0 76 + 64 "\t\t\tAPPLICATION SITE ERYTHEMA" 3 ( 4.62%) 65 + 65 "\t\t\tAPPLICATION SITE ERYTHEMA" 0 65 + 66 "\t\t\tAPPLICATION SITE ERYTHEMA" 0 65 + 67 "\t\t\tAPPLICATION SITE ERYTHEMA" 4 ( 5.19%) 77 + 68 "\t\t\tAPPLICATION SITE ERYTHEMA" 6 ( 7.79%) 77 + 69 "\t\t\tAPPLICATION SITE ERYTHEMA" 2 ( 2.60%) 77 + 70 "\t\t\tAPPLICATION SITE ERYTHEMA" 9 (11.84%) 76 + 71 "\t\t\tAPPLICATION SITE ERYTHEMA" 6 ( 7.89%) 76 + 72 "\t\t\tAPPLICATION SITE ERYTHEMA" 0 76 + 73 "\t\t\tAPPLICATION SITE IRRITATION" 1 ( 1.54%) 65 + 74 "\t\t\tAPPLICATION SITE IRRITATION" 2 ( 3.08%) 65 + 75 "\t\t\tAPPLICATION SITE IRRITATION" 0 65 + 76 "\t\t\tAPPLICATION SITE IRRITATION" 3 ( 3.90%) 77 + 77 "\t\t\tAPPLICATION SITE IRRITATION" 3 ( 3.90%) 77 + 78 "\t\t\tAPPLICATION SITE IRRITATION" 3 ( 3.90%) 77 + 79 "\t\t\tAPPLICATION SITE IRRITATION" 3 ( 3.95%) 76 + 80 "\t\t\tAPPLICATION SITE IRRITATION" 6 ( 7.89%) 76 + 81 "\t\t\tAPPLICATION SITE IRRITATION" 0 76 + 82 "\t\t\tAPPLICATION SITE PRURITUS" 5 ( 7.69%) 65 + 83 "\t\t\tAPPLICATION SITE PRURITUS" 1 ( 1.54%) 65 + 84 "\t\t\tAPPLICATION SITE PRURITUS" 0 65 + 85 "\t\t\tAPPLICATION SITE PRURITUS" 13 (16.88%) 77 + 86 "\t\t\tAPPLICATION SITE PRURITUS" 8 (10.39%) 77 + 87 "\t\t\tAPPLICATION SITE PRURITUS" 1 ( 1.30%) 77 + 88 "\t\t\tAPPLICATION SITE PRURITUS" 10 (13.16%) 76 + 89 "\t\t\tAPPLICATION SITE PRURITUS" 12 (15.79%) 76 + 90 "\t\t\tAPPLICATION SITE PRURITUS" 0 76 + 91 "\t\t\tDIZZINESS" 2 ( 3.08%) 65 + 92 "\t\t\tDIZZINESS" 0 65 + 93 "\t\t\tDIZZINESS" 0 65 + 94 "\t\t\tDIZZINESS" 5 ( 6.49%) 77 + 95 "\t\t\tDIZZINESS" 3 ( 3.90%) 77 + 96 "\t\t\tDIZZINESS" 0 77 + 97 "\t\t\tDIZZINESS" 7 ( 9.21%) 76 + 98 "\t\t\tDIZZINESS" 3 ( 3.95%) 76 + 99 "\t\t\tDIZZINESS" 1 ( 1.32%) 76 + 100 "\t\t\tERYTHEMA" 4 ( 6.15%) 65 + 101 "\t\t\tERYTHEMA" 4 ( 6.15%) 65 + 102 "\t\t\tERYTHEMA" 0 65 + 103 "\t\t\tERYTHEMA" 6 ( 7.79%) 77 + 104 "\t\t\tERYTHEMA" 8 (10.39%) 77 + 105 "\t\t\tERYTHEMA" 0 77 + 106 "\t\t\tERYTHEMA" 10 (13.16%) 76 + 107 "\t\t\tERYTHEMA" 4 ( 5.26%) 76 + 108 "\t\t\tERYTHEMA" 0 76 + 109 "\t\t\tHYPERHIDROSIS" 2 ( 3.08%) 65 + 110 "\t\t\tHYPERHIDROSIS" 0 65 + 111 "\t\t\tHYPERHIDROSIS" 0 65 + 112 "\t\t\tHYPERHIDROSIS" 1 ( 1.30%) 77 + 113 "\t\t\tHYPERHIDROSIS" 3 ( 3.90%) 77 + 114 "\t\t\tHYPERHIDROSIS" 0 77 + 115 "\t\t\tHYPERHIDROSIS" 8 (10.53%) 76 + 116 "\t\t\tHYPERHIDROSIS" 0 76 + 117 "\t\t\tHYPERHIDROSIS" 0 76 + 118 "\t\t\tPRURITUS" 7 (10.77%) 65 + 119 "\t\t\tPRURITUS" 1 ( 1.54%) 65 + 120 "\t\t\tPRURITUS" 0 65 + 121 "\t\t\tPRURITUS" 9 (11.69%) 77 + 122 "\t\t\tPRURITUS" 11 (14.29%) 77 + 123 "\t\t\tPRURITUS" 1 ( 1.30%) 77 + 124 "\t\t\tPRURITUS" 17 (22.37%) 76 + 125 "\t\t\tPRURITUS" 9 (11.84%) 76 + 126 "\t\t\tPRURITUS" 0 76 + 127 "\t\t\tRASH" 2 ( 3.08%) 65 + 128 "\t\t\tRASH" 3 ( 4.62%) 65 + 129 "\t\t\tRASH" 0 65 + 130 "\t\t\tRASH" 9 (11.69%) 77 + 131 "\t\t\tRASH" 3 ( 3.90%) 77 + 132 "\t\t\tRASH" 1 ( 1.30%) 77 + 133 "\t\t\tRASH" 5 ( 6.58%) 76 + 134 "\t\t\tRASH" 3 ( 3.95%) 76 + 135 "\t\t\tRASH" 1 ( 1.32%) 76 + 136 "Any Adverse Event" 21 (39.62%) 53 + 137 "Any Adverse Event" 8 (15.09%) 53 + 138 "Any Adverse Event" 0 53 + 139 "Any Adverse Event" 16 (21.62%) 74 + 140 "Any Adverse Event" 24 (32.43%) 74 + 141 "Any Adverse Event" 6 ( 8.11%) 74 + 142 "Any Adverse Event" 19 (26.03%) 73 + 143 "Any Adverse Event" 32 (43.84%) 73 + 144 "Any Adverse Event" 2 ( 2.74%) 73 + 145 "Total preferred term events" 36 NA + 146 "Total preferred term events" 12 NA + 147 "Total preferred term events" 60 NA + 148 "Total preferred term events" 46 NA + 149 "Total preferred term events" 8 NA + 150 "Total preferred term events" 75 NA + 151 "Total preferred term events" 49 NA + 152 "Total preferred term events" 2 NA + 153 "Total preferred term events" 0 NA + FREQ SUBGRPVAR1N PCT CPCT + + 1 8 1 15.1 "15.09" + 2 2 2 3.77 " 3.77" + 3 2 3 3.77 " 3.77" + 4 8 1 10.8 "10.81" + 5 5 2 6.76 " 6.76" + 6 0 3 0 " 0.00" + 7 9 1 12.3 "12.33" + 8 5 2 6.85 " 6.85" + 9 1 3 1.37 " 1.37" + 10 15 1 28.3 "28.30" + 11 2 2 3.77 " 3.77" + 12 0 3 0 " 0.00" + 13 10 1 13.5 "13.51" + 14 4 2 5.41 " 5.41" + 15 0 3 0 " 0.00" + 16 14 1 19.2 "19.18" + 17 4 2 5.48 " 5.48" + 18 2 3 2.74 " 2.74" + 19 16 1 30.2 "30.19" + 20 5 2 9.43 " 9.43" + 21 0 3 0 " 0.00" + 22 19 1 25.7 "25.68" + 23 21 2 28.4 "28.38" + 24 7 3 9.46 " 9.46" + 25 19 1 26.0 "26.03" + 26 21 2 28.8 "28.77" + 27 0 3 0 " 0.00" + 28 6 1 11.3 "11.32" + 29 2 2 3.77 " 3.77" + 30 0 3 0 " 0.00" + 31 10 1 13.5 "13.51" + 32 7 2 9.46 " 9.46" + 33 3 3 4.05 " 4.05" + 34 13 1 17.8 "17.81" + 35 8 2 11.0 "10.96" + 36 4 3 5.48 " 5.48" + 37 12 1 22.6 "22.64" + 38 8 2 15.1 "15.09" + 39 0 3 0 " 0.00" + 40 12 1 16.2 "16.22" + 41 23 2 31.1 "31.08" + 42 4 3 5.41 " 5.41" + 43 24 1 32.9 "32.88" + 44 15 2 20.5 "20.55" + 45 1 3 1.37 " 1.37" + 46 1 1 1.54 " 1.54" + 47 1 2 1.54 " 1.54" + 48 0 3 0 " 0.00" + 49 6 1 7.79 " 7.79" + 50 1 2 1.30 " 1.30" + 51 0 3 0 " 0.00" + 52 4 1 5.26 " 5.26" + 53 4 2 5.26 " 5.26" + 54 0 3 0 " 0.00" + 55 9 1 13.8 "13.85" + 56 0 2 0 " 0.00" + 57 0 3 0 " 0.00" + 58 4 1 5.19 " 5.19" + 59 0 2 0 " 0.00" + 60 0 3 0 " 0.00" + 61 2 1 2.63 " 2.63" + 62 2 2 2.63 " 2.63" + 63 0 3 0 " 0.00" + 64 3 1 4.62 " 4.62" + 65 0 2 0 " 0.00" + 66 0 3 0 " 0.00" + 67 4 1 5.19 " 5.19" + 68 6 2 7.79 " 7.79" + 69 2 3 2.60 " 2.60" + 70 9 1 11.8 "11.84" + 71 6 2 7.89 " 7.89" + 72 0 3 0 " 0.00" + 73 1 1 1.54 " 1.54" + 74 2 2 3.08 " 3.08" + 75 0 3 0 " 0.00" + 76 3 1 3.90 " 3.90" + 77 3 2 3.90 " 3.90" + 78 3 3 3.90 " 3.90" + 79 3 1 3.95 " 3.95" + 80 6 2 7.89 " 7.89" + 81 0 3 0 " 0.00" + 82 5 1 7.69 " 7.69" + 83 1 2 1.54 " 1.54" + 84 0 3 0 " 0.00" + 85 13 1 16.9 "16.88" + 86 8 2 10.4 "10.39" + 87 1 3 1.30 " 1.30" + 88 10 1 13.2 "13.16" + 89 12 2 15.8 "15.79" + 90 0 3 0 " 0.00" + 91 2 1 3.08 " 3.08" + 92 0 2 0 " 0.00" + 93 0 3 0 " 0.00" + 94 5 1 6.49 " 6.49" + 95 3 2 3.90 " 3.90" + 96 0 3 0 " 0.00" + 97 7 1 9.21 " 9.21" + 98 3 2 3.95 " 3.95" + 99 1 3 1.32 " 1.32" + 100 4 1 6.15 " 6.15" + 101 4 2 6.15 " 6.15" + 102 0 3 0 " 0.00" + 103 6 1 7.79 " 7.79" + 104 8 2 10.4 "10.39" + 105 0 3 0 " 0.00" + 106 10 1 13.2 "13.16" + 107 4 2 5.26 " 5.26" + 108 0 3 0 " 0.00" + 109 2 1 3.08 " 3.08" + 110 0 2 0 " 0.00" + 111 0 3 0 " 0.00" + 112 1 1 1.30 " 1.30" + 113 3 2 3.90 " 3.90" + 114 0 3 0 " 0.00" + 115 8 1 10.5 "10.53" + 116 0 2 0 " 0.00" + 117 0 3 0 " 0.00" + 118 7 1 10.8 "10.77" + 119 1 2 1.54 " 1.54" + 120 0 3 0 " 0.00" + 121 9 1 11.7 "11.69" + 122 11 2 14.3 "14.29" + 123 1 3 1.30 " 1.30" + 124 17 1 22.4 "22.37" + 125 9 2 11.8 "11.84" + 126 0 3 0 " 0.00" + 127 2 1 3.08 " 3.08" + 128 3 2 4.62 " 4.62" + 129 0 3 0 " 0.00" + 130 9 1 11.7 "11.69" + 131 3 2 3.90 " 3.90" + 132 1 3 1.30 " 1.30" + 133 5 1 6.58 " 6.58" + 134 3 2 3.95 " 3.95" + 135 1 3 1.32 " 1.32" + 136 21 1 39.6 "39.62" + 137 8 2 15.1 "15.09" + 138 0 3 0 " 0.00" + 139 16 1 21.6 "21.62" + 140 24 2 32.4 "32.43" + 141 6 3 8.11 " 8.11" + 142 19 1 26.0 "26.03" + 143 32 2 43.8 "43.84" + 144 2 3 2.74 " 2.74" + 145 36 1 NA + 146 12 2 NA + 147 60 1 NA + 148 46 2 NA + 149 8 3 NA + 150 75 1 NA + 151 49 2 NA + 152 2 3 NA + 153 0 3 NA + XVAR CN DPTVARN DPTVALN + + 1 CARDIAC DISORDERS C 1 0 + 2 CARDIAC DISORDERS C 1 0 + 3 CARDIAC DISORDERS C 1 0 + 4 CARDIAC DISORDERS C 1 0 + 5 CARDIAC DISORDERS C 1 0 + 6 CARDIAC DISORDERS C 1 0 + 7 CARDIAC DISORDERS C 1 0 + 8 CARDIAC DISORDERS C 1 0 + 9 CARDIAC DISORDERS C 1 0 + 10 GASTROINTESTINAL DISORDERS C 2 0 + 11 GASTROINTESTINAL DISORDERS C 2 0 + 12 GASTROINTESTINAL DISORDERS C 2 0 + 13 GASTROINTESTINAL DISORDERS C 2 0 + 14 GASTROINTESTINAL DISORDERS C 2 0 + 15 GASTROINTESTINAL DISORDERS C 2 0 + 16 GASTROINTESTINAL DISORDERS C 2 0 + 17 GASTROINTESTINAL DISORDERS C 2 0 + 18 GASTROINTESTINAL DISORDERS C 2 0 + 19 GENERAL DISORDERS AND ADMINISTRATION SITE CONDITIONS C 3 0 + 20 GENERAL DISORDERS AND ADMINISTRATION SITE CONDITIONS C 3 0 + 21 GENERAL DISORDERS AND ADMINISTRATION SITE CONDITIONS C 3 0 + 22 GENERAL DISORDERS AND ADMINISTRATION SITE CONDITIONS C 3 0 + 23 GENERAL DISORDERS AND ADMINISTRATION SITE CONDITIONS C 3 0 + 24 GENERAL DISORDERS AND ADMINISTRATION SITE CONDITIONS C 3 0 + 25 GENERAL DISORDERS AND ADMINISTRATION SITE CONDITIONS C 3 0 + 26 GENERAL DISORDERS AND ADMINISTRATION SITE CONDITIONS C 3 0 + 27 GENERAL DISORDERS AND ADMINISTRATION SITE CONDITIONS C 3 0 + 28 NERVOUS SYSTEM DISORDERS C 4 0 + 29 NERVOUS SYSTEM DISORDERS C 4 0 + 30 NERVOUS SYSTEM DISORDERS C 4 0 + 31 NERVOUS SYSTEM DISORDERS C 4 0 + 32 NERVOUS SYSTEM DISORDERS C 4 0 + 33 NERVOUS SYSTEM DISORDERS C 4 0 + 34 NERVOUS SYSTEM DISORDERS C 4 0 + 35 NERVOUS SYSTEM DISORDERS C 4 0 + 36 NERVOUS SYSTEM DISORDERS C 4 0 + 37 SKIN AND SUBCUTANEOUS TISSUE DISORDERS C 5 0 + 38 SKIN AND SUBCUTANEOUS TISSUE DISORDERS C 5 0 + 39 SKIN AND SUBCUTANEOUS TISSUE DISORDERS C 5 0 + 40 SKIN AND SUBCUTANEOUS TISSUE DISORDERS C 5 0 + 41 SKIN AND SUBCUTANEOUS TISSUE DISORDERS C 5 0 + 42 SKIN AND SUBCUTANEOUS TISSUE DISORDERS C 5 0 + 43 SKIN AND SUBCUTANEOUS TISSUE DISORDERS C 5 0 + 44 SKIN AND SUBCUTANEOUS TISSUE DISORDERS C 5 0 + 45 SKIN AND SUBCUTANEOUS TISSUE DISORDERS C 5 0 + 46 SINUS BRADYCARDIA C 1 1 + 47 SINUS BRADYCARDIA C 1 1 + 48 SINUS BRADYCARDIA C 1 1 + 49 SINUS BRADYCARDIA C 1 1 + 50 SINUS BRADYCARDIA C 1 1 + 51 SINUS BRADYCARDIA C 1 1 + 52 SINUS BRADYCARDIA C 1 1 + 53 SINUS BRADYCARDIA C 1 1 + 54 SINUS BRADYCARDIA C 1 1 + 55 DIARRHOEA C 2 1 + 56 DIARRHOEA C 2 1 + 57 DIARRHOEA C 2 1 + 58 DIARRHOEA C 2 1 + 59 DIARRHOEA C 2 1 + 60 DIARRHOEA C 2 1 + 61 DIARRHOEA C 2 1 + 62 DIARRHOEA C 2 1 + 63 DIARRHOEA C 2 1 + 64 APPLICATION SITE ERYTHEMA C 3 1 + 65 APPLICATION SITE ERYTHEMA C 3 1 + 66 APPLICATION SITE ERYTHEMA C 3 1 + 67 APPLICATION SITE ERYTHEMA C 3 1 + 68 APPLICATION SITE ERYTHEMA C 3 1 + 69 APPLICATION SITE ERYTHEMA C 3 1 + 70 APPLICATION SITE ERYTHEMA C 3 1 + 71 APPLICATION SITE ERYTHEMA C 3 1 + 72 APPLICATION SITE ERYTHEMA C 3 1 + 73 APPLICATION SITE IRRITATION C 3 2 + 74 APPLICATION SITE IRRITATION C 3 2 + 75 APPLICATION SITE IRRITATION C 3 2 + 76 APPLICATION SITE IRRITATION C 3 2 + 77 APPLICATION SITE IRRITATION C 3 2 + 78 APPLICATION SITE IRRITATION C 3 2 + 79 APPLICATION SITE IRRITATION C 3 2 + 80 APPLICATION SITE IRRITATION C 3 2 + 81 APPLICATION SITE IRRITATION C 3 2 + 82 APPLICATION SITE PRURITUS C 3 3 + 83 APPLICATION SITE PRURITUS C 3 3 + 84 APPLICATION SITE PRURITUS C 3 3 + 85 APPLICATION SITE PRURITUS C 3 3 + 86 APPLICATION SITE PRURITUS C 3 3 + 87 APPLICATION SITE PRURITUS C 3 3 + 88 APPLICATION SITE PRURITUS C 3 3 + 89 APPLICATION SITE PRURITUS C 3 3 + 90 APPLICATION SITE PRURITUS C 3 3 + 91 DIZZINESS C 4 1 + 92 DIZZINESS C 4 1 + 93 DIZZINESS C 4 1 + 94 DIZZINESS C 4 1 + 95 DIZZINESS C 4 1 + 96 DIZZINESS C 4 1 + 97 DIZZINESS C 4 1 + 98 DIZZINESS C 4 1 + 99 DIZZINESS C 4 1 + 100 ERYTHEMA C 5 1 + 101 ERYTHEMA C 5 1 + 102 ERYTHEMA C 5 1 + 103 ERYTHEMA C 5 1 + 104 ERYTHEMA C 5 1 + 105 ERYTHEMA C 5 1 + 106 ERYTHEMA C 5 1 + 107 ERYTHEMA C 5 1 + 108 ERYTHEMA C 5 1 + 109 HYPERHIDROSIS C 5 2 + 110 HYPERHIDROSIS C 5 2 + 111 HYPERHIDROSIS C 5 2 + 112 HYPERHIDROSIS C 5 2 + 113 HYPERHIDROSIS C 5 2 + 114 HYPERHIDROSIS C 5 2 + 115 HYPERHIDROSIS C 5 2 + 116 HYPERHIDROSIS C 5 2 + 117 HYPERHIDROSIS C 5 2 + 118 PRURITUS C 5 3 + 119 PRURITUS C 5 3 + 120 PRURITUS C 5 3 + 121 PRURITUS C 5 3 + 122 PRURITUS C 5 3 + 123 PRURITUS C 5 3 + 124 PRURITUS C 5 3 + 125 PRURITUS C 5 3 + 126 PRURITUS C 5 3 + 127 RASH C 5 4 + 128 RASH C 5 4 + 129 RASH C 5 4 + 130 RASH C 5 4 + 131 RASH C 5 4 + 132 RASH C 5 4 + 133 RASH C 5 4 + 134 RASH C 5 4 + 135 RASH C 5 4 + 136 1 C 0 0 + 137 1 C 0 0 + 138 1 C 0 0 + 139 1 C 0 0 + 140 1 C 0 0 + 141 1 C 0 0 + 142 1 C 0 0 + 143 1 C 0 0 + 144 1 C 0 0 + 145 1 C 6 0 + 146 1 C 6 0 + 147 1 C 6 0 + 148 1 C 6 0 + 149 1 C 6 0 + 150 1 C 6 0 + 151 1 C 6 0 + 152 1 C 6 0 + 153 1 C 6 0 + SUBGRPVARX SUBGRPVARXN + + 1 "n " 1 + 2 "n " 1 + 3 "n " 1 + 4 "n " 1 + 5 "n " 1 + 6 "n " 1 + 7 "n " 1 + 8 "n " 1 + 9 "n " 1 + 10 "n " 1 + 11 "n " 1 + 12 "n " 1 + 13 "n " 1 + 14 "n " 1 + 15 "n " 1 + 16 "n " 1 + 17 "n " 1 + 18 "n " 1 + 19 "n " 1 + 20 "n " 1 + 21 "n " 1 + 22 "n " 1 + 23 "n " 1 + 24 "n " 1 + 25 "n " 1 + 26 "n " 1 + 27 "n " 1 + 28 "n " 1 + 29 "n " 1 + 30 "n " 1 + 31 "n " 1 + 32 "n " 1 + 33 "n " 1 + 34 "n " 1 + 35 "n " 1 + 36 "n " 1 + 37 "n " 1 + 38 "n " 1 + 39 "n " 1 + 40 "n " 1 + 41 "n " 1 + 42 "n " 1 + 43 "n " 1 + 44 "n " 1 + 45 "n " 1 + 46 "n " 1 + 47 "n " 1 + 48 "n " 1 + 49 "n " 1 + 50 "n " 1 + 51 "n " 1 + 52 "n " 1 + 53 "n " 1 + 54 "n " 1 + 55 "n " 1 + 56 "n " 1 + 57 "n " 1 + 58 "n " 1 + 59 "n " 1 + 60 "n " 1 + 61 "n " 1 + 62 "n " 1 + 63 "n " 1 + 64 "n " 1 + 65 "n " 1 + 66 "n " 1 + 67 "n " 1 + 68 "n " 1 + 69 "n " 1 + 70 "n " 1 + 71 "n " 1 + 72 "n " 1 + 73 "n " 1 + 74 "n " 1 + 75 "n " 1 + 76 "n " 1 + 77 "n " 1 + 78 "n " 1 + 79 "n " 1 + 80 "n " 1 + 81 "n " 1 + 82 "n " 1 + 83 "n " 1 + 84 "n " 1 + 85 "n " 1 + 86 "n " 1 + 87 "n " 1 + 88 "n " 1 + 89 "n " 1 + 90 "n " 1 + 91 "n " 1 + 92 "n " 1 + 93 "n " 1 + 94 "n " 1 + 95 "n " 1 + 96 "n " 1 + 97 "n " 1 + 98 "n " 1 + 99 "n " 1 + 100 "n " 1 + 101 "n " 1 + 102 "n " 1 + 103 "n " 1 + 104 "n " 1 + 105 "n " 1 + 106 "n " 1 + 107 "n " 1 + 108 "n " 1 + 109 "n " 1 + 110 "n " 1 + 111 "n " 1 + 112 "n " 1 + 113 "n " 1 + 114 "n " 1 + 115 "n " 1 + 116 "n " 1 + 117 "n " 1 + 118 "n " 1 + 119 "n " 1 + 120 "n " 1 + 121 "n " 1 + 122 "n " 1 + 123 "n " 1 + 124 "n " 1 + 125 "n " 1 + 126 "n " 1 + 127 "n " 1 + 128 "n " 1 + 129 "n " 1 + 130 "n " 1 + 131 "n " 1 + 132 "n " 1 + 133 "n " 1 + 134 "n " 1 + 135 "n " 1 + 136 "n " 1 + 137 "n " 1 + 138 "n " 1 + 139 "n " 1 + 140 "n " 1 + 141 "n " 1 + 142 "n " 1 + 143 "n " 1 + 144 "n " 1 + 145 "n " 1 + 146 "n " 1 + 147 "n " 1 + 148 "n " 1 + 149 "n " 1 + 150 "n " 1 + 151 "n " 1 + 152 "n " 1 + 153 "n " 1 diff --git a/tests/testthat/_snaps/ptly_utils.md b/tests/testthat/_snaps/ptly_utils.md new file mode 100644 index 0000000..3bdbc04 --- /dev/null +++ b/tests/testthat/_snaps/ptly_utils.md @@ -0,0 +1,108 @@ +# Test Case 1: plotly_legend works + + Code + fig1$x$layoutAttrs[[1]] + Output + $annotations + $annotations$text + [1] "Age Group" + + $annotations$xref + [1] "paper" + + $annotations$yref + [1] "paper" + + $annotations$x + [1] 0.3 + + $annotations$xanchor + [1] "right" + + $annotations$y + [1] -0.2 + + $annotations$yanchor + [1] "top" + + $annotations$legendtitle + [1] TRUE + + $annotations$showarrow + [1] FALSE + + $annotations$font + $annotations$font$size + [1] 10 + + + + +--- + + Code + fig1$x$layoutAttrs[[2]] + Output + $showlegend + [1] TRUE + + $legend + $legend$orientation + [1] "h" + + $legend$x + [1] 0.3 + + $legend$y + [1] -0.2 + + $legend$size + [1] 8 + + $legend$xanchor + [1] "left" + + $legend$yanchor + [1] "top" + + $legend$font + $legend$font$size + [1] 8 + + + + +--- + + Code + fig2$x$layoutAttrs[[1]] + Output + $showlegend + [1] TRUE + + $legend + $legend$orientation + [1] "v" + + $legend$x + [1] 0.2 + + $legend$y + [1] 0.1 + + $legend$size + [1] 8 + + $legend$xanchor + [1] "center" + + $legend$yanchor + [1] "top" + + $legend$font + $legend$font$size + [1] 8 + + + + diff --git a/tests/testthat/_snaps/scatter_plot.md b/tests/testthat/_snaps/scatter_plot.md new file mode 100644 index 0000000..53d239b --- /dev/null +++ b/tests/testthat/_snaps/scatter_plot.md @@ -0,0 +1,275 @@ +# scatter_plot works as expected + + Code + print(tibble::as_tibble(fig[["data"]]), n = Inf) + Output + # A tibble: 254 x 7 + USUBJID TRTVAR ALT BILI XVAR YVAR .group + + 1 01-701-1015 Placebo 41 10.3 41 10.3 1 + 2 01-701-1023 Placebo 38 12.0 38 12.0 2 + 3 01-701-1028 Xanomeline High Dose 33 18.8 33 18.8 3 + 4 01-701-1033 Xanomeline Low Dose 35 15.4 35 15.4 4 + 5 01-701-1034 Xanomeline High Dose 24 10.3 24 10.3 5 + 6 01-701-1047 Placebo 22 8.55 22 8.55 6 + 7 01-701-1097 Xanomeline Low Dose 24 10.3 24 10.3 7 + 8 01-701-1111 Xanomeline Low Dose 23 8.55 23 8.55 8 + 9 01-701-1115 Xanomeline Low Dose 18 8.55 18 8.55 9 + 10 01-701-1118 Placebo 16 12.0 16 12.0 10 + 11 01-701-1130 Placebo 18 12.0 18 12.0 11 + 12 01-701-1133 Xanomeline High Dose 23 15.4 23 15.4 12 + 13 01-701-1146 Xanomeline High Dose 16 10.3 16 10.3 13 + 14 01-701-1148 Xanomeline High Dose 41 12.0 41 12.0 14 + 15 01-701-1153 Placebo 17 8.55 17 8.55 15 + 16 01-701-1180 Xanomeline High Dose 29 12.0 29 12.0 16 + 17 01-701-1181 Xanomeline High Dose 18 8.55 18 8.55 17 + 18 01-701-1188 Xanomeline Low Dose 29 8.55 29 8.55 18 + 19 01-701-1192 Xanomeline Low Dose 19 12.0 19 12.0 19 + 20 01-701-1203 Placebo 16 8.55 16 8.55 20 + 21 01-701-1211 Xanomeline Low Dose 21 25.6 21 25.6 21 + 22 01-701-1234 Placebo 40 20.5 40 20.5 22 + 23 01-701-1239 Xanomeline High Dose 71 39.3 71 39.3 23 + 24 01-701-1275 Xanomeline High Dose 22 10.3 22 10.3 24 + 25 01-701-1287 Xanomeline High Dose 27 18.8 27 18.8 25 + 26 01-701-1294 Xanomeline Low Dose 29 10.3 29 10.3 26 + 27 01-701-1302 Xanomeline High Dose 62 10.3 62 10.3 27 + 28 01-701-1317 Xanomeline Low Dose 14 32.5 14 32.5 28 + 29 01-701-1324 Xanomeline Low Dose 15 8.55 15 8.55 29 + 30 01-701-1341 Xanomeline Low Dose 58 8.55 58 8.55 30 + 31 01-701-1345 Placebo 25 8.55 25 8.55 31 + 32 01-701-1360 Xanomeline High Dose 19 17.1 19 17.1 32 + 33 01-701-1363 Placebo 14 NA 14 NA 33 + 34 01-701-1383 Xanomeline High Dose 19 10.3 19 10.3 34 + 35 01-701-1387 Placebo 12 6.84 12 6.84 35 + 36 01-701-1392 Placebo 23 10.3 23 10.3 36 + 37 01-701-1415 Placebo 16 13.7 16 13.7 37 + 38 01-701-1429 Xanomeline Low Dose 28 13.7 28 13.7 38 + 39 01-701-1440 Placebo 26 8.55 26 8.55 39 + 40 01-701-1442 Xanomeline Low Dose 33 8.55 33 8.55 40 + 41 01-701-1444 Xanomeline High Dose 23 17.1 23 17.1 41 + 42 01-702-1082 Xanomeline Low Dose 37 10.3 37 10.3 42 + 43 01-703-1042 Placebo 31 17.1 31 17.1 43 + 44 01-703-1076 Xanomeline High Dose 27 10.3 27 10.3 44 + 45 01-703-1086 Xanomeline Low Dose 29 15.4 29 15.4 45 + 46 01-703-1096 Placebo 12 8.55 12 8.55 46 + 47 01-703-1100 Placebo 18 13.7 18 13.7 47 + 48 01-703-1119 Xanomeline Low Dose 44 8.55 44 8.55 48 + 49 01-703-1175 Placebo 19 13.7 19 13.7 49 + 50 01-703-1182 Xanomeline Low Dose 19 17.1 19 17.1 50 + 51 01-703-1197 Xanomeline Low Dose 18 10.3 18 10.3 51 + 52 01-703-1210 Placebo 18 12.0 18 12.0 52 + 53 01-703-1258 Xanomeline High Dose 43 12.0 43 12.0 53 + 54 01-703-1279 Xanomeline Low Dose 11 6.84 11 6.84 54 + 55 01-703-1295 Xanomeline High Dose 21 10.3 21 10.3 55 + 56 01-703-1299 Placebo 13 8.55 13 8.55 56 + 57 01-703-1335 Xanomeline High Dose 25 8.55 25 8.55 57 + 58 01-703-1379 Xanomeline Low Dose 24 8.55 24 8.55 58 + 59 01-703-1403 Xanomeline High Dose 40 12.0 40 12.0 59 + 60 01-703-1439 Xanomeline High Dose 27 15.4 27 15.4 60 + 61 01-704-1008 Xanomeline High Dose 25 22.2 25 22.2 61 + 62 01-704-1009 Xanomeline Low Dose 39 12.0 39 12.0 62 + 63 01-704-1010 Placebo 14 22.2 14 22.2 63 + 64 01-704-1017 Xanomeline High Dose 11 13.7 11 13.7 64 + 65 01-704-1025 Xanomeline Low Dose 23 10.3 23 10.3 65 + 66 01-704-1065 Xanomeline High Dose 20 10.3 20 10.3 66 + 67 01-704-1074 Xanomeline High Dose 14 10.3 14 10.3 67 + 68 01-704-1093 Xanomeline High Dose 26 17.1 26 17.1 68 + 69 01-704-1114 Xanomeline Low Dose 21 13.7 21 13.7 69 + 70 01-704-1120 Xanomeline Low Dose 33 18.8 33 18.8 70 + 71 01-704-1127 Placebo 26 12.0 26 12.0 71 + 72 01-704-1135 Xanomeline Low Dose 19 17.1 19 17.1 72 + 73 01-704-1164 Placebo 13 13.7 13 13.7 73 + 74 01-704-1218 Xanomeline Low Dose 23 20.5 23 20.5 74 + 75 01-704-1233 Placebo 16 10.3 16 10.3 75 + 76 01-704-1241 Xanomeline High Dose 23 12.0 23 12.0 76 + 77 01-704-1260 Placebo 22 12.0 22 12.0 77 + 78 01-704-1266 Xanomeline High Dose 21 13.7 21 13.7 78 + 79 01-704-1323 Xanomeline Low Dose 16 NA 16 NA 79 + 80 01-704-1325 Xanomeline Low Dose 17 20.5 17 20.5 80 + 81 01-704-1332 Xanomeline High Dose 16 29.1 16 29.1 81 + 82 01-704-1351 Placebo 21 15.4 21 15.4 82 + 83 01-704-1388 Placebo 36 15.4 36 15.4 83 + 84 01-704-1435 Placebo 14 10.3 14 10.3 84 + 85 01-704-1445 Placebo 48 12.0 48 12.0 85 + 86 01-705-1018 Placebo 12 6.84 12 6.84 86 + 87 01-705-1031 Xanomeline Low Dose 28 NA 28 NA 87 + 88 01-705-1059 Placebo 32 12.0 32 12.0 88 + 89 01-705-1186 Placebo 107 125. 107 125. 89 + 90 01-705-1199 Xanomeline Low Dose 15 10.3 15 10.3 90 + 91 01-705-1280 Xanomeline High Dose 21 10.3 21 10.3 91 + 92 01-705-1281 Xanomeline High Dose 18 12.0 18 12.0 92 + 93 01-705-1282 Placebo 32 6.84 32 6.84 93 + 94 01-705-1292 Xanomeline Low Dose 88 12.0 88 12.0 94 + 95 01-705-1303 Xanomeline High Dose 22 20.5 22 20.5 95 + 96 01-705-1310 Xanomeline High Dose 129 17.1 129 17.1 96 + 97 01-705-1349 Placebo 39 27.4 39 27.4 97 + 98 01-705-1377 Xanomeline High Dose 20 6.84 20 6.84 98 + 99 01-705-1382 Xanomeline High Dose 13 12.0 13 12.0 99 + 100 01-705-1393 Xanomeline Low Dose 12 NA 12 NA 100 + 101 01-705-1431 Xanomeline Low Dose 21 8.55 21 8.55 101 + 102 01-706-1041 Placebo 24 8.55 24 8.55 102 + 103 01-706-1049 Xanomeline High Dose 24 8.55 24 8.55 103 + 104 01-706-1384 Xanomeline Low Dose 18 8.55 18 8.55 104 + 105 01-707-1037 Xanomeline Low Dose 7 8.55 7 8.55 105 + 106 01-707-1206 Placebo 28 10.3 28 10.3 106 + 107 01-708-1019 Xanomeline Low Dose 15 6.84 15 6.84 107 + 108 01-708-1032 Xanomeline Low Dose 28 22.2 28 22.2 108 + 109 01-708-1084 Xanomeline Low Dose 13 8.55 13 8.55 109 + 110 01-708-1087 Placebo 14 12.0 14 12.0 110 + 111 01-708-1158 Placebo 19 6.84 19 6.84 111 + 112 01-708-1171 Placebo 18 8.55 18 8.55 112 + 113 01-708-1178 Xanomeline High Dose 17 10.3 17 10.3 113 + 114 01-708-1213 Xanomeline High Dose 16 12.0 16 12.0 114 + 115 01-708-1216 Xanomeline High Dose 28 20.5 28 20.5 115 + 116 01-708-1236 Xanomeline High Dose 16 12.0 16 12.0 116 + 117 01-708-1253 Placebo 25 12.0 25 12.0 117 + 118 01-708-1272 Xanomeline Low Dose 29 17.1 29 17.1 118 + 119 01-708-1286 Placebo 124 8.55 124 8.55 119 + 120 01-708-1296 Placebo 22 10.3 22 10.3 120 + 121 01-708-1297 Xanomeline Low Dose 24 15.4 24 15.4 121 + 122 01-708-1316 Placebo 18 12.0 18 12.0 122 + 123 01-708-1336 Xanomeline High Dose 18 13.7 18 13.7 123 + 124 01-708-1342 Placebo 28 13.7 28 13.7 124 + 125 01-708-1347 Xanomeline High Dose 23 8.55 23 8.55 125 + 126 01-708-1348 Xanomeline Low Dose 15 8.55 15 8.55 126 + 127 01-708-1353 Xanomeline Low Dose 15 8.55 15 8.55 127 + 128 01-708-1372 Xanomeline High Dose 14 8.55 14 8.55 128 + 129 01-708-1378 Placebo 18 25.6 18 25.6 129 + 130 01-708-1406 Xanomeline High Dose 20 27.4 20 27.4 130 + 131 01-708-1428 Xanomeline Low Dose 14 8.55 14 8.55 131 + 132 01-709-1001 Placebo 32 10.3 32 10.3 132 + 133 01-709-1007 Xanomeline Low Dose 21 8.55 21 8.55 133 + 134 01-709-1020 Xanomeline Low Dose 13 18.8 13 18.8 134 + 135 01-709-1029 Xanomeline High Dose 18 53.0 18 53.0 135 + 136 01-709-1081 Xanomeline Low Dose 19 8.55 19 8.55 136 + 137 01-709-1088 Placebo 20 13.7 20 13.7 137 + 138 01-709-1099 Xanomeline High Dose 29 12.0 29 12.0 138 + 139 01-709-1102 Xanomeline Low Dose 88 12.0 88 12.0 139 + 140 01-709-1168 Xanomeline High Dose 18 10.3 18 10.3 140 + 141 01-709-1217 Xanomeline Low Dose 23 8.55 23 8.55 141 + 142 01-709-1238 Xanomeline High Dose 32 12.0 32 12.0 142 + 143 01-709-1259 Placebo 21 15.4 21 15.4 143 + 144 01-709-1285 Xanomeline Low Dose 17 15.4 17 15.4 144 + 145 01-709-1301 Placebo 69 10.3 69 10.3 145 + 146 01-709-1306 Placebo 13 10.3 13 10.3 146 + 147 01-709-1309 Xanomeline High Dose 42 35.9 42 35.9 147 + 148 01-709-1312 Placebo 20 27.4 20 27.4 148 + 149 01-709-1326 Xanomeline Low Dose 26 6.84 26 6.84 149 + 150 01-709-1329 Xanomeline High Dose 41 6.84 41 6.84 150 + 151 01-709-1339 Placebo 31 12.0 31 12.0 151 + 152 01-709-1424 Xanomeline High Dose 18 6.84 18 6.84 152 + 153 01-710-1002 Xanomeline Low Dose 17 12.0 17 12.0 153 + 154 01-710-1006 Xanomeline High Dose 18 12.0 18 12.0 154 + 155 01-710-1021 Xanomeline High Dose 28 10.3 28 10.3 155 + 156 01-710-1027 Placebo 16 17.1 16 17.1 156 + 157 01-710-1045 Xanomeline Low Dose 15 10.3 15 10.3 157 + 158 01-710-1053 Xanomeline Low Dose 22 12.0 22 12.0 158 + 159 01-710-1060 Placebo 32 12.0 32 12.0 159 + 160 01-710-1070 Xanomeline High Dose 14 13.7 14 13.7 160 + 161 01-710-1077 Placebo 19 12.0 19 12.0 161 + 162 01-710-1078 Placebo 22 10.3 22 10.3 162 + 163 01-710-1083 Placebo 12 8.55 12 8.55 163 + 164 01-710-1137 Xanomeline High Dose 17 10.3 17 10.3 164 + 165 01-710-1142 Xanomeline High Dose 26 6.84 26 6.84 165 + 166 01-710-1154 Xanomeline Low Dose 22 27.4 22 27.4 166 + 167 01-710-1166 Xanomeline Low Dose 23 12.0 23 12.0 167 + 168 01-710-1183 Placebo 8 15.4 8 15.4 168 + 169 01-710-1187 Xanomeline High Dose 16 13.7 16 13.7 169 + 170 01-710-1235 Xanomeline Low Dose 27 10.3 27 10.3 170 + 171 01-710-1249 Xanomeline High Dose 14 8.55 14 8.55 171 + 172 01-710-1264 Placebo 16 13.7 16 13.7 172 + 173 01-710-1270 Xanomeline Low Dose 24 12.0 24 12.0 173 + 174 01-710-1271 Placebo 13 10.3 13 10.3 174 + 175 01-710-1278 Xanomeline High Dose 20 15.4 20 15.4 175 + 176 01-710-1300 Xanomeline Low Dose 21 12.0 21 12.0 176 + 177 01-710-1314 Placebo 14 10.3 14 10.3 177 + 178 01-710-1315 Placebo 19 10.3 19 10.3 178 + 179 01-710-1354 Xanomeline High Dose 38 12.0 38 12.0 179 + 180 01-710-1358 Xanomeline Low Dose 20 8.55 20 8.55 180 + 181 01-710-1368 Placebo 23 15.4 23 15.4 181 + 182 01-710-1385 Xanomeline Low Dose 43 8.55 43 8.55 182 + 183 01-710-1408 Xanomeline High Dose 44 10.3 44 10.3 183 + 184 01-711-1012 Xanomeline High Dose 17 8.55 17 8.55 184 + 185 01-711-1036 Placebo 25 NA 25 NA 185 + 186 01-711-1143 Xanomeline Low Dose 21 15.4 21 15.4 186 + 187 01-711-1433 Xanomeline High Dose 13 8.55 13 8.55 187 + 188 01-713-1043 Xanomeline Low Dose 19 13.7 19 13.7 188 + 189 01-713-1073 Xanomeline Low Dose 20 10.3 20 10.3 189 + 190 01-713-1106 Xanomeline High Dose 37 12.0 37 12.0 190 + 191 01-713-1141 Xanomeline High Dose 28 12.0 28 12.0 191 + 192 01-713-1179 Placebo 29 8.55 29 8.55 192 + 193 01-713-1209 Xanomeline High Dose 21 6.84 21 6.84 193 + 194 01-713-1256 Placebo 15 8.55 15 8.55 194 + 195 01-713-1269 Placebo 19 12.0 19 12.0 195 + 196 01-713-1448 Xanomeline Low Dose 22 10.3 22 10.3 196 + 197 01-714-1035 Placebo 37 18.8 37 18.8 197 + 198 01-714-1068 Xanomeline Low Dose 21 6.84 21 6.84 198 + 199 01-714-1195 Xanomeline Low Dose 39 18.8 39 18.8 199 + 200 01-714-1288 Xanomeline High Dose 24 12.0 24 12.0 200 + 201 01-714-1375 Placebo 19 10.3 19 10.3 201 + 202 01-714-1425 Xanomeline High Dose 22 12.0 22 12.0 202 + 203 01-715-1085 Xanomeline Low Dose 19 13.7 19 13.7 203 + 204 01-715-1107 Xanomeline Low Dose 39 8.55 39 8.55 204 + 205 01-715-1155 Placebo 13 6.84 13 6.84 205 + 206 01-715-1207 Placebo 14 10.3 14 10.3 206 + 207 01-715-1319 Xanomeline High Dose 15 10.3 15 10.3 207 + 208 01-715-1321 Xanomeline High Dose 29 8.55 29 8.55 208 + 209 01-715-1397 Placebo 16 8.55 16 8.55 209 + 210 01-715-1405 Xanomeline Low Dose 20 6.84 20 6.84 210 + 211 01-716-1024 Placebo 17 15.4 17 15.4 211 + 212 01-716-1026 Placebo 21 6.84 21 6.84 212 + 213 01-716-1030 Xanomeline High Dose 17 12.0 17 12.0 213 + 214 01-716-1044 Placebo 18 30.8 18 30.8 214 + 215 01-716-1063 Xanomeline Low Dose 22 12.0 22 12.0 215 + 216 01-716-1071 Xanomeline High Dose 21 10.3 21 10.3 216 + 217 01-716-1094 Xanomeline Low Dose 22 15.4 22 15.4 217 + 218 01-716-1103 Xanomeline Low Dose 15 6.84 15 6.84 218 + 219 01-716-1108 Placebo 16 13.7 16 13.7 219 + 220 01-716-1151 Xanomeline Low Dose 40 6.84 40 6.84 220 + 221 01-716-1157 Xanomeline Low Dose 21 8.55 21 8.55 221 + 222 01-716-1160 Placebo 26 10.3 26 10.3 222 + 223 01-716-1167 Xanomeline Low Dose 39 10.3 39 10.3 223 + 224 01-716-1177 Placebo 17 15.4 17 15.4 224 + 225 01-716-1189 Xanomeline High Dose 33 8.55 33 8.55 225 + 226 01-716-1229 Xanomeline High Dose 38 5.13 38 5.13 226 + 227 01-716-1298 Xanomeline Low Dose 15 8.55 15 8.55 227 + 228 01-716-1308 Placebo 14 6.84 14 6.84 228 + 229 01-716-1311 Xanomeline Low Dose 26 18.8 26 18.8 229 + 230 01-716-1364 Xanomeline High Dose 36 15.4 36 15.4 230 + 231 01-716-1373 Xanomeline High Dose 50 12.0 50 12.0 231 + 232 01-716-1418 Xanomeline High Dose 13 13.7 13 13.7 232 + 233 01-716-1441 Placebo 20 18.8 20 18.8 233 + 234 01-716-1447 Xanomeline High Dose 27 8.55 27 8.55 234 + 235 01-717-1004 Xanomeline Low Dose 26 6.84 26 6.84 235 + 236 01-717-1109 Xanomeline High Dose 30 20.5 30 20.5 236 + 237 01-717-1174 Xanomeline High Dose 37 13.7 37 13.7 237 + 238 01-717-1201 Placebo 23 8.55 23 8.55 238 + 239 01-717-1344 Placebo 12 10.3 12 10.3 239 + 240 01-717-1357 Xanomeline High Dose 23 20.5 23 20.5 240 + 241 01-717-1446 Xanomeline Low Dose 41 15.4 41 15.4 241 + 242 01-718-1066 Xanomeline Low Dose 19 6.84 19 6.84 242 + 243 01-718-1079 Xanomeline Low Dose 23 8.55 23 8.55 243 + 244 01-718-1101 Xanomeline High Dose 17 15.4 17 15.4 244 + 245 01-718-1139 Placebo 21 12.0 21 12.0 245 + 246 01-718-1150 Placebo 76 12.0 76 12.0 246 + 247 01-718-1170 Xanomeline Low Dose 17 10.3 17 10.3 247 + 248 01-718-1172 Placebo 18 17.1 18 17.1 248 + 249 01-718-1250 Xanomeline Low Dose 19 6.84 19 6.84 249 + 250 01-718-1254 Xanomeline Low Dose 22 12.0 22 12.0 250 + 251 01-718-1328 Xanomeline High Dose 28 13.7 28 13.7 251 + 252 01-718-1355 Placebo 13 15.4 13 15.4 252 + 253 01-718-1371 Xanomeline High Dose 30 8.55 30 8.55 253 + 254 01-718-1427 Xanomeline High Dose 16 10.3 16 10.3 254 + +--- + + Code + fig[[y]] + Output + Aesthetic mapping: + * `x` -> `.data[["XVAR"]]` + * `y` -> `.data[["YVAR"]]` + * `shape` -> `.data[["TRTVAR"]]` + * `colour` -> `.data[["TRTVAR"]]` + * `size` -> `.data[["TRTVAR"]]` + diff --git a/tests/testthat/_snaps/tbl_display.md b/tests/testthat/_snaps/tbl_display.md new file mode 100644 index 0000000..46c5c32 --- /dev/null +++ b/tests/testthat/_snaps/tbl_display.md @@ -0,0 +1,114 @@ +# tbl_processor works standard + + Code + print(tbl_data, n = Inf, width = Inf) + Output + # A tibble: 26 x 9 + BYVAR1 DPTVAL DPTVARN DPTVALN + + 1 HISPANIC OR LATINO "Age (Years), n (%)" 1 0 + 2 HISPANIC OR LATINO "\t\t<65" 1 1 + 3 HISPANIC OR LATINO "\t\t65-80" 1 2 + 4 HISPANIC OR LATINO "\t\t>80" 1 3 + 5 HISPANIC OR LATINO "NONE" 2 0 + 6 HISPANIC OR LATINO "\t\tn" 2 1 + 7 HISPANIC OR LATINO "\t\tMean (SD)" 2 2 + 8 HISPANIC OR LATINO "Gender, n (%)" 3 0 + 9 HISPANIC OR LATINO "\t\tF" 3 1 + 10 HISPANIC OR LATINO "\t\tM" 3 2 + 11 HISPANIC OR LATINO "Race, n (%)" 4 0 + 12 HISPANIC OR LATINO "\t\tWHITE" 4 1 + 13 NOT HISPANIC OR LATINO "Age (Years), n (%)" 1 0 + 14 NOT HISPANIC OR LATINO "\t\t<65" 1 1 + 15 NOT HISPANIC OR LATINO "\t\t65-80" 1 2 + 16 NOT HISPANIC OR LATINO "\t\t>80" 1 3 + 17 NOT HISPANIC OR LATINO "NONE" 2 0 + 18 NOT HISPANIC OR LATINO "\t\tn" 2 1 + 19 NOT HISPANIC OR LATINO "\t\tMean (SD)" 2 2 + 20 NOT HISPANIC OR LATINO "Gender, n (%)" 3 0 + 21 NOT HISPANIC OR LATINO "\t\tF" 3 1 + 22 NOT HISPANIC OR LATINO "\t\tM" 3 2 + 23 NOT HISPANIC OR LATINO "Race, n (%)" 4 0 + 24 NOT HISPANIC OR LATINO "\t\tWHITE" 4 1 + 25 NOT HISPANIC OR LATINO "\t\tBLACK OR AFRICAN AMERICAN" 4 2 + 26 NOT HISPANIC OR LATINO "\t\tAMERICAN INDIAN OR ALASKA NATIVE" 4 6 + CN `Placebo (N=86)` `Xanomeline Low Dose (N=84)` + + 1 + 2 C 2 ( 2.33%) 2 ( 2.38%) + 3 C 0 2 ( 2.38%) + 4 C 1 ( 1.16%) 2 ( 2.38%) + 5 + 6 N 3 6 + 7 N 71.00 (13.00) 70.67 (12.63) + 8 + 9 C 2 ( 2.33%) 4 ( 4.76%) + 10 C 1 ( 1.16%) 2 ( 2.38%) + 11 + 12 C 3 ( 3.49%) 6 ( 7.14%) + 13 + 14 C 12 (13.95%) 6 ( 7.14%) + 15 C 42 (48.84%) 45 (53.57%) + 16 C 29 (33.72%) 27 (32.14%) + 17 + 18 N 83 78 + 19 N 75.36 (8.47) 76.05 (7.85) + 20 + 21 C 51 (59.30%) 46 (54.76%) + 22 C 32 (37.21%) 32 (38.10%) + 23 + 24 C 75 (87.21%) 72 (85.71%) + 25 C 8 ( 9.30%) 6 ( 7.14%) + 26 C 0 0 + `Xanomeline High Dose (N=84)` `Total (N=254)` + + 1 + 2 3 ( 3.57%) 7 ( 2.76%) + 3 0 2 ( 0.79%) + 4 0 3 ( 1.18%) + 5 + 6 3 12 + 7 58.33 (4.04) 67.67 (11.74) + 8 + 9 1 ( 1.19%) 7 ( 2.76%) + 10 2 ( 2.38%) 5 ( 1.97%) + 11 + 12 3 ( 3.57%) 12 ( 4.72%) + 13 + 14 8 ( 9.52%) 26 (10.24%) + 15 55 (65.48%) 142 (55.91%) + 16 18 (21.43%) 74 (29.13%) + 17 + 18 81 242 + 19 74.98 (7.36) 75.45 (7.89) + 20 + 21 39 (46.43%) 136 (53.54%) + 22 42 (50.00%) 106 (41.73%) + 23 + 24 71 (84.52%) 218 (85.83%) + 25 9 (10.71%) 23 ( 9.06%) + 26 1 ( 1.19%) 1 ( 0.39%) + +# tbl_processor works without trt/dpt + + Code + print(tbl_data1, n = Inf, width = Inf) + Output + # A tibble: 2 x 5 + BYVAR1 DPTVALN DPTVARN CN `Participants, n (%) (N = 254)` + + 1 HISPANIC OR LATINO 1 1 C 12 ( 4.72%) + 2 NOT HISPANIC OR LATINO 1 1 C 242 (95.28%) + +# Empty_tbl works + + Code + tbl_empty + Output + a flextable object. + col_keys: `X` + header has 1 row(s) + body has 1 row(s) + original dataset sample: + [1] "No participant meets the reporting criteria" + diff --git a/tests/testthat/_snaps/tornado_plot.md b/tests/testthat/_snaps/tornado_plot.md new file mode 100644 index 0000000..6bc51c8 --- /dev/null +++ b/tests/testthat/_snaps/tornado_plot.md @@ -0,0 +1,150 @@ +# Test Case 5: tornado_plot creates tornado plot + + Code + plot_out[[y]] + Output + Aesthetic mapping: + * `x` -> `XVAR` + +--- + + Code + plot_out[[y]] + Output + $axis.title.x + List of 11 + $ family : NULL + $ face : chr "plain" + $ colour : NULL + $ size : num 12 + $ hjust : NULL + $ vjust : NULL + $ angle : NULL + $ lineheight : NULL + $ margin : NULL + $ debug : NULL + $ inherit.blank: logi FALSE + - attr(*, "class")= chr [1:2] "element_text" "element" + + $axis.title.y + List of 11 + $ family : NULL + $ face : chr "plain" + $ colour : NULL + $ size : num 12 + $ hjust : NULL + $ vjust : NULL + $ angle : NULL + $ lineheight : NULL + $ margin : NULL + $ debug : NULL + $ inherit.blank: logi FALSE + - attr(*, "class")= chr [1:2] "element_text" "element" + + $axis.text.x + List of 11 + $ family : NULL + $ face : chr "plain" + $ colour : NULL + $ size : num 8 + $ hjust : NULL + $ vjust : NULL + $ angle : num 0 + $ lineheight : NULL + $ margin : NULL + $ debug : NULL + $ inherit.blank: logi FALSE + - attr(*, "class")= chr [1:2] "element_text" "element" + + $axis.text.y + List of 11 + $ family : NULL + $ face : chr "plain" + $ colour : NULL + $ size : num 8 + $ hjust : NULL + $ vjust : NULL + $ angle : num 0 + $ lineheight : NULL + $ margin : NULL + $ debug : NULL + $ inherit.blank: logi FALSE + - attr(*, "class")= chr [1:2] "element_text" "element" + + $legend.background + List of 5 + $ fill : NULL + $ colour : chr "black" + $ linewidth : NULL + $ linetype : chr "solid" + $ inherit.blank: logi FALSE + - attr(*, "class")= chr [1:2] "element_rect" "element" + + $legend.position + [1] "inside" + + $legend.direction + [1] "vertical" + + $panel.background + List of 5 + $ fill : chr "white" + $ colour : chr "black" + $ linewidth : NULL + $ linetype : NULL + $ inherit.blank: logi FALSE + - attr(*, "class")= chr [1:2] "element_rect" "element" + + $panel.border + List of 5 + $ fill : logi NA + $ colour : chr "black" + $ linewidth : num 1 + $ linetype : NULL + $ inherit.blank: logi FALSE + - attr(*, "class")= chr [1:2] "element_rect" "element" + + $plot.title + List of 11 + $ family : NULL + $ face : NULL + $ colour : NULL + $ size : NULL + $ hjust : num 0.5 + $ vjust : NULL + $ angle : NULL + $ lineheight : NULL + $ margin : NULL + $ debug : NULL + $ inherit.blank: logi FALSE + - attr(*, "class")= chr [1:2] "element_text" "element" + + $legend.position.inside + [1] 0.15 0.15 + + attr(,"complete") + [1] FALSE + attr(,"validate") + [1] TRUE + +--- + + Code + plot_out[[y]] + Output + $x + [1] "Primary System Organ Class" + + $y + [1] "% of Subjects" + + $title + [1] "DRUG B : DRUG C" + + $yintercept + [1] "yintercept" + + $fill + [1] "BYVAR1" + + diff --git a/tests/testthat/test-adae_risk_summary.R b/tests/testthat/test-adae_risk_summary.R index 90f1fdc..5f709e7 100644 --- a/tests/testthat/test-adae_risk_summary.R +++ b/tests/testthat/test-adae_risk_summary.R @@ -16,37 +16,34 @@ ae_entry <- ae_pre_process[["data"]] |> pop_fil = "Overall Population" ) -test_that("Standard Inputs work", { - output <- ae_entry |> +test_that("Test Case 1: adae_summary with standard inputs works", { + ae_risk <- ae_entry |> adae_risk_summary( - a_subset = ae_pre_process[["a_subset"]], + a_subset = ae_pre_process$a_subset, summary_by = "Patients", hterm = "AEBODSYS", lterm = "AEDECOD", ctrlgrp = "Placebo", trtgrp = "Xanomeline Low Dose", - statistics = "Risk Ratio", + statistics = "Risk Difference", alpha = 0.05, - cutoff = 5, + cutoff_where = "PCT > 5", sort_opt = "Ascending", - sort_var = "Count" + sort_var = "Count", + risklabels = tbl_risk_labels("Risk Difference") ) - expect_s3_class(output, "data.frame") - # Check risk calculated as expected; - expect_true("Risk Ratio (CI)" %in% names(output)) - # CHeck only pair of treatments present in output: - expect_length(unique(output$TRTPAIR), 1) + expect_equal(unique(pull(ae_risk, "TRTPAIR")), "Placebo -vs- Xanomeline Low Dose") + expect_snapshot(ae_risk) + output <- ae_risk |> + tbl_processor(keepvars = "Risk Ratio (CI)") |> + tbl_display() expect_snapshot(output) - out_table <- output |> - tbl_processor(keepvars = c("Risk Ratio (CI)", "P-value")) - expect_snapshot(out_table) }) -test_that("High cutoff as expected", { - expect_message( +test_that("Test Case 2: adae_summary with summary row", { + ae_risk <- ae_entry |> adae_risk_summary( - ae_entry, - a_subset = ae_pre_process[["a_subset"]], + a_subset = ae_pre_process$a_subset, summary_by = "Patients", hterm = "AEBODSYS", lterm = "AEDECOD", @@ -54,46 +51,54 @@ test_that("High cutoff as expected", { trtgrp = "Xanomeline Low Dose", statistics = "Risk Ratio", alpha = 0.05, - cutoff = 20, - sort_opt = "Ascending", - sort_var = "Count" + cutoff_where = "PCT > 5", + sort_opt = "Alphabetical", + sort_var = "Count", + risklabels = tbl_risk_labels("Risk Ratio"), + sum_row = "Y", + sum_row_label = "Any AE" ) - ) + expect_equal(unique(pull(ae_risk, "TRTPAIR")), "Placebo -vs- Xanomeline Low Dose") + expect_snapshot(ae_risk) + output <- ae_risk |> + tbl_processor(keepvars = "Risk Ratio (CI)") |> + tbl_display() + expect_snapshot(output) }) -test_that("Errors Resolved correctly", { - expect_error( +test_that("Test Case 3: Check empty and errors", { + ae_risk <- data.frame() |> adae_risk_summary( - data.frame(), - a_subset = ae_pre_process[["a_subset"]], + a_subset = NA, summary_by = "Patients", hterm = "AEBODSYS", lterm = "AEDECOD", ctrlgrp = "Placebo", trtgrp = "Xanomeline Low Dose", - statistics = "Risk Ratio", + statistics = "Risk Difference", alpha = 0.05, - cutoff = 5, - sort_opt = "Ascending", - sort_var = "Count" - ), - "Input data is empty" - ) - expect_error( + cutoff_where = "PCT > 5", + sort_opt = "Alphabetical", + sort_var = "Count", + sum_row = "Y", + sum_row_label = "Any AE" + ) + expect_equal(nrow(ae_risk), 0) + ae_risk1 <- ae_entry |> adae_risk_summary( - ae_entry, - a_subset = ae_pre_process[["a_subset"]], + a_subset = ae_pre_process$a_subset, summary_by = "Patients", hterm = "AEBODSYS", lterm = "AEDECOD", ctrlgrp = "Placebo", trtgrp = "Xanomeline Low Dose", - statistics = "Relative Risk", + statistics = "Risk Difference", alpha = 0.05, - cutoff = 5, - sort_opt = "Ascending", - sort_var = "Count" - ), - "Invalid Risk Statistics; specify any one of `Risk Ratio` or `Risk Difference`" - ) + cutoff_where = "PCT > 50", + sort_opt = "Alphabetical", + sort_var = "Count", + sum_row = "Y", + sum_row_label = "Any AE" + ) + expect_equal(nrow(ae_risk1), 0) }) diff --git a/tests/testthat/test-adlb_r301.R b/tests/testthat/test-adlb_r301.R deleted file mode 100644 index 6c0a824..0000000 --- a/tests/testthat/test-adlb_r301.R +++ /dev/null @@ -1,138 +0,0 @@ -#' Incidence of Laboratory Test Abnormalities (Without Regard to Baseline Abnormality) -#' -#' @param datain Input dataset (`adlb`). -#' @param crit_vars Criteria variables -#' @param pctdisp Denominator to calculate percentages by. -#' Values: `"TRT", "VAR","COL", "SUBGRP", "SGRPN", "CAT", "NONE", "NO", "DPTVAR"` -#' @param a_subset Subset conditions for analysis of dependent variable. -#' @param denom_subset Subset conditions for denominator eg. `"APSBLFL == 'Y'"` -#' -#' @return `data.frame` with summary of laboratory abnormality incidence counts -#' @export -#' -#' @examples -#' data("lab_data") -#' -#' lb_entry <- lab_data$adlb |> -#' mentry( -#' subset = NA_character_, -#' byvar = "PARCAT1~PARAM", -#' subgrpvar = NA_character_, -#' trtvar = "TRTA", -#' trtsort = "TRTAN", -#' trttotalyn = "N", -#' sgtotalyn = "N", -#' add_grpmiss = "N", -#' pop_fil = "SAFFL" -#' ) -#' -#' out <- -#' lb_entry |> -#' lab_abnormality_summary( -#' crit_vars = "CRIT3~CRIT4", -#' pctdisp = "SUBGRP", -#' a_subset = NA_character_, -#' denom_subset = NA_character_ -#' ) |> -#' display_bign_head(mentry_data = lb_entry) |> -#' tbl_processor( -#' dptlabel = "" -#' ) -#' -#' out -#' -#' # `flextable` output -#' out |> -#' tbl_display( -#' bylabel = "Parameter Category~Parameter", -#' dpthead = "Primary Criteria" -#' ) -#' -lab_abnormality_summary <- function(datain, - crit_vars = "CRIT3~CRIT4", - pctdisp = "SUBGRP", - a_subset = NA_character_, - denom_subset = NA_character_) { - # Data checks and error messages - stopifnot(is.data.frame(datain) && nrow(datain) > 0) - dptvars <- toupper(str_to_vec(crit_vars)) - dptvars_fl <- glue("{dptvars}FL") - byvars <- var_start(datain, "BYVAR") - byvarsN <- glue("{byvars}N") - stopifnot("Criteria Variables/Flags not present in `datain`" = all(dptvars %in% names(datain)) || - all(dptvars_fl %in% names(datain))) - # handle denom_subset when not specified - if (is.na(denom_subset) || str_squish(denom_subset) == "") { - if ("APSBLFL" %in% names(datain)) { - message("`denom_subset` not specified, set to APSBLFL == 'Y'") - dsubset <- c("APSBLFL == 'Y'") - } else { - stop( - "`APSBLFL` not present in `datain`, please provide a valid denominator subset condition" - ) - } - } else { - dsubset <- denom_subset - } - # Pre process adlb - adlb <- datain |> - filter(!str_sub(.data[["PARAMCD"]], start = -2L) %in% c("PL", "SL")) |> - # Replace missing values numeric equivalent grouping variables with 0 - mutate(across(any_of(byvarsN), ~ replace_na(., 0))) - # Calculate lab abnormalities by Criteria Flags - seq_along(dptvars) |> - map(\(dptval) { - asubset <- glue("{dptvars_fl[dptval]} == 'Y'") - if (!is.na(a_subset) && - str_squish(a_subset) != "") { - asubset <- glue("{a_subset} & {asubset}") - } - ## add lab abnormality counts - adlb |> - count_abnormalities( - asubset, - dsubset, - toupper(byvars), - dptvars[[dptval]], - pctdisp - ) - }) |> - # combine and display lab abnormality table - bind_rows() |> - mutate(across(c("DENOMN", "CVALUE"), as.character)) |> - rename(N = DENOMN, n = CVALUE) |> - pivot_longer(c("N", "n"), names_to = "SUBGRPVARX", values_to = "CVALUE") |> - mutate(SUBGRPVARXN = 9999) -} - -#' Count Lab Abnormalities -#' -#' @inheritParams lab_abnormality_summary -#' -#' @return List of data frames -#' @noRd -#' -count_abnormalities <- - function(datain, - a_subset, - denom_subset, - byvars, - dptvars, - pctdisp) { - crit_df <- - datain |> - filter(.data[[dptvars]] != "") |> - group_by(across(all_of(c(byvars, dptvars)))) |> - distinct() |> - ungroup() |> - rename(DPTVAR = all_of(dptvars)) - ## summarize categorical variables on data filtered by criteria flags - crit_df |> - mcatstat( - a_subset = a_subset, - denom_subset = denom_subset, - dptvar = "DPTVAR", - pctdisp = pctdisp, - pctsyn = "N" - ) - } diff --git a/tests/testthat/test-adsl_summary.R b/tests/testthat/test-adsl_summary.R new file mode 100644 index 0000000..2d28a79 --- /dev/null +++ b/tests/testthat/test-adsl_summary.R @@ -0,0 +1,173 @@ +data(adsl) + +mentry_df <- adsl |> + mentry( + subset = NA_character_, + byvar = "SEX", + trtvar = "TRT01A", + trtsort = "TRT01AN", + subgrpvar = NA_character_, + trttotalyn = "N", + add_grpmiss = "N", + sgtotalyn = "N", + pop_fil = "SAFFL" + ) + +test_that("split_var_types works", { + actual <- split_var_types(c("AGE-S", "RACE", "SEX")) + expected <- + list(num_vars = "AGE", cat_vars = c("RACE", "SEX"), all_vars = c("AGE", "RACE", "SEX")) + + actual_ <- split_var_types(c("AGE", "RACE", "SEX")) + expected_ <- + list( + num_vars = character(0), + cat_vars = c("AGE", "RACE", "SEX"), + all_vars = c("AGE", "RACE", "SEX") + ) + + expect_identical(actual, expected) + expect_identical(actual_, expected_) +}) + +test_that("adsl_summary works as expected", { + adsl_sum <- adsl_summary( + datain = mentry_df, + vars = "AGEGR1~AGE-S~RACE" + ) + + dataf <- adsl_sum |> + display_bign_head(mentry_df) |> + tbl_processor( + dptlabel = str_to_vec("Age Group~Age~Race"), + statlabel = str_to_vec("N~Range~Mean (SD)~Median~Interquartile Range") + ) + + adsl_sum_ <- adsl_summary( + datain = mentry_df, + vars = "AGEGR1~AGE~RACE" + ) + + dataf_ <- adsl_sum_ |> + display_bign_head(mentry_df) |> + tbl_processor( + statlabel = str_to_vec("N~Range~Meansd~Median~IQR"), + dptlabel = str_to_vec("Age Group~Age~Race") + ) + + expect_false(identical(dataf, dataf_)) + expect_true(nrow(dataf) < nrow(dataf_)) + expect_snapshot(print(tibble::as_tibble(dataf), n = Inf, width = Inf)) + expect_snapshot(print(tibble::as_tibble(dataf_), n = Inf, width = Inf)) +}) + +test_that("adsl_summary gives returns correct summary statistics", { + adsl_sum <- adsl_summary( + datain = mentry_df, + vars = "AGEGR1~AGE-S~RACE" + ) + + actual <- adsl_sum |> + display_bign_head(mentry_df) |> + tbl_processor( + statlabel = str_to_vec("N~Range~Meansd~Median~IQR"), + dptlabel = str_to_vec("Age Group~Age~Race") + ) + + agegr1 <- adsl |> + dplyr::filter(SAFFL == "Y") |> + dplyr::select(dplyr::all_of(c("TRT01A", "SEX", "AGEGR1"))) |> + dplyr::group_by(dplyr::across(dplyr::everything())) |> + dplyr::summarise(N = n()) |> + dplyr::filter(TRT01A == "Placebo") |> + dplyr::pull(N) + + exp_agegr1 <- actual |> + dplyr::filter(DPTVAR == "Age Group") |> + dplyr::arrange(BYVAR1, DPTVAL) |> + dplyr::mutate(dplyr::across( + dplyr::starts_with("Placebo"), + \(x) as.integer(stringr::str_squish(stringr::str_sub(x, 1, 2))) + )) |> + dplyr::pull(dplyr::starts_with("Placebo")) + + age_stat <- adsl |> + dplyr::filter(SAFFL == "Y") |> + dplyr::select(dplyr::all_of(c("TRT01A", "SEX", "AGE"))) |> + dplyr::group_by(dplyr::across(c("TRT01A", "SEX"))) |> + dplyr::summarize( + Mean = paste0(round_f(mean(.data[["AGE"]]), 2), " (", round_f(sd(.data[["AGE"]]), 2), ")") + ) |> + dplyr::arrange(.data[["SEX"]]) |> + dplyr::pull(Mean) + + exp_age_stat <- actual |> + dplyr::filter(DPTVAL == "Meansd") |> + dplyr::relocate(`Xanomeline Low Dose (N=84)`, .after = `Xanomeline High Dose (N=84)`) + + expect_identical(unique(actual[["DPTVAR"]]), c("Age Group", "Age", "Race")) + expect_identical(agegr1, exp_agegr1) + expect_identical(age_stat, unname(unlist(c(exp_age_stat[1, 7:9], exp_age_stat[2, 7:9])))) +}) + +test_that("adsl_summary works with subsets", { + adsl_sum <- mentry_df |> + adsl_summary( + vars = "AGEGR1~AGE-S~SEX~RACE", + a_subset = "AGE<65~AGE>80~NA~NA" + ) + + actual <- adsl_sum |> + display_bign_head(mentry_df) |> + tbl_processor( + statlabel = str_to_vec("N~Range~Meansd~Median~IQR"), + dptlabel = str_to_vec("Age Group~Age~Sex~Race") + ) + + adsl_sum_ <- mentry_df |> + adsl_summary( + vars = "AGEGR1~AGE-S~SEX~RACE", + denom_subset = "RACE=='WHITE'~NA~NA~NA" + ) + + actual_ <- adsl_sum_ |> + display_bign_head(mentry_df) |> + tbl_processor( + statlabel = str_to_vec("N~Range~Meansd~Median~IQR"), + dptlabel = str_to_vec("Age Group~Age~Sex~Race") + ) + + expect_snapshot(print(actual, n = Inf, width = Inf)) + expect_snapshot(print(tibble::as_tibble(actual_), n = Inf, width = Inf)) + + expect_error( + adsl_summary( + datain = mentry_df, + vars = "AGEGR1~AGE-S~SEX~RACE", + a_subset = "AGE<65~AGE>80~NA" + ), + "Number of subsets should be 1 or equal to number of corresponding variables" + ) + expect_error( + adsl_summary( + datain = mentry_df, + vars = "AGEGR1~AGE-S~SEX~RACE", + denom_subset = "AGE<65~NA" + ), + "Number of subsets should be 1 or equal to number of corresponding variables" + ) +}) + +test_that("Analysis variables not present", { + adsl_sum1 <- mentry_df |> + adsl_summary( + vars = "AGEGR1/AGEGR1N~AGE-S~SEX/SEXN~RACE/RACEN", + a_subset = "AGE<65~AGE>80~NA~NA" + ) + adsl_sum2 <- mentry_df |> + adsl_summary( + vars = "AGEGR1/AGEGR1N~AGE-S~SEX/SEXN~RACE/RACEN~AGEGR5/AGEGR5N", + a_subset = "AGE<65~AGE>80~NA~NA~NA" + ) + expect_equal(adsl_sum1, adsl_sum2) +}) diff --git a/tests/testthat/test-ae_forestplot.R b/tests/testthat/test-ae_forestplot.R new file mode 100644 index 0000000..c1c4113 --- /dev/null +++ b/tests/testthat/test-ae_forestplot.R @@ -0,0 +1,177 @@ +data("ae_pre_process") +ae_entry <- mentry( + datain = ae_pre_process$data, + subset = NA, + byvar = "AEBODSYS", + trtvar = "TRTA", + trtsort = "TRTAN", + subgrpvar = NA, + trttotalyn = "N", + add_grpmiss = "N", + sgtotalyn = "N", + pop_fil = "SAFFL" +) +ae_risk_forest <- risk_stat( + datain = ae_entry, + a_subset = ae_pre_process$a_subset, + summary_by = "Patients", + eventvar = "AEDECOD", + ctrlgrp = "Placebo", + trtgrp = "Xanomeline High Dose", + statistics = "Risk Ratio", + alpha = 0.05, + cutoff_where = "PCT > 5", + sort_opt = "Ascending", + sort_var = "Count" +) |> + plot_display_bign(ae_entry) +series_opts <- ae_risk_forest |> + plot_aes_opts(series_color = c("black", "royalblue2")) +# AE Forest Plot + +axis_opts1 <- plot_axis_opts( + xaxis_label = "Risk Ratio", + xopts = list(labelsize = 8, ticksize = 8) +) +axis_opts <- append(axis_opts1, list(xpos = "top")) +ae_risk1_forest <- risk_stat( + datain = ae_entry, + a_subset = ae_pre_process$a_subset, + summary_by = "Patients", + eventvar = "AEDECOD", + ctrlgrp = "Placebo", + trtgrp = "Xanomeline High Dose~~Xanomeline Low Dose", + statistics = "Risk Ratio", + alpha = 0.05, + cutoff_where = "PCT > 5", + sort_opt = "Ascending", + sort_var = "Count", + g_sort_by_ht = "Y" +) |> + plot_display_bign(ae_entry) +series_opts1 <- plot_aes_opts(ae_risk1_forest, series_color = "black~black~black") + +forest_dat <- ae_risk_forest |> + filter(!is.nan(.data[["RISK"]]), !is.infinite(.data[["RISK"]])) +test_that("Test Case 1: Standard error checks", { + expect_error( + ae_forest_plot( + datain = ae_risk_forest[0, ], + series_opts = list( + color = g_seriescol(ae_risk_forest, c("black", "royalblue2"), "TRTVAR"), + shape = g_seriessym(ae_risk_forest, NA, "TRTVAR"), + size = rep(1, 2) + ), + axis_opts = plot_axis_opts( + xaxis_label = "Risk Ratio", + xopts = list(labelsize = 8) + ) + ), + "Input ae_forest_plot data is empty" + ) + expect_error( + ae_forest_plot( + datain = ae_risk_forest, + series_opts = list( + color = g_seriescol(ae_risk_forest, c("black", "royalblue2"), "TRTVAR"), + shape = g_seriessym(ae_risk_forest, NA, "TRTVAR"), + size = rep(1, 2) + ), + rel_widths = c(0.38, 0.27), + axis_opts = plot_axis_opts( + xaxis_label = "Risk Ratio", + xopts = list(labelsize = 8) + ), + text_size = 2.4, + term_label = "Reported Term for the Adverse Event", + risk_ref = 1, + highlight_sig = "N" + ), + "rel_widths should be equal to the number of plot columns" + ) +}) +test_that("Test Case 2: Standard Inputs 1", { + forest1 <- ae_forest_plot( + datain = ae_risk_forest, + series_opts = series_opts, + trtpair_color = c("#F8766D", "#00BFC4"), + axis_opts = axis_opts, + term_label = "Reported Term for the Adverse Event", + highlight_sig = "Y", + rel_widths = c(0.5, 0.35, 0.15), + ht_dispyn = "N", + pvalue_dispyn = "Y", + terms_perpg = NULL + ) + expect_type(forest1, "list") + expect_length(forest1, 1) + expect_true("ggplot" %in% class(forest1[[1]])) + expect_length(forest1[[1]][["layers"]], 3) + purrr::walk(forest1[[1]][["layers"]], \(x) { + expect_snapshot(x[["geom_params"]][-1]) + }) +}) + +test_that("Test Case 3: Standard Inputs 2", { + forest2 <- ae_forest_plot( + datain = ae_risk1_forest, + series_opts = series_opts1, + axis_opts = axis_opts1, + term_label = "", + risk_ref = 1, + pairwise = "Y", + highlight_sig = "N", + rel_widths = c(0.25, 0.45, 0.3), + ht_dispyn = "Y", + pvalue_dispyn = "N", + terms_perpg = NULL + ) + expect_type(forest2, "list") + expect_length(forest2, 2) + expect_true("ggplot" %in% class(forest2[[1]])) + expect_length(forest2[[2]][["layers"]], 3) +}) +test_that("Test Case 4: Page splitting", { + forest3 <- ae_forest_plot( + datain = ae_risk_forest, + series_opts = series_opts, + trtpair_color = c("#F8766D", "#00BFC4"), + axis_opts = axis_opts, + term_label = "Reported Term for the Adverse Event", + highlight_sig = "Y", + rel_widths = c(0.5, 0.35, 0.15), + ht_dispyn = "N", + pvalue_dispyn = "Y", + terms_perpg = 8 + ) + expect_true(length(forest3) > 1) + purrr::walk( + forest3, + \(x) expect_true("ggplot" %in% class(x)) + ) + expect_length(forest3[[3]][["layers"]], 3) +}) + +# Create scatter plot to test sig points +splot <- forest_plot_scatter( + datain = ae_risk_forest, + xvar = "PCT", + yvar = "DPTVAL", + series_var = "TRTVAR", + series_opts = series_opts, + hovervar = "HOVER_PCT", + xaxis_pos = "top", + legend_opts = list(pos = "bottom", dir = "horizontal"), + axis_opts = list(xsize = 8, xtsize = 6, xaxis_label = "Percentage") +) +test_that("Test Case: Significant Points", { + actual <- ae_forest_hlt_sig( + plotin = splot, + datain = forest_dat, + pvalue_sig = 0.05, + pts_size = 1.5 + ) + expect_length(actual[["layers"]], 3) + expect_true(length(actual[["layers"]]) > length(splot[["layers"]])) + expect_equal(actual[["labels"]][["fill"]], "EFFECT") +}) diff --git a/tests/testthat/test-ae_pre_processor.R b/tests/testthat/test-ae_pre_processor.R index b1f71aa..f199538 100644 --- a/tests/testthat/test-ae_pre_processor.R +++ b/tests/testthat/test-ae_pre_processor.R @@ -1,172 +1,140 @@ # testcase 1: data(adae) data(FMQ_Consolidated_List) -test_that("Test Case 1: With standard inputs", { +adae1 <- adae |> + dplyr::mutate(ASEVN = dplyr::recode(.data[["AESEV"]], "MILD" = 1, "MODERATE" = 2, "SEVERE" = 3)) +test_that("Test Case 1: With standard arguments", { + adaetest <- adae + adaetest$AEDECOD[1] <- NA actual <- ae_pre_processor( - datain = adae, - aeSubset = "AOCCPFL=='Y'", - aeDenomSubset = "!is.na(ASTDT)", + datain = adaetest, ae_filter = "Any Event", - aeObsPeriod = "Overall Duration", - aeObsResidual = 0, - trtvar = "TRTA", - trtsort = "TRTAN", - pop_fil = "SAFFL", - fmq_data = FMQ_Consolidated_List, - aeEventVar = "AEDECOD", - aeByVar = "AEBODSYS", - aeSubGrpVar = NA, - aeBigN = "N", - aeGrpVarMiss = "N", - aeTrtTot = "N", - aeSubGrpTot = "N" + obs_residual = NA, + fmq_data = NA ) - date_formats <- c("%d%b%Y", "%Y-%m-%d") - - expected <- adae %>% - mutate( - AESTDT = as.Date(ASTDT, tryFormats = date_formats, optional = FALSE), - AEENDT = as.Date(AENDT, tryFormats = date_formats, optional = FALSE), - RFSTDTC = as.Date(TRTSDT, tryFormats = date_formats, optional = FALSE), - RFENDTC = as.Date(TRTEDT, tryFormats = date_formats, optional = FALSE) - ) %>% - tidyr::drop_na(RFSTDTC) %>% + date_formats <- c("%d%b%Y", "%Y-%m-%d", "%m/%d/%Y", "%d/%m/%Y") + expected <- adaetest |> mutate( - AEDECOD = if_else(!is.na(AESTDT) & is.na(AEDECOD), "Not yet coded", AEDECOD), - AESTDT = if_else(is.na(AESTDT) & !is.na(AEDECOD), RFSTDTC, AESTDT), - AESEV = toupper(AESEV) - ) - - mdsin <- mentry( - datain = expected, - ui_aSubset = "AOCCPFL=='Y'", - ui_dSubset = "!is.na(ASTDT)", - ui_byvar = "AEBODSYS", - ui_subgrpvar = NA, - ui_trtvar = "TRTA", - ui_trtsort = "TRTAN", - ui_trttotalyn = "N", - ui_sgtotalyn = "N", - ui_bign = "N", - ui_addGrpMiss = "N", - ui_pop_fil = "SAFFL" - ) - expect_named(actual, c("dsin", "dout", "bigN")) - expect_equal(actual$dsin, mdsin$dsin) - expect_equal(actual$dout, mdsin$dout) - expect_true(is.na(actual$bigN)) + ASTDT = as.Date(.data[["ASTDT"]], tryFormats = date_formats, optional = FALSE), + AENDT = as.Date(.data[["AENDT"]], tryFormats = date_formats, optional = FALSE), + TRTSDT = as.Date(.data[["TRTSDT"]], tryFormats = date_formats, optional = FALSE), + TRTEDT = as.Date(.data[["TRTEDT"]], tryFormats = date_formats, optional = FALSE) + ) |> + tidyr::drop_na(all_of("TRTSDT")) |> + mutate(AEDECOD = if_else(is.na(.data[["AEDECOD"]]) & !is.na(.data[["ASTDT"]]), + "Not Yet Coded", .data[["AEDECOD"]] + )) + expect_named(actual, c("data", "a_subset")) + expect_equal(actual$data, expected) + expect_true(is.na(actual$a_subset)) }) -# testcase 2: -test_that("Test Case 2: Varying inputs", { +test_that("Test Case 2: Check filtering", { actual <- ae_pre_processor( datain = adae, - aeSubset = "AOCCPFL=='Y'", - aeDenomSubset = "!is.na(ASTDT)", - ae_filter = "Treatment emergent", - aeObsPeriod = "Other", - aeObsResidual = 5, - trtvar = "TRTA", - trtsort = "TRTAN", - pop_fil = "SAFFL", - fmq_data = FMQ_Consolidated_List, - aeEventVar = "AEDECOD", - aeByVar = "AEBODSYS", - aeSubGrpVar = NA, - aeBigN = "N", - aeGrpVarMiss = "N", - aeTrtTot = "Y", - aeSubGrpTot = "N" + ae_filter = "Serious", + obs_residual = 5, + fmq_data = NA + ) + date_formats <- c("%d%b%Y", "%Y-%m-%d", "%m/%d/%Y", "%d/%m/%Y") + expected <- adae |> + mutate( + ASTDT = as.Date(.data[["ASTDT"]], tryFormats = date_formats, optional = FALSE), + AENDT = as.Date(.data[["AENDT"]], tryFormats = date_formats, optional = FALSE), + TRTSDT = as.Date(.data[["TRTSDT"]], tryFormats = date_formats, optional = FALSE), + TRTEDT = as.Date(.data[["TRTEDT"]], tryFormats = date_formats, optional = FALSE) + ) |> + tidyr::drop_na(all_of("TRTSDT")) |> + filter( + .data[["AESER"]] == "Y", .data[["ASTDT"]] > .data[["TRTSDT"]], + .data[["ASTDT"]] < (.data[["TRTEDT"]] + 5) + ) + expect_named(actual, c("data", "a_subset")) + expect_equal(actual$data, expected) + expect_equal( + actual$a_subset, + "AESER == 'Y' & (ASTDT > TRTSDT) & (ASTDT < (TRTEDT + 5))" ) - expect_named(actual, c("dsin", "dout", "bigN")) - expect_true(is.na(actual$bigN)) - # AE filter applied: - expect_equal(unique(actual$dsin$TRTEMFL), "Y") - # Analysis Subset applied: - expect_equal(unique(actual$dsin$AOCCPFL), "Y") - # Denom Subset: - expect_false(any(is.na(actual$dout$ASTDT))) - # Observation Period: - expect_true(all(actual$dsin$AESTDT > actual$dsin$RFSTDTC)) - expect_true(all(actual$dsin$AESTDT < (actual$dsin$RFENDTC + 5))) - # All required variables created in if(): - expect_true(all(c("AESTDT", "AEENDT", "RFSTDTC", "RFENDTC", "AESEV") %in% names(actual$dout))) - # There are no non-coded terms in default adae: - expect_false("Not yet coded" %in% unique(actual$dsin$AEDECOD)) - # Treatment - expect_is(actual$dsin$TRTVAR, "factor") - # Total Treatment: - expect_true("Total" %in% unique(actual$dsin$TRTVAR)) - # FMQ is not given as eventvar: - expect_false("FMQ_NAM" %in% names(actual$dout)) }) # test case 3: test_that("Test Case 3: FMQ created from Consolidated List", { actual <- ae_pre_processor( datain = adae, - aeSubset = "USUBJID != ''", - aeDenomSubset = "!is.na(ASTDT)", - ae_filter = c("Mild", "Recovered/Resolved"), - aeObsPeriod = "Overall Duration", - trtvar = "TRTA", - trtsort = "TRTAN", - pop_fil = "SAFFL", - fmq_data = FMQ_Consolidated_List, - aeEventVar = "AEDECOD", - aeByVar = "FMQ_NAM", - aeSubGrpVar = NA, - aeBigN = "Y", - aeGrpVarMiss = "N", - aeTrtTot = "N", - aeSubGrpTot = "N" + ae_filter = NA, + obs_residual = NA, + fmq_data = FMQ_Consolidated_List ) - expect_named(actual, c("dsin", "dout", "bigN")) - expect_is(actual$bigN, "data.frame") - # AE filter applied: - expect_equal(toupper(unique(actual$dsin$AESEV)), "MILD") - expect_equal(toupper(unique(actual$dsin$AEOUT)), "RECOVERED/RESOLVED") # FMQ is given as BYVAR - expect_true("FMQ_NAM" %in% names(actual$dout)) - # Using PT = "Rash" as example: - Fmq_rash <- FMQ_Consolidated_List %>% - filter(PT == "Rash") %>% + expect_true("FMQ_NAM" %in% names(actual$data)) + # Using PT = "Anxiety" as example: + Fmq_Anxiety <- FMQ_Consolidated_List |> + filter(PT == "Anxiety") |> mutate(FMQ_NAM = paste0(FMQ, "/", FMQCAT)) - expectedfmq <- paste(unique(Fmq_rash$FMQ_NAM), collapse = "~~") - actualfmq <- actual$dout %>% - filter(AEDECOD == "RASH") %>% - distinct(FMQ_NAM) %>% + expectedfmq <- paste(unique(Fmq_Anxiety$FMQ_NAM), collapse = "~~") + actualfmq <- actual$data |> + filter(AEDECOD == "ANXIETY") |> + distinct(FMQ_NAM) |> pull() expect_equal(actualfmq, expectedfmq) }) -# test case 4 -test_that("Test Case 4: Dates Converted As Expected:", { + +# test case 3: +test_that("Test Case 4: Filters executed correctly", { + expect_error( + ae_pre_processor( + datain = adae, + ae_filter = "GRADE 1", + obs_residual = NA, + fmq_data = FMQ_Consolidated_List + ), "ATOXGR not found in data. Cannot apply ae_filter" + ) actual <- ae_pre_processor( datain = adae, - aeSubset = "USUBJID != ''", - aeDenomSubset = "!is.na(ASTDT)", ae_filter = "Serious", - aeObsPeriod = "Other", - aeObsResidual = 5, - trtvar = "TRTA", - trtsort = "TRTAN", - pop_fil = "SAFFL", - fmq_data = FMQ_Consolidated_List, - aeEventVar = "AEDECOD", - aeByVar = "AEBODSYS", - aeSubGrpVar = NA, - aeBigN = "N", - aeGrpVarMiss = "N", - aeTrtTot = "Y", - aeSubGrpTot = "N" + subset = "AGE > 80", + fmq_data = NA ) - expect_named(actual, c("dsin", "dout", "bigN")) - # AE filter applied: - expect_equal(unique(actual$dsin$AESER), "Y") - # expected class to be 'Date' - expect_is(actual$dsin$AESTDT, "Date") - expect_is(actual$dsin$AEENDT, "Date") - expect_is(actual$dsin$RFSTDTC, "Date") - expect_is(actual$dsin$RFENDTC, "Date") + expect_named(actual, c("data", "a_subset")) + expect_equal(nrow(actual$data), 0) + expect_equal(actual$a_subset, "AESER == 'Y' & AGE > 80") + actual1 <- ae_pre_processor( + datain = data.frame() + ) + expect_equal(actual1, list(data = data.frame(), a_subset = NA_character_)) +}) + +# test case 5: +test_that("Test Case 5: Max Sev/Toxicity", { + actual <- ae_pre_processor( + datain = adae1, + subset = "TRTEMFL == 'Y' & SITEID == '703'", + max_sevctc = "SEV", + sev_ctcvar = "ASEVN", + hterm = "AEBODSYS", + lterm = "AEDECOD", + pt_total = "Y" + ) + expected <- adae1 |> + filter(TRTEMFL == "Y", SITEID == "703") |> + mutate( + ASTDT = as.Date(.data[["ASTDT"]], tryFormats = date_formats, optional = FALSE), + AENDT = as.Date(.data[["AENDT"]], tryFormats = date_formats, optional = FALSE), + TRTSDT = as.Date(.data[["TRTSDT"]], tryFormats = date_formats, optional = FALSE), + TRTEDT = as.Date(.data[["TRTEDT"]], tryFormats = date_formats, optional = FALSE) + ) |> + tidyr::drop_na(all_of("TRTSDT")) |> + group_by(across(all_of(c("TRTA", "USUBJID", "AEBODSYS", "AEDECOD")))) |> + mutate(MAX_SEVCTC = ifelse(.data[["ASEVN"]] == max(.data[["ASEVN"]], na.rm = TRUE), 1, 0)) |> + filter(.data[["MAX_SEVCTC"]] == 1) |> + group_by(across(any_of(c("TRTA", "USUBJID")))) |> + mutate(ANY = ifelse(.data[["ASEVN"]] == max(.data[["ASEVN"]], na.rm = TRUE), 1, 0)) |> + group_by(across(any_of(c("TRTA", "USUBJID", "AEBODSYS")))) |> + mutate(HT_FL = ifelse(.data[["ASEVN"]] == max(.data[["ASEVN"]], na.rm = TRUE), 1, 0)) |> + group_by(across(any_of(c("TRTA", "AEDECOD", "USUBJID")))) |> + mutate(PT_CNT = ifelse(.data[["ASEVN"]] == max(.data[["ASEVN"]], na.rm = TRUE), 1, 0)) |> + ungroup() + expect_equal(actual$data, expected) + expect_equal(actual$a_subset, "TRTEMFL == 'Y' & SITEID == '703' & MAX_SEVCTC == 1") }) diff --git a/tests/testthat/test-ae_volcano_plot.R b/tests/testthat/test-ae_volcano_plot.R index 45b389b..908f588 100644 --- a/tests/testthat/test-ae_volcano_plot.R +++ b/tests/testthat/test-ae_volcano_plot.R @@ -1,4 +1,37 @@ -data("ae_risk") +data("adae") +ae_pre <- ae_pre_processor( + datain = adae, + obs_residual = 0, + fmq_data = NA, + subset = "TRTEMFL == 'Y'" +) + +ae_entry <- mentry( + datain = ae_pre$data, + subset = NA, + byvar = "AEBODSYS", + trtvar = "TRTA", + trtsort = "TRTAN", + subgrpvar = NA, + trttotalyn = "N", + add_grpmiss = "N", + sgtotalyn = "N", + pop_fil = "SAFFL" +) + +ae_risk <- risk_stat( + datain = ae_entry, + a_subset = ae_pre$a_subset, + summary_by = "Patients", + eventvar = "AEDECOD", + ctrlgrp = "Placebo", + trtgrp = "Xanomeline High Dose", + statistics = "Risk Ratio", + alpha = 0.05, + cutoff_where = "PCT > 5", + sort_opt = "Ascending", + sort_var = "Count" +) vaxis_opts <- ae_volcano_opts( datain = ae_risk, statistic = "Risk Ratio", @@ -21,7 +54,7 @@ test_that("Test 1: Volcano plot Options works", { c("xaxis_label", "yaxis_label", "ylinearopts", "yaxis_scale", "xref") ) expected <- list( - xaxis_label = "<--- Favors Control (N=69) ---- Favors Exposure (N=79) --->\nRisk Ratio", + xaxis_label = "<--- Favors Control (N=62) ---- Favors Exposure (N=69) --->\nRisk Ratio", yaxis_label = "-log10 p-value", ylinearopts = list(breaks = as.numeric(paste0("1e-", 0:20)), labels = as.character(0:20)), yaxis_scale = reverselog_trans(10), @@ -33,7 +66,7 @@ test_that("Test 1: Volcano plot Options works", { pvalue_trans = "none" ) expected2 <- list( - xaxis_label = "<--- Favors Control (N=69) ---- Favors Exposure (N=79) --->\nRisk Ratio", + xaxis_label = "<--- Favors Control (N=62) ---- Favors Exposure (N=69) --->\nRisk Ratio", yaxis_label = "p-value", ylinearopts = list( breaks = c(0.05, 0, rep(1, 10) / 10^(9:0)), diff --git a/tests/testthat/test-bar_plot.R b/tests/testthat/test-bar_plot.R new file mode 100644 index 0000000..6b57e1a --- /dev/null +++ b/tests/testthat/test-bar_plot.R @@ -0,0 +1,78 @@ +data(adsl) +adsl_entry <- mentry( + datain = adsl, + subset = "EFFFL=='Y'", + byvar = "RACE", + trtvar = "TRT01A", + trtsort = "TRT01AN", + pop_fil = NA +) + +adsl_sum <- msumstat( + datain = adsl_entry, + dptvar = "AGE", + statvar = "mean", + figyn = "Y" +)[["gsum"]] |> + mutate( + XVAR = BYVAR1, + YVAR = as.numeric(mean) + ) + +test_that("Test Case 1: bar_plot works with expected inputs", { + bar_out <- bar_plot( + datain = adsl_sum, + flip_plot = "N", + series_opts = list( + color = c("red", "gold", "cyan") + ), + axis_opts = plot_axis_opts(), + legend_opts = list( + label = "", pos = "bottom", + dir = "horizontal" + ), + series_var = "TRTVAR", + series_labelvar = "TRTVAR", + bar_pos = "dodged", + griddisplay = "N", + plot_title = NULL + ) + + legendgroups <- unique(bar_out[["data"]][["TRTVAR"]]) + + expect_type(bar_out, "list") + expect_true(is.ggplot(bar_out)) + expect_equal(legendgroups, unique(bar_out[["data"]][["TRTVAR"]])) + purrr::walk( + c("mapping", "labels"), + \(x) expect_snapshot(bar_out[[x]]) + ) +}) + +test_that("Test Case 2: bar_plot works with modified inputs", { + bar_out <- bar_plot( + datain = adsl_sum, + flip_plot = "Y", + series_opts = list( + color = c("red", "gold", "cyan"), + contrast = c("black", "grey", "pink") + ), + axis_opts = plot_axis_opts(), + legend_opts = list( + label = "", pos = "bottom", + dir = "horizontal" + ), + series_var = "TRTVAR", + series_labelvar = "TRTVAR", + bar_pos = "stacked", + griddisplay = "N", + plot_title = NULL + ) + + legendgroups <- unique(bar_out[["data"]][["TRTVAR"]]) + + expect_type(bar_out, "list") + expect_equal(legendgroups, unique(bar_out[["data"]][["TRTVAR"]])) + expect_true(nrow(bar_out$data) > 0) + expect_true(length(bar_out) > 0) +}) diff --git a/tests/testthat/test-box_plot.R b/tests/testthat/test-box_plot.R new file mode 100644 index 0000000..1968d2f --- /dev/null +++ b/tests/testthat/test-box_plot.R @@ -0,0 +1,115 @@ +adsl_entry <- mentry( + datain = adsl, + subset = "EFFFL=='Y'", + byvar = "RACE", + trtvar = "TRT01A", + trtsort = "TRT01AN", + pop_fil = NA +) + +adsl_sum <- msumstat( + datain = adsl_entry, + dptvar = "AGE", + statvar = c( + "mean", "median", "q25", "q75", "whiskerlow", + "whiskerup", "outliers" + ) +) + +adsl_sum$gsum$XVAR <- fct_reorder(adsl_sum$gsum$BYVAR1, adsl_sum$gsum$BYVAR1N) +fig_col <- box_plot( + datain = adsl_sum$gsum, + axis_opts = plot_axis_opts(xaxis_label = "Race", yaxis_label = "Age"), + legend_opts = list( + label = "Treatment", pos = "bottom", + dir = "horizontal" + ), + series_opts = list( + color = c("red", "gold", "cyan"), shape = c(16, 17, 15), + size = c(1, 1, 1) + ) +) +fig_fill <- box_plot( + datain = adsl_sum$gsum, + axis_opts = plot_axis_opts(xaxis_label = "Race", yaxis_label = "Age"), + legend_opts = list( + label = "Treatment", pos = "bottom", + dir = "horizontal" + ), + series_opts = list( + color = c("red", "gold", "cyan"), shape = c(16, 17, 15), + size = c(1, 1, 1) + ), + boxfill = "Y", + griddisplay = "Y" +) + +# Whiskers varied to min and max +adsl_sum2 <- msumstat( + datain = adsl_entry, + dptvar = "AGE", + statvar = c( + "mean", "median", "q25", "q75", "min", + "max" + ) +) +adsl_sum2$gsum$XVAR <- fct_reorder(adsl_sum2$gsum$BYVAR1, adsl_sum2$gsum$BYVAR1N) +fig_fill2 <- box_plot( + datain = adsl_sum2$gsum, + axis_opts = plot_axis_opts(xaxis_label = "Race", yaxis_label = "Age"), + legend_opts = list( + label = "Treatment", pos = "bottom", + dir = "horizontal" + ), + series_opts = list( + color = c("red", "gold", "cyan"), shape = c(16, 17, 15), + size = c(1, 1, 1) + ), + boxfill = "Y" +) + +# Tests: +test_that("Standard box plot outputs", { + expect_true(is.ggplot(fig_col)) + expectdata <- adsl_sum$gsum |> + mutate(across(all_of(c( + "mean", "median", "q25", "q75", "whiskerlow", + "whiskerup" + )), as.numeric)) + expect_equal(fig_col$data, expectdata) + purrr::walk( + list(fig_col, fig_fill, fig_fill2), + \(p) purrr::walk(c("mapping", "labels"), \(x) expect_snapshot(p[[x]])) + ) +}) + +test_that("Errors resolved", { + expect_error( + box_plot( + datain = adsl_sum$gsum |> select(-all_of(c("median", "q25"))), + axis_opts = plot_axis_opts(xaxis_label = "Race", yaxis_label = "Age"), + legend_opts = list( + label = "Treatment", pos = "bottom", + dir = "horizontal" + ), + series_opts = list( + color = c("red", "gold", "cyan"), shape = c(16, 17, 15), + size = c(1, 1, 1) + ) + ), "Expected statistics not found" + ) + expect_error( + box_plot( + datain = data.frame(), + axis_opts = plot_axis_opts(xaxis_label = "Race", yaxis_label = "Age"), + legend_opts = list( + label = "Treatment", pos = "bottom", + dir = "horizontal" + ), + series_opts = list( + color = c("red", "gold", "cyan"), shape = c(16, 17, 15), + size = c(1, 1, 1) + ) + ) + ) +}) diff --git a/tests/testthat/test-data_read.R b/tests/testthat/test-data_read.R index f1ad5a7..31d3121 100644 --- a/tests/testthat/test-data_read.R +++ b/tests/testthat/test-data_read.R @@ -1,5 +1,7 @@ data("adae") data("adsl") +adae_actual <- haven::read_xpt(paste0(app_sys("extdata"), "/adae.xpt")) +adsl_actual <- get(load("testdata/adsl.rda")) # data_read default test test_that("Case 1: Works with Default", { test_adam <- data_read( @@ -11,9 +13,10 @@ test_that("Case 1: Works with Default", { expect_named(test_adam$adam, c("adae", "adsl")) # Read Correctly - expect_equal(test_adam$adam$adae, adae) + expect_s3_class(test_adam$adam$adae, "data.frame") + expect_equal(test_adam$adam$adae, adae_actual) # Labels read - expect_equal(test_adam$adam_attrib$adsl$VAR_NAMES, names(adsl)) + expect_equal(test_adam$adam_attrib$adsl$VAR_NAMES, names(test_adam$adam$adsl)) }) ## Source: Local, path = package path @@ -24,9 +27,9 @@ test_that("Case 2: Works with Path", { ui_adam_data = list(datapath = "testdata/adsl.rda", name = "adsl.rda") ) expect_named(test_adsl, c("adam", "adam_attrib")) - expect_equal(test_adsl$adam$adsl, adsl) + expect_equal(test_adsl$adam$adsl, adsl_actual) - expect_equal(test_adsl$adam_attrib$adsl$VAR_NAMES, names(adsl)) + expect_equal(test_adsl$adam_attrib$adsl$VAR_NAMES, names(test_adsl$adam$adsl)) }) test_that("Case 3: NULL Path", { diff --git a/tests/testthat/test-dataset_merge.R b/tests/testthat/test-dataset_merge.R index 020a258..eae21a2 100644 --- a/tests/testthat/test-dataset_merge.R +++ b/tests/testthat/test-dataset_merge.R @@ -4,7 +4,7 @@ df1 <- iris |> df2 <- iris |> dplyr::select(Species, dplyr::ends_with("Width")) - +options(warn = 1) test_that("dataset_merge works", { expected <- dplyr::left_join(df1, df2, by = "Species") actual <- dataset_merge(df1, df2, byvars = "Species") @@ -51,4 +51,23 @@ test_that("dataset_merge returns expected errors", { ), "All subsets cannot be `NA`, use `subset = NULL` instead" ) + expect_error( + dataset_merge( + df1, + df2, + byvars = "Species", + subset = NULL, + type = "outer" + ), + "Type should be one of left, right, inner, full" + ) + expect_warning( + dataset_merge( + df1, + df2, + byvars = "Species", + subset = list("Species != 'versicolor'", NA_character_), + type = "full" + ) + ) }) diff --git a/tests/testthat/test-edish_plot.R b/tests/testthat/test-edish_plot.R index 6c0a824..49f2236 100644 --- a/tests/testthat/test-edish_plot.R +++ b/tests/testthat/test-edish_plot.R @@ -1,138 +1,106 @@ -#' Incidence of Laboratory Test Abnormalities (Without Regard to Baseline Abnormality) -#' -#' @param datain Input dataset (`adlb`). -#' @param crit_vars Criteria variables -#' @param pctdisp Denominator to calculate percentages by. -#' Values: `"TRT", "VAR","COL", "SUBGRP", "SGRPN", "CAT", "NONE", "NO", "DPTVAR"` -#' @param a_subset Subset conditions for analysis of dependent variable. -#' @param denom_subset Subset conditions for denominator eg. `"APSBLFL == 'Y'"` -#' -#' @return `data.frame` with summary of laboratory abnormality incidence counts -#' @export -#' -#' @examples -#' data("lab_data") -#' -#' lb_entry <- lab_data$adlb |> -#' mentry( -#' subset = NA_character_, -#' byvar = "PARCAT1~PARAM", -#' subgrpvar = NA_character_, -#' trtvar = "TRTA", -#' trtsort = "TRTAN", -#' trttotalyn = "N", -#' sgtotalyn = "N", -#' add_grpmiss = "N", -#' pop_fil = "SAFFL" -#' ) -#' -#' out <- -#' lb_entry |> -#' lab_abnormality_summary( -#' crit_vars = "CRIT3~CRIT4", -#' pctdisp = "SUBGRP", -#' a_subset = NA_character_, -#' denom_subset = NA_character_ -#' ) |> -#' display_bign_head(mentry_data = lb_entry) |> -#' tbl_processor( -#' dptlabel = "" -#' ) -#' -#' out -#' -#' # `flextable` output -#' out |> -#' tbl_display( -#' bylabel = "Parameter Category~Parameter", -#' dpthead = "Primary Criteria" -#' ) -#' -lab_abnormality_summary <- function(datain, - crit_vars = "CRIT3~CRIT4", - pctdisp = "SUBGRP", - a_subset = NA_character_, - denom_subset = NA_character_) { - # Data checks and error messages - stopifnot(is.data.frame(datain) && nrow(datain) > 0) - dptvars <- toupper(str_to_vec(crit_vars)) - dptvars_fl <- glue("{dptvars}FL") - byvars <- var_start(datain, "BYVAR") - byvarsN <- glue("{byvars}N") - stopifnot("Criteria Variables/Flags not present in `datain`" = all(dptvars %in% names(datain)) || - all(dptvars_fl %in% names(datain))) - # handle denom_subset when not specified - if (is.na(denom_subset) || str_squish(denom_subset) == "") { - if ("APSBLFL" %in% names(datain)) { - message("`denom_subset` not specified, set to APSBLFL == 'Y'") - dsubset <- c("APSBLFL == 'Y'") - } else { - stop( - "`APSBLFL` not present in `datain`, please provide a valid denominator subset condition" - ) - } - } else { - dsubset <- denom_subset - } - # Pre process adlb - adlb <- datain |> - filter(!str_sub(.data[["PARAMCD"]], start = -2L) %in% c("PL", "SL")) |> - # Replace missing values numeric equivalent grouping variables with 0 - mutate(across(any_of(byvarsN), ~ replace_na(., 0))) - # Calculate lab abnormalities by Criteria Flags - seq_along(dptvars) |> - map(\(dptval) { - asubset <- glue("{dptvars_fl[dptval]} == 'Y'") - if (!is.na(a_subset) && - str_squish(a_subset) != "") { - asubset <- glue("{a_subset} & {asubset}") - } - ## add lab abnormality counts - adlb |> - count_abnormalities( - asubset, - dsubset, - toupper(byvars), - dptvars[[dptval]], - pctdisp - ) - }) |> - # combine and display lab abnormality table - bind_rows() |> - mutate(across(c("DENOMN", "CVALUE"), as.character)) |> - rename(N = DENOMN, n = CVALUE) |> - pivot_longer(c("N", "n"), names_to = "SUBGRPVARX", values_to = "CVALUE") |> - mutate(SUBGRPVARXN = 9999) -} +data(adsl) +data(adlb) -#' Count Lab Abnormalities -#' -#' @inheritParams lab_abnormality_summary -#' -#' @return List of data frames -#' @noRd -#' -count_abnormalities <- - function(datain, - a_subset, - denom_subset, - byvars, - dptvars, - pctdisp) { - crit_df <- - datain |> - filter(.data[[dptvars]] != "") |> - group_by(across(all_of(c(byvars, dptvars)))) |> - distinct() |> - ungroup() |> - rename(DPTVAR = all_of(dptvars)) - ## summarize categorical variables on data filtered by criteria flags - crit_df |> - mcatstat( - a_subset = a_subset, - denom_subset = denom_subset, - dptvar = "DPTVAR", - pctdisp = pctdisp, - pctsyn = "N" - ) - } +merged_data <- adsl_merge( + adsl = adsl, + dataset_add = adlb +) |> + mentry( + subset = "SAFFL == 'Y'", + trtvar = "TRT01A", + trtsort = "TRT01AN" + ) + +pt_data <- process_edish_data( + datain = merged_data, + xvar = "both", + alt_paramcd = "ALT", + ast_paramcd = "AST", + bili_paramcd = "BILI" +) + +# dataset to test xvar for "ast/alt" +dt_xvar <- process_edish_data( + datain = merged_data, + xvar = "ast", + alt_paramcd = "ALT", + ast_paramcd = "AST", + bili_paramcd = "BILI" +) +series_opts <- plot_aes_opts(pt_data, + series_size = c(2, 2), + series_shape = "circle~square" +) +e_plot <- edish_plot( + datain = pt_data, + axis_opts = plot_axis_opts( + xlinearopts = list( + breaks = c(0.1, 1, 2, 10), + limits = c(0.1, 10), + labels = c("0.1", "1", "2x ULN", "10") + ), + ylinearopts = list( + breaks = c(0.1, 1, 3, 10), + limits = c(0.1, 10), + labels = c("0.1", "1", "3x ULN", "10") + ), + xaxis_label = "Peak ALT/AST (x ULN)", + yaxis_label = "Peak Total Bilirubin (x ULN)" + ), + xrefline = c("2", "gray30", "dashed"), + yrefline = c("3", "gray30", "dashed"), + quad_labels = + "Potential Hy's Law Cases~Temple's Corollary~Gilberts Syndrome or Cholestasis~Normal", + legend_opts = list( + label = "Treatment", + pos = "bottom", dir = "horizontal" + ), + series_opts = series_opts, + interactive = "N" +) + +test_that("edish data Works with standard inputs", { + actual_trt <- unique(pt_data$TRTVAR) + + expect_equal(levels(actual_trt), c("Placebo", "Xanomeline Low Dose", "Xanomeline High Dose")) + expect_equal(nrow(pt_data), 254) + + expect_error(process_edish_data( + datain = merged_data, + alt_paramcd = "L00030S", + ast_paramcd = "L00028S", + bili_paramcd = "wefewf" + ), "Please provide valid PARAMCD") + + # test xvar for "ast/alt" + expect_equal(dt_xvar$XVAR, dt_xvar$ast) +}) + +test_that("edish_plot works with expected output", { + expect_type(e_plot, "list") + expect_true(nrow(e_plot$data) > 0) + expect_equal( + e_plot$labels$x, + "Peak ALT/AST (x ULN)" + ) + expect_equal( + e_plot$labels$y, + "Peak Total Bilirubin (x ULN)" + ) + expect_true(is.ggplot(e_plot)) + + + # plotly output comparison + ptly <- edish_plot( + datain = pt_data, + series_opts = series_opts, + interactive = "Y" + ) + expect_equal(class(ptly), c("plotly", "htmlwidget")) +}) + +test_that("snapshot comparison", { + purrr::walk(c("mapping", "theme", "labels"), function(x) { + expect_snapshot(e_plot[[x]]) + }) +}) diff --git a/tests/testthat/test-event_analysis.R b/tests/testthat/test-event_analysis.R index 99b7225..561b377 100644 --- a/tests/testthat/test-event_analysis.R +++ b/tests/testthat/test-event_analysis.R @@ -1,90 +1,56 @@ -data(event_df) - -test_that("Test Case 1: Event Analysis works with expected inputs", { - goutput <- event_analysis( - datain = event_df$dsin, - datain_N = event_df$dout, - hl_var = "FMQ_NAM", - hl_val = "ABDOMINAL PAIN", - hl_scope = "Narrow", - ll_var = "AEDECOD", - ll_val = "ABDOMINAL DISCOMFORT", - ll_scope = "Narrow", +data(adae) +data(FMQ_Consolidated_List) + +prep_ae <- adae |> + ae_pre_processor( + ae_filter = "ANY", + subset = "AOCCPFL == 'Y'", + obs_residual = 0, + fmq_data = FMQ_Consolidated_List + ) +prep_entry <- prep_ae$data |> + mentry( + trtvar = "TRTA", + trtsort = "TRTAN", + trttotalyn = "N", + byvar = "FMQ_NAM" + ) +prep_event_analysis <- prep_entry |> + process_event_analysis( + a_subset = prep_ae$a_subset, summary_by = "Events", - ref_line = 2 + hterm = "FMQ_NAM", + ht_val = "ABDOMINAL PAIN", + ht_scope = "Narrow", + lterm = "AEDECOD", + lt_val = "ABDOMINAL DISCOMFORT", + lt_scope = "Narrow" ) - ptly_data <- goutput[["ptly"]][["x"]][["data"]] - - legendgroups <- - unlist(purrr::compact(purrr::map( - seq_along(ptly_data), - function(x) ptly_data[[x]][["legendgroup"]] - ))) - - expect_equal(length(goutput), 6) - expect_equal(names(goutput), c("ptly", "plot", "rpt_data", "rpt_data1", "title", "footnote")) - expect_true(nrow(goutput$rpt_data) > 0) - expect_type(goutput$ptly, "list") - expect_equal(legendgroups, sort(unique(goutput[["rpt_data"]][["DPTVAL"]]))) - - expect_equal(goutput$title, "Event Analysis plot of Adverse Events") +test_that("Test Case 1: process_event_analysis works with expected inputs", { + expect_named(prep_event_analysis, c("query_df", "pt_df")) + expect_equal(unique(prep_event_analysis$pt_df$DPTVAL), "ABDOMINAL DISCOMFORT") + expect_equal(unique(prep_event_analysis$pt_df$DPTVAR), "AEDECOD") expect_equal( - goutput$footnote, - paste0( - "* N is the total number of events. \nClassifications of adverse events ", - "are based on the Medical Dictionary for Regulatory Activities (MedDRA", - " v21.1). \nFMQ classification is based on FDA FMQ consolidated list. ", - "\nDashed Horizontal line represents incidence percentage reference line. ", - "\nTotals for the No. of Participants/Events at a higher level are not ", - "necessarily the sum of those at the lower levels since a participant ", - "may report two or more. \nPT - Preferred Term ; FMQ - FDA MedDRA Queries ", - "\nEvent counts are the sum of individual occurrences within that category." - ) + unique(prep_event_analysis$query_df$DPTVAL), + c("ABDOMINAL PAIN", "ABDOMINAL DISCOMFORT", "STOMACH DISCOMFORT") + ) + expect_equal(unique(prep_event_analysis$query_df$DPTVAR), "AEDECOD") + purrr::walk( + prep_event_analysis, + \(x) expect_snapshot(print(tibble::as_tibble(x), n = Inf, width = Inf)) ) }) - -test_that("Test Case 2: Event Analysis works with expected inputs", { - goutput <- event_analysis( - datain = event_df$dsin, - datain_N = event_df$dout, - hl_var = "FMQ_NAM", - hl_val = "abdominal pain", - hl_scope = "Narrow", - ll_var = "FMQ_NAM", - ll_val = "abdominal discomfort", - ll_scope = "Narrow", - summary_by = "Events", - ref_line = 2 +test_that("Test Case 2: event_analysis_plot works with expected inputs", { + plot <- event_analysis_plot( + datain = prep_event_analysis, + ref_line = 1, + x_tickangle = 15, + disp.proportion = "4~6", + pt_color = "royalblue3", + interactive = "Y" ) - ptly_data <- goutput[["ptly"]][["x"]][["data"]] - - legendgroups <- - unlist(purrr::compact(purrr::map( - seq_along(ptly_data), - function(x) ptly_data[[x]][["legendgroup"]] - ))) - - expect_equal(length(goutput), 6) - expect_equal(names(goutput), c("ptly", "plot", "rpt_data", "rpt_data1", "title", "footnote")) - expect_true(nrow(goutput$rpt_data) > 0) - expect_type(goutput$ptly, "list") - expect_equal(legendgroups, sort(unique(goutput[["rpt_data"]][["DPTVAL"]]))) - expect_identical(goutput$rpt_data, goutput$rpt_data) - expect_equal(goutput$title, "Event Analysis plot of Adverse Events") - expect_equal( - goutput$footnote, - paste0( - "* N is the total number of events. \nClassifications of adverse events ", - "are based on the Medical Dictionary for Regulatory Activities (MedDRA", - " v21.1). \nFMQ classification is based on FDA FMQ consolidated list. ", - "\nDashed Horizontal line represents incidence percentage reference line. ", - "\nTotals for the No. of Participants/Events at a higher level are not ", - "necessarily the sum of those at the lower levels since a participant ", - "may report two or more. \nPT - Preferred Term ; FMQ - FDA MedDRA Queries ", - "\nEvent counts are the sum of individual occurrences within that category." - ) - ) + expect_snapshot(plot$x$data) }) diff --git a/tests/testthat/test-forest_plot.R b/tests/testthat/test-forest_plot.R index 6ded5ca..5eec505 100644 --- a/tests/testthat/test-forest_plot.R +++ b/tests/testthat/test-forest_plot.R @@ -1,5 +1,37 @@ -data("ae_risk") +ae_pre_process <- ae_pre_processor( + datain = adae, + obs_residual = 0 +) + +ae_entry <- mentry( + datain = ae_pre_process$data, + subset = NA, + byvar = "AEBODSYS", + trtvar = "TRTA", + trtsort = "TRTAN", + subgrpvar = NA, + trttotalyn = "N", + add_grpmiss = "N", + sgtotalyn = "N", + pop_fil = "SAFFL" +) + options(warn = -1) +ae_risk <- risk_stat( + datain = ae_entry, + a_subset = ae_pre_process$a_subset, + summary_by = "Patients", + eventvar = "AEDECOD", + ctrlgrp = "Placebo", + trtgrp = "Xanomeline High Dose", + statistics = "Risk Ratio", + alpha = 0.05, + cutoff_where = "PCT > 2", + sort_opt = "Ascending", + sort_var = "Count", + hoveryn = "Y" +) |> + mutate(key = row_number()) fp <- forest_plot_base( ae_risk, xvar = "RISK", diff --git a/tests/testthat/test-graph_utils.R b/tests/testthat/test-graph_utils.R new file mode 100644 index 0000000..36b42d8 --- /dev/null +++ b/tests/testthat/test-graph_utils.R @@ -0,0 +1,328 @@ +# Test graph_utils +data("adae") +data("adsl") +data("ae_pre_process") + +ae_pre <- mentry( + datain = ae_pre_process$data, + subset = NA, + byvar = "AEBODSYS", + trtvar = "TRTA", + trtsort = "TRTAN", + subgrpvar = "SEX", + trttotalyn = "N", + add_grpmiss = "N", + sgtotalyn = "N", + pop_fil = "SAFFL" +) +## reverselog_trans testing +test_that("Case 1: Transformation works with expected input", { + # Labels for adae data: + trans2 <- reverselog_trans(2) + expect_equal(trans2$name, "reverselog-2") +}) + +############################################################################# +## g_seriescol testing ## + +test_that("Case 1: Works with expected input", { + trt_cols <- g_seriescol(ae_pre, "red~cyan~forestgreen~black~pink~green", "TRTVAR") + + # Correct number of levels and colors assigned + expect_equal(unname(trt_cols), c("red", "cyan", "forestgreen")) + # Names as expected + expect_named( + trt_cols, + c("Placebo", "Xanomeline Low Dose", "Xanomeline High Dose") + ) +}) + +test_that("Case 2: Works with default", { + trt_na <- g_seriescol(ae_pre, NA, "TRTVAR") + # Default colors: + + expect_equal( + unname(trt_na), + c("firebrick2", "blue4", "forestgreen") + ) + expect_named( + trt_na, + c("Placebo", "Xanomeline Low Dose", "Xanomeline High Dose") + ) +}) + +test_that("Case 3: Works with character column", { + trt_ch <- g_seriescol(ae_pre, NA, "SEX") + # Colors: + expect_equal( + unname(trt_ch), + c("firebrick2", "blue4") + ) + expect_named( + trt_ch, + c("F", "M") + ) +}) + +############################################################################# +## g_seriessym ## + +test_that("Case 1: Works with expected input", { + trt_shp <- g_seriessym( + ae_pre, + "triangle~circle~square~asterisk", "TRTVAR" + ) + + # Correct number of levels and colors assigned + expect_equal(unname(trt_shp), c(2, 1, 0)) + # Names as expected + expect_named( + trt_shp, + c("Placebo", "Xanomeline Low Dose", "Xanomeline High Dose") + ) + + # Numeric Input: + trt_shp1 <- g_seriessym( + ae_pre, + c(1, 21, 23, 3), "TRTVAR" + ) + expect_equal(unname(trt_shp1), c(1, 21, 23)) + expect_named( + trt_shp1, + c("Placebo", "Xanomeline Low Dose", "Xanomeline High Dose") + ) +}) + +test_that("Case 2: Works with default", { + trt_nashp <- g_seriessym(ae_pre, NA, "TRTVAR") + # Default colors: + + expect_equal( + unname(trt_nashp), + c(16, 17, 15) + ) + expect_named( + trt_nashp, + c("Placebo", "Xanomeline Low Dose", "Xanomeline High Dose") + ) +}) + +test_that("Case 3: Works with character column", { + trt_chshp <- g_seriessym(ae_pre, NA, "SEX") + # Colors: + expect_equal( + unname(trt_chshp), + c(16, 17) + ) + expect_named( + trt_chshp, + c("F", "M") + ) +}) + +############################################################################# +# plot_display_bign + +# Test Data +# data without treatment +adsl_entry1 <- mentry( + datain = adsl, + subset = "EFFFL=='Y'", + byvar = NA, + trtvar = NA, + trtsort = NA, + subgrpvar = NA, + trttotalyn = "N", + add_grpmiss = "N", + sgtotalyn = "N", + pop_fil = "Overall Population" +) +datain1 <- mcatstat( + datain = adsl_entry1, + dptvar = "AGEGR1" +) +adsl_entry2 <- mentry( + datain = adsl, + subset = "EFFFL=='Y'", + byvar = NA, + trtvar = "TRT01A", + trtsort = "TRT01AN", + subgrpvar = "SEX", + trttotalyn = "N", + add_grpmiss = "N", + sgtotalyn = "N", + pop_fil = "Overall Population" +) +datain2 <- msumstat( + datain = adsl_entry2, + dptvar = "AGE", + statvar = "box" +)$gsum +# Test Cases + +test_that("Test 1:Check for count and values of the output", { + actual <- datain2 |> + plot_display_bign(adsl_entry2, bignyn = "Y") + expect_true(is.data.frame(actual)) + expected <- datain2 |> + add_bigN(adsl_entry2, grpvar = c("TRTVAR", "SUBGRPVAR1"), modvar = "TRTVAR") |> + rename("TRTTXT" = "TRTVAR_BIGN") + expect_equal(actual, expected) + # Testing with case "N" no bign + actual1 <- datain2 |> + plot_display_bign(adsl_entry2, bignyn = "N") + expected1 <- datain2 |> + mutate(TRTTXT = .data[["TRTVAR"]]) + expect_equal(actual1, expected1) +}) + +test_that("Test 2: Check bign without TRTVAR", { + actual <- plot_display_bign(datain1, adsl_entry1, bignyn = "Y") + expect_true(is.data.frame(actual)) + expect_equal(unique(actual$TRTVAR), "Total") + expect_equal( + unique(actual$TRTTXT), + paste0("Total (N=", length(unique(adsl_entry1[["USUBJID"]])), ")") + ) +}) + +test_that("Test 1: test plot_aes_opts works", { + actual <- plot_aes_opts( + datain = adsl_entry2, + series_var = "TRTVAR", + series_color = NA, + series_shape = NA, + series_size = rep(1, 3), + series_contrast = rep("black", 3) + ) + expect_type(actual, "list") + expect_equal(actual$color, g_seriescol(adsl_entry2, NA, "TRTVAR")) + expect_equal(actual$shape, g_seriessym(adsl_entry2, NA, "TRTVAR")) + expect_equal(actual$size, g_seriessym(adsl_entry2, rep(1, 3), "TRTVAR")) + expect_equal(actual$contrast, g_seriescol(adsl_entry2, rep("black", 3), "TRTVAR")) +}) + +test_that("Test 2: Check plot_aes_opts without series var", { + actual <- plot_aes_opts( + datain = adsl_entry2, + series_var = "NOVAR", + series_color = "red~green", + series_shape = "square~circle", + series_size = rep(1, 3), + series_contrast = rep("black", 3) + ) + expect_type(actual, "list") + expect_equal(actual, list(color = "red", shape = 0, size = 1, contrast = "black")) +}) +############################################################################# +# plot_axis_opts + +test_that("Test 1: Expected Inputs", { + actual <- plot_axis_opts() + expect_type(actual, "list") + expected <- list( + Ybrks = waiver(), + Ylims = NULL, + Yticks = waiver(), + Xbrks = waiver(), + Xlims = NULL, + Xticks = waiver(), + xsize = 12, + xface = "plain", + ysize = 12, + yface = "plain", + ytsize = 8, + ytface = "plain", + xtsize = 8, + xtface = "plain", + xtangle = 0, + ytangle = 0, + xaxis_scale = "identity", + yaxis_scale = "identity", + xaxis_label = "", + yaxis_label = "" + ) + expect_equal(actual, expected) + actual1 <- plot_axis_opts(xlinearopts = list(limits = c(0, 100))) + expected1 <- expected + expected1[["Xlims"]] <- c(0, 100) + expect_equal(actual1, expected1) +}) + +test_that("empty_plot works as expected", { + actual <- empty_plot() + static_label <- "No data available for these values" + exp_ptly_obj <- actual$ptly$x$data + + expect_length(actual, 2) + expect_length(actual$plot$data, 0) + expect_equal(actual[["plot"]][["layers"]][[1]][["aes_params"]][["label"]], static_label) + expect_snapshot(exp_ptly_obj) +}) + +test_that("theme_cleany works as expected", { + actual <- theme_cleany(legend_opts = list(pos = "bottom", dir = "horizontal")) + expect_true(all(class(actual) %in% c("theme", "gg"))) + expect_snapshot(actual) +}) + +test_that("theme_std works as expected", { + actual <- theme_std() + expect_true(all(class(actual) %in% c("theme", "gg"))) + expect_length(actual, 10) + expect_equal(actual$legend.position, "bottom") + expect_equal(actual$plot.title$hjust, 0.5) + actual2 <- theme_std(griddisplay = "Y") + expect_length(actual2, 12) + expect_equal(actual2$panel.grid.major.x$colour, "grey") + expect_equal(actual2$panel.grid.major.y$linewidth, 0.1) +}) + +test_that("plot_title_nsubj works as expected", { + plotdata <- ae_pre |> + msumstat( + dptvar = "AGE", + statvar = "mean", + sigdec = 2 + ) + actual1 <- plot_title_nsubj( + ae_pre, + plotdata$gsum, + "SUBGRPVAR1" + ) + expect_true(is.data.frame(actual1)) + expected1 <- ae_pre |> + group_by(across(all_of("SUBGRPVAR1"))) |> + summarise(splitN = n_distinct(.data[["USUBJID"]])) |> + (\(.) left_join(plotdata[["gsum"]], ., by = "SUBGRPVAR1"))() + expect_equal(actual1, expected1, ignore_attr = TRUE) + # No subgroup case + actual2 <- plot_title_nsubj( + ae_pre, + plotdata$gsum, + character(0) + ) + expected2 <- plotdata[["gsum"]] |> + mutate(splitN = n_distinct(ae_pre[["USUBJID"]])) + expect_equal(actual2, expected2, ignore_attr = TRUE) +}) + +test_that("tbl_to_plot works as expected", { + fig <- ggplot2::mpg |> + mutate(CYL = as.character(.data[["cyl"]])) |> + group_by(.data[["CYL"]]) |> + mutate(HWY = round(mean(.data[["hwy"]]))) |> + tbl_to_plot( + "CYL", + "manufacturer", + "HWY" + ) + expect_true("ggplot" %in% class(fig)) + purrr::walk(c("mapping", "labels"), \(x) expect_snapshot(fig[[x]])) +}) + +test_that("series_leg_lab works properly", { + iris1 <- iris |> mutate(SPNEW = fct_inorder(c(rep("A", 50), rep("B", 50), rep("C", 50)))) + expect_equal(series_leg_lab(iris1, "Species", "SPNEW"), as.factor(c("A", "B", "C"))) + expect_equal(series_leg_lab(iris1, "Species", "Species"), waiver()) +}) diff --git a/tests/testthat/test-lab_abnormality.R b/tests/testthat/test-lab_abnormality.R new file mode 100644 index 0000000..4cd9ee1 --- /dev/null +++ b/tests/testthat/test-lab_abnormality.R @@ -0,0 +1,103 @@ +data("adlb") + +lb_entry <- adlb |> + mentry( + subset = NA_character_, + byvar = "PARCAT1~PARAM", + subgrpvar = NA_character_, + trtvar = "TRTA", + trtsort = NA_character_, + trttotalyn = "N", + sgtotalyn = "N", + add_grpmiss = "N", + pop_fil = "SAFFL" + ) + +lb_entry_subgrp <- adlb |> + mentry( + subset = NA_character_, + byvar = "PARCAT1~PARAM", + subgrpvar = "RACE", + trtvar = "TRTA", + trtsort = "TRTAN", + trttotalyn = "Y", + sgtotalyn = "Y", + add_grpmiss = "Y", + pop_fil = "SAFFL" + ) + +lb_entry_subset <- adlb |> + mentry( + subset = NA_character_, + byvar = "PARCAT1~PARAM", + subgrpvar = "RACE", + trtvar = "TRTA", + trtsort = NA_character_, + trttotalyn = "N", + sgtotalyn = "N", + add_grpmiss = "N", + pop_fil = "SAFFL" + ) + +test_that("lab_abnormality_summary works as expected with different options", { + out <- lb_entry |> + lab_abnormality_summary( + crit_vars = "CRIT1~CRIT2", + pctdisp = "SUBGRP", + a_subset = NA_character_, + denom_subset = NA_character_ + ) |> + display_bign_head(lb_entry) |> + tbl_processor(addrowvars = NA_character_) + + out_by_subgrp <- + lb_entry_subgrp |> + lab_abnormality_summary( + crit_vars = "CRIT1~CRIT2", + pctdisp = "SUBGRP", + a_subset = NA_character_, + denom_subset = "APSBLFL == 'Y'" + ) |> + display_bign_head(mentry_data = lb_entry_subgrp) |> + tbl_processor(addrowvars = NA_character_) + + out_by_subset <- + lb_entry_subset |> + lab_abnormality_summary( + crit_vars = "CRIT1~CRIT2", + pctdisp = "SUBGRP", + a_subset = "RACE == 'WHITE'" + ) |> + display_bign_head(mentry_data = lb_entry_subset) |> + tbl_processor(addrowvars = NA_character_) + + purrr::walk(out, \(x) print(x)) + purrr::walk(out_by_subgrp, \(x) expect_snapshot(x)) + purrr::walk(out_by_subset, \(x) expect_snapshot(x)) +}) + +test_that("lab_abnormality_summary returns expected error messages", { + df_ <- lb_entry |> + dplyr::select(-APSBLFL) + + expect_error( + lab_abnormality_summary( + datain = df_, + crit_vars = "CRIT1~CRIT2", + pctdisp = "SUBGRP", + a_subset = NA_character_, + denom_subset = NA_character_ + ), + "`APSBLFL` not present in `datain`, please provide a valid denominator subset condition" + ) + + expect_error( + lab_abnormality_summary( + datain = df_, + crit_vars = "CRIT3~CRIT487900", + pctdisp = "SUBGRP", + a_subset = NA_character_, + denom_subset = NA_character_ + ) + ) +}) diff --git a/tests/testthat/test-line_plot.R b/tests/testthat/test-line_plot.R new file mode 100644 index 0000000..d123205 --- /dev/null +++ b/tests/testthat/test-line_plot.R @@ -0,0 +1,58 @@ +adsl_entry <- mentry( + datain = adsl, + subset = "EFFFL=='Y'", + byvar = "RACE", + trtvar = "TRT01A", + trtsort = "TRT01AN", + pop_fil = NA +) + +adsl_sum <- msumstat( + datain = adsl_entry, + dptvar = "AGE", + statvar = "mean" +) +adsl_sum$gsum <- adsl_sum$gsum |> + mutate( + XVAR = fct_reorder(.data[["BYVAR1"]], .data[["BYVAR1N"]]), + YVAR = as.numeric(.data[["mean"]]) + ) +fig <- line_plot( + datain = adsl_sum$gsum, + axis_opts = plot_axis_opts(xaxis_label = "Race", yaxis_label = "Mean Age"), + legend_opts = list( + label = "Treatment", pos = "bottom", + dir = "horizontal" + ), + series_opts = plot_aes_opts( + adsl_sum$gsum, + "TRTVAR", + series_color = "firebrick~forestgreen~dodgerblue", + series_shape = "triangle~square~circle" + ), + griddisplay = "Y" +) + +test_that("Standard line plot outputs", { + expect_true(is.ggplot(fig)) + expect_equal(fig$data, adsl_sum$gsum) + purrr::walk(c("mapping", "labels"), \(x) expect_snapshot(fig[[x]])) +}) + +test_that("Expect errors", { + expect_error( + line_plot( + datain = adsl_sum$gsum |> select(-all_of("XVAR")), + axis_opts = plot_axis_opts(xaxis_label = "Race", yaxis_label = "Mean Age"), + legend_opts = list( + label = "Treatment", pos = "bottom", + dir = "horizontal" + ), + series_opts = list( + color = c("red", "gold", "cyan") + ), + griddisplay = "Y" + ), + "XVAR, YVAR, series_var and series_labelvar should exist in data" + ) +}) diff --git a/tests/testthat/test-mcatstat.R b/tests/testthat/test-mcatstat.R index 69d9796..5b9e8fb 100644 --- a/tests/testthat/test-mcatstat.R +++ b/tests/testthat/test-mcatstat.R @@ -31,8 +31,9 @@ ad_sum <- ad_entry |> group_by(across(all_of("TRTVAR"))) |> mutate( DPTVAL = as.character(.data[["SEX"]]), DENOMN = sum(.data[["FREQ"]]), - PCT = round_f(100 * .data[["FREQ"]] / .data[["DENOMN"]], 2), - CVALUE = paste0(.data[["FREQ"]], " (", .data[["PCT"]], "%)"), CN = "C", + PCT = 100 * .data[["FREQ"]] / .data[["DENOMN"]], + CPCT = round_f(.data[["PCT"]], 2), + CVALUE = paste0(.data[["FREQ"]], " (", .data[["CPCT"]], "%)"), CN = "C", DPTVARN = 1, XVAR = .data[["DPTVAL"]], DPTVAR = "SEX", DPTVALN = as.numeric(factor(.data[["SEX"]])) ) |> @@ -62,13 +63,14 @@ test_that("Case 1:mcatstat output with standard inputs and filters", { }) test_that("Case 2: Empty input", { - expect_error( + expect_equal( mcatstat( datain = ad_entry |> filter(USUBJID == "A"), dptvar = "SEX", pctdisp = "TRT" ), - "No data for mcatstat" + ad_entry |> filter(USUBJID == "A"), + ignore_attr = TRUE ) expect_error( mcatstat( @@ -100,8 +102,8 @@ test_that("Case 3: Unique ID and sign variation", { # All groups and order except actual count values should be equal expect_equal( - m_subj |> select(-all_of(c("DENOMN", "FREQ", "PCT", "CVALUE"))), - m_na |> select(-all_of(c("DENOMN", "FREQ", "PCT", "CVALUE"))) + m_subj |> select(-all_of(c("DENOMN", "FREQ", "PCT", "CVALUE", "CPCT"))), + m_na |> select(-all_of(c("DENOMN", "FREQ", "PCT", "CVALUE", "CPCT"))) ) # Counts are different @@ -137,7 +139,7 @@ test_that("Case 4: Percentage denominator variation and denomyn", { # No percentage columns: expect_false(any(c("PCT", "DENOMN") %in% names(m_none))) - expect_equal(m_none$FREQ, m_none$CVALUE) + expect_equal(as.character(m_none$FREQ), m_none$CVALUE) # Variable total as denominator m_var <- mcatstat( @@ -201,12 +203,44 @@ test_that("Case 6: Filters check", { distinct(USUBJID) |> nrow() expect_equal(unique(m_denom$DENOMN), denomvalue) - m_num1 <- mcatstat( +}) + +test_that("Case 7: Sparse check", { + m_num <- mcatstat( datain = ad_entry, - a_subset = "SEX == 'X'", + a_subset = "SEX == 'F'", uniqid = "USUBJID", dptvar = "SEX", - pctdisp = "TRT" + pctdisp = "TRT", + sparseyn = "Y" + ) + expect_equal(unique(m_num$DPTVAL), c("F", "M")) + m_by <- mcatstat( + datain = ae_entry, + a_subset = "AEBODSYS != 'CARDIAC DISORDERS'", + uniqid = "USUBJID", + dptvar = "SEX", + pctdisp = "TRT", + sparsebyvalyn = "Y" + ) + expect_true("CARDIAC DISORDERS" %in% m_by$BYVAR1) + freq <- m_by |> + filter(BYVAR1 == "CARDIAC DISORDERS") |> + pull(.data[["FREQ"]]) |> + unique() + expect_equal(freq, 0) +}) + +test_that("Analysis Subset and return zero", { + m_num <- mcatstat( + datain = ad_entry, + a_subset = "SEX == 'XC'", + uniqid = "USUBJID", + dptvar = "SEX", + pctdisp = "TRT", + return_zero = "Y" ) - expect_equal(nrow(m_num1), 0) + expect_s3_class(m_num, "data.frame") + expect_true(nrow(m_num) > 0) + expect_equal(unique(m_num$FREQ), 0) }) diff --git a/tests/testthat/test-mentry.R b/tests/testthat/test-mentry.R index aa4884d..6a1b048 100644 --- a/tests/testthat/test-mentry.R +++ b/tests/testthat/test-mentry.R @@ -1,102 +1,103 @@ data(adsl) - +# For testing purposes +adsl[1, "SEX"] <- NA_character_ +adsl[2, "SITEGR1"] <- NA_character_ test_that("Test Case:1 mentry works with the inputs given and returns the expected items", { data_out <- mentry( datain = adsl, - ui_aSubset = "EFFFL=='Y'", - ui_dSubset = NA, - ui_byvar = "SEX", - ui_subgrpvar = "SITEGR1", - ui_trtvar = "TRT01A", - ui_trtsort = "TRT01AN", - ui_trttotalyn = "N", - ui_sgtotalyn = "N", - ui_bign = "Y", - ui_addGrpMiss = "Y", - ui_pop_fil = "SAFFL" + subset = "EFFFL=='Y'", + byvar = "SEX", + subgrpvar = "SITEGR1", + trtvar = "TRT01A", + trtsort = "TRT01AN", + trttotalyn = "N", + sgtotalyn = "N", + add_grpmiss = "Y", + pop_fil = "SAFFL" ) - # it returns a list with 3 items - expect_type(data_out, "list") - expect_equal(length(data_out), 3) - - # it returns dsin, dout, bign - expect_equal(names(data_out), c("dsin", "dout", "bign")) + # it returns a dataframe + expect_s3_class(data_out, "data.frame") # testing asubset filter - expect_equal(unique(data_out$dsin$EFFFL), "Y") - - # testing whether bign has 3 variables - treatment, subgroup, and bign count - expect_equal(length(data_out$bign), 3) + expect_equal(unique(data_out$EFFFL), "Y") # testing population filter - expect_equal(unique(data_out$dsin$SAFFL), "Y") + expect_equal(unique(data_out$SAFFL), "Y") + # Treatment check + expect_s3_class(data_out$TRTVAR, "factor") # testing missing logic in byvar and subgrpvar - expect_false(unique(data_out$dsin$BYVAR1 == "")) - expect_false(unique(data_out$dsin$SUBGRPVAR1 == "")) - - # after getting dout, it is filtered with asubset hence checking whether dsin has less rows than - # dout - expect_true(nrow(data_out$dsin) < nrow(data_out$dout)) + expect_equal( + unique(data_out$BYVAR1), + stringr::str_replace_na(unique(adsl$SEX), "Missing") + ) + expect_equal( + unique(data_out$SUBGRPVAR1), + stringr::str_replace_na(unique(adsl$SITEGR1), "Missing") + ) }) test_that("Test Case:2 byvar and byvarn check", { data_out <- mentry( datain = adsl, - ui_aSubset = "EFFFL=='Y'", - ui_dSubset = NA, - ui_byvar = "SEX,ETHNIC", - ui_subgrpvar = "SITEGR1,BMIBLGR1", - ui_trtvar = "TRT01A", - ui_trtsort = "TRT01AN", - ui_trttotalyn = "N", - ui_sgtotalyn = "N", - ui_bign = "Y", - ui_addGrpMiss = "N", - ui_pop_fil = "SAFFL" + subset = "EFFFL=='Y'", + byvar = "SEX~ETHNIC", + subgrpvar = "RACE/RACEN", + trtvar = "TRT01A", + trtsort = "TRT01AN", + trttotalyn = "N", + sgtotalyn = "N", + add_grpmiss = "N", + pop_fil = "SAFFL" ) byvars_check <- c( "BYVAR1", "BYVAR1N", "BYVAR2", "BYVAR2N", "SUBGRPVAR1", - "SUBGRPVAR1N", "SUBGRPVAR2", "SUBGRPVAR2N" + "SUBGRPVAR1N" ) - expect_equal(names(data_out$dsin), names(data_out$dout)) - expect_true(isTRUE(all(byvars_check %in% names(data_out$dsin)))) + expect_true(isTRUE(all(byvars_check %in% names(data_out)))) + expect_identical(unique(adsl$RACEN[!is.na(adsl$RACEN)]), unique(data_out$SUBGRPVAR1N)) + expect_identical(unique(data_out$BYVAR1), unique(adsl$SEX[!is.na(adsl$SEX)])) + expect_false("Missing" %in% unique(data_out$BYVAR1)) }) -test_that("Test Case: 3 bign conditions check when ui_bign = 'N'", { +test_that("Total and Treatment Values", { data_out <- mentry( datain = adsl, - ui_aSubset = "EFFFL=='Y'", - ui_dSubset = NA, - ui_byvar = "SEX,ETHNIC", - ui_subgrpvar = "SITEGR1,BMIBLGR1", - ui_trtvar = "TRT01A", - ui_trtsort = "TRT01AN", - ui_trttotalyn = "N", - ui_sgtotalyn = "N", - ui_bign = "N", - ui_addGrpMiss = "N", - ui_pop_fil = "SAFFL" + subset = NA_character_, + subgrpvar = "SITEGR1", + trtvar = "TRT01A", + trtsort = NA, + trttotalyn = "Y", + sgtotalyn = "Y", + add_grpmiss = "Y", + pop_fil = "SAFFL" ) - expect_equal(length(data_out), 3) - expect_equal(data_out$bign, NA) + chdata <- data_out |> + filter(.data[["TRTVAR"]] %in% + c("NOT ASSIGNED", "SCREEN FAILURE", "SCRNFAIL", "NOTRT", "NOTASSGN")) + expect_equal(nrow(chdata), 0) + exp <- data_out |> + mutate( + TRTSORT = as.numeric(factor(.data$TRTVAR)), + TRTSORT = ifelse(.data[["TRTVAR"]] == "Total", 999, .data[["TRTSORT"]]) + ) |> + select(all_of(names(data_out))) + expect_equal(data_out, exp) + expect_true("Total" %in% data_out$TRTVAR) + expect_true("Total" %in% data_out$SUBGRPVAR1) }) -test_that("Test Case: 4 bign conditions check when ui_bign = 'Y'", { +test_that("Check Empty Input", { data_out <- mentry( - datain = adsl, - ui_aSubset = "EFFFL=='Y'", - ui_dSubset = NA, - ui_byvar = "SEX,ETHNIC", - ui_subgrpvar = NA, - ui_trtvar = NA, - ui_trtsort = NA, - ui_trttotalyn = "N", - ui_sgtotalyn = "N", - ui_bign = "Y", - ui_addGrpMiss = "N", - ui_pop_fil = "SAFFL" + datain = data.frame(), + subset = NA_character_, + subgrpvar = "SITEGR1", + trtvar = "TRT01A", + trtsort = NA, + trttotalyn = "Y", + sgtotalyn = "Y", + add_grpmiss = "Y", + pop_fil = "SAFFL" ) - - expect_equal(data_out$bign, nrow(adsl)) + expect_equal(data_out, data.frame()) }) diff --git a/tests/testthat/test-msumstat.R b/tests/testthat/test-msumstat.R new file mode 100644 index 0000000..3acc9d6 --- /dev/null +++ b/tests/testthat/test-msumstat.R @@ -0,0 +1,158 @@ +data("adsl") +adsl_entry <- + adsl |> mentry( + subset = "EFFFL=='Y'", + byvar = "AGEGR1", + subgrpvar = "SEX", + trtvar = "TRT01A", + trtsort = "TRT01AN", + trttotalyn = "N", + add_grpmiss = "N", + pop_fil = NA + ) +expected_g <- adsl_entry |> + group_by(across(all_of(c("BYVAR1", "BYVAR1N", "TRTVAR", "SUBGRPVAR1", "SUBGRPVAR1N")))) |> + summarise(mean = round_f(mean(.data[["AGE"]], na.rm = TRUE), 2)) |> + ungroup() |> + mutate(DPTVAR = "AGE", CN = "N", DPTVARN = 1) |> + arrange(across(all_of(c("BYVAR1N", "TRTVAR", "SUBGRPVAR1N")))) +expected_t <- expected_g |> + pivot_longer(cols = "mean", names_to = "DPTVAL", values_to = "CVALUE") |> + ungroup() |> + mutate(DPTVALN = 1) |> + arrange(across(all_of(c("BYVAR1N", "TRTVAR", "SUBGRPVAR1N")))) + +test_that("Test 1: 'Check for expected inputs", { + # Logic check + # for a valid input data, the number of rows returned is >0 + actual <- msumstat( + datain = adsl_entry, + dptvar = "AGE", + statvar = "mean", + sigdec = 2 + ) + # Test + expect_type(actual, "list") + expect_named(actual, c("tsum", "gsum")) + expect_equal( + actual$gsum |> arrange(across(all_of(c("BYVAR1N", "TRTVAR", "SUBGRPVAR1N")))), + expected_g + ) + expect_equal( + actual$tsum |> arrange(across(all_of(c("BYVAR1N", "TRTVAR", "SUBGRPVAR1N")))), + expected_t + ) +}) + + +# Test 2 +test_that("Test 2: Check modified inputs", { + # LOGIC: Check if the valid Dependent Variable Exists and Type Conversion is performed + test_adsl <- adsl_entry |> + mutate(BMIBLCH = as.character(.data[["BMIBL"]])) + actual <- msumstat( + datain = test_adsl, + dptvar = "BMIBLCH", + statvar = "", + sigdec = 2 + ) + expect_named(actual, c("tsum", "gsum")) + expected <- test_adsl |> + mutate(BMIBLCH = as.numeric(BMIBLCH)) |> + filter(!is.na(BMIBLCH)) |> + group_by(across(all_of(c("BYVAR1", "BYVAR1N", "TRTVAR", "SUBGRPVAR1", "SUBGRPVAR1N")))) |> + summarise( + n = as.character(n()), + mean = round_f(mean(.data[["BMIBLCH"]], na.rm = TRUE), 2), + min = round_f(min(.data[["BMIBLCH"]], na.rm = TRUE), 2), + median = round_f(median(.data[["BMIBLCH"]], na.rm = TRUE), 2), + max = round_f(max(.data[["BMIBLCH"]], na.rm = TRUE), 2), + sd = round_f(sd(.data[["BMIBLCH"]], na.rm = TRUE), 2) + ) |> + ungroup() |> + mutate(DPTVAR = "BMIBLCH", CN = "N", DPTVARN = 1) + expect_equal(actual$gsum, expected) + actual1 <- msumstat( + datain = adsl_entry, + dptvar = "AGE", + statvar = "box", + sigdec = 2 + ) + expect_true(all( + c("median", "q25", "q75", "whiskerlow", "whiskerup", "outliers") %in% names(actual1$gsum) + )) + expect_true(all( + unique(actual1$tsum$DPTVAL) == c("median", "q25", "q75", "whiskerlow", "whiskerup", "outliers") + )) +}) + + +test_that("Test 3: Check errors", { + expect_equal( + msumstat( + datain = adsl_entry |> filter(TRTVAR == "A"), + dptvar = "BMIBL", + statvar = "", + sigdec = 2 + ), + adsl_entry |> filter(TRTVAR == "A") + ) + expect_equal( + msumstat( + datain = adsl_entry, + dptvar = "BMIBL", + a_subset = "TRTVAR == 'A'", + statvar = "", + sigdec = 2 + ), + adsl_entry |> filter(TRTVAR == "A") + ) + expect_error( + msumstat( + datain = adsl_entry, + dptvar = "YVAR", + statvar = "", + sigdec = 2 + ), + "Dependent Variable does not Exist" + ) + nostat <- msumstat( + datain = adsl_entry, + dptvar = "AGE", + statvar = "pvalue", + sigdec = 2 + ) + expect_equal(unique(nostat$gsum$pvalue), "_NO_STAT") +}) + +test_that("Test 4: Filter", { + m_filt <- msumstat( + datain = adsl_entry, + a_subset = "SEX == 'F'", + dptvar = "AGE", + statvar = "mean", + sigdec = 2 + ) + expect_true(unique(m_filt$gsum$SUBGRPVAR1) == "F") +}) + +test_that("Test 5: Sparse by value", { + adsl_entry <- mentry( + datain = adsl, + subset = "EFFFL=='Y'", + byvar = "SEX", + trtvar = "TRT01A", + trtsort = "TRT01AN", + pop_fil = NA + ) + + adsl_sum <- adsl_entry |> + msumstat( + dptvar = "AGE", + a_subset = "SEX == 'F'", + statvar = "mean(sd)~median(minmaxc)~q3", + sigdec = "3(2)~2(0)~1", + sparsebyvalyn = "Y" + ) + expect_equal(unique(adsl_sum$gsum$BYVAR1), c("F", "M")) +}) diff --git a/tests/testthat/test-occ_tier_summary.R b/tests/testthat/test-occ_tier_summary.R index 9f83672..2cc7307 100644 --- a/tests/testthat/test-occ_tier_summary.R +++ b/tests/testthat/test-occ_tier_summary.R @@ -1,9 +1,29 @@ +data("adae") +data("adsl") ae_pre_process <- ae_pre_processor( datain = adae, - ae_filter = "Any Event", - obs_residual = 0, - fmq_data = FMQ_Consolidated_List + fmq_data = NA ) +adae1 <- adae |> + mutate(ASEVN = recode(.data[["AESEV"]], "MILD" = 1, "MODERATE" = 2, "SEVERE" = 3)) +ae_pre <- ae_pre_processor( + adae1, + subset = "TRTEMFL == 'Y'", + max_sevctc = "SEV", + pt_total = "Y" +) +ae_entry_max <- ae_pre[["data"]] |> + mentry( + subset = NA, + byvar = "AEBODSYS", + trtvar = "TRTA", + trtsort = "TRTAN", + trttotalyn = "N", + add_grpmiss = "N", + subgrpvar = "AESEV", + sgtotalyn = "N", + pop_fil = "Overall Population" + ) ae_entry <- ae_pre_process[["data"]] |> mentry( subset = NA, @@ -16,7 +36,7 @@ ae_entry <- ae_pre_process[["data"]] |> pop_fil = "Overall Population" ) -test_that("Standard inputs for occ_tier works", { +test_that("occ_tier standard inputs works", { output <- occ_tier_summary( ae_entry, a_subset = ae_pre_process[["a_subset"]], @@ -24,18 +44,17 @@ test_that("Standard inputs for occ_tier works", { hterm = "AEBODSYS", lterm = "AEDECOD", pctdisp = "TRT", - cutoff = 5, + cutoff_where = "PCT > 10 & FREQ > 20", apply_hrow_cutoff = "N", sort_opt = "Ascending", sort_var = "Count" ) expect_s3_class(output, "data.frame") - # Check treatments are accounted: - all(unique(output$TRTVAR) %in% unique(ae_entry$TRTVAR)) - expect_snapshot(output) + expect_true(unique(trimws(output$SUBGRPVARX)) == "n (%)") + expect_snapshot(print(output, n = Inf, width = Inf)) }) -test_that("Standard inputs for occ_tier works", { +test_that("occ_tier modified inputs works", { output <- occ_tier_summary( ae_entry, a_subset = ae_pre_process[["a_subset"]], @@ -43,80 +62,65 @@ test_that("Standard inputs for occ_tier works", { hterm = "AEBODSYS", lterm = "AEDECOD", pctdisp = "TRT", - cutoff = 5, - apply_hrow_cutoff = "N", - sort_opt = "Ascending", - sort_var = "Count" + cutoff_where = "PCT > 10 & FREQ > 20", + apply_hrow_cutoff = "Y", + nolwrtierdispyn = "Y", + htermctyn = "N", + sort_opt = "Alphabetical", + sum_row = "Y", + sum_row_label = "Any Adverse Event" ) expect_s3_class(output, "data.frame") - # Check treatments are accounted: - all(unique(output$TRTVAR) %in% unique(ae_entry$TRTVAR)) - expect_snapshot(output) + expect_true(unique(trimws(output$SUBGRPVARX)) == "n (%)") + expect_snapshot(print(output, n = Inf, width = Inf)) }) -test_that("Cut off applied for occ_tier works", { +test_that("Empty Outputs", { output <- occ_tier_summary( - ae_entry, + data.frame(), a_subset = ae_pre_process[["a_subset"]], summary_by = "Patients", hterm = "AEBODSYS", lterm = "AEDECOD", pctdisp = "TRT", - cutoff = 5, apply_hrow_cutoff = "Y", - sort_opt = "Alphabetical", - sort_var = "Count" + nolwrtierdispyn = "N", + htermctyn = "N", + sort_opt = "Alphabetical" ) expect_s3_class(output, "data.frame") - # Check treatments are accounted: - all(unique(output$TRTVAR) %in% unique(ae_entry$TRTVAR)) - expect_snapshot(output) -}) - -test_that("Cut off too high", { - output <- occ_tier_summary( + expect_equal(nrow(output), 0) + output1 <- occ_tier_summary( ae_entry, a_subset = ae_pre_process[["a_subset"]], summary_by = "Patients", hterm = "AEBODSYS", lterm = "AEDECOD", pctdisp = "TRT", - cutoff = 40, + cutoff_where = "PCT > 50", apply_hrow_cutoff = "Y", - sort_opt = "Alphabetical", - sort_var = "Count" + htermctyn = "N", + sort_opt = "Alphabetical" ) - expect_s3_class(output, "data.frame") - expect_equal(output, data.frame("Note" = "No low term data available under these conditions")) + expect_equal(nrow(output1), 0) }) -test_that("Errors resolved correctly", { - expect_error( - occ_tier_summary( - data.frame(), - a_subset = ae_pre_process[["a_subset"]], - summary_by = "Patients", - hterm = "AEBODSYS", - lterm = "AEDECOD", - pctdisp = "TRT", - cutoff = 0, - apply_hrow_cutoff = "Y", - sort_opt = "Alphabetical", - sort_var = "Count" - ), "Input data is empty" - ) - expect_error( - occ_tier_summary( - ae_entry, - a_subset = ae_pre_process[["a_subset"]], - summary_by = "Patients", - hterm = "RACE", - lterm = "AEDECOD", - pctdisp = "TRT", - cutoff = 0, - apply_hrow_cutoff = "Y", - sort_opt = "Alphabetical", - sort_var = "Count" - ) +test_that("occ_tier standard inputs works max severity", { + output <- occ_tier_summary( + ae_entry_max, + a_subset = ae_pre[["a_subset"]], + summary_by = "Patients", + hterm = "AEBODSYS", + lterm = "AEDECOD", + cutoff_where = "FREQ > 5", + pctdisp = "TRT", + sum_row = "Y", + sum_row_label = "Any Adverse Event", + nolwrtierdispyn = "N", + sort_opt = "Alphabetical", + stathead = "n" ) + expect_s3_class(output, "data.frame") + expect_true(unique(trimws(output$SUBGRPVARX)) == "n") + expect_snapshot(print(output, n = Inf, width = Inf)) }) diff --git a/tests/testthat/test-risk_stat.R b/tests/testthat/test-risk_stat.R index 723380b..18b20cf 100644 --- a/tests/testthat/test-risk_stat.R +++ b/tests/testthat/test-risk_stat.R @@ -1,4 +1,8 @@ -data("ae_pre_process") +data("adae") +ae_pre_process <- ae_pre_processor( + datain = adae, + ae_filter = "Any Event" +) ae_entry <- mentry( datain = ae_pre_process$data, subset = NA, @@ -12,39 +16,28 @@ ae_entry <- mentry( pop_fil = "SAFFL" ) dsin1 <- ae_entry |> - filter(AEDECOD %in% c("NAUSEA", "SINUS BRADYCARDIA")) + filter(.data[["AEDECOD"]] %in% c("NAUSEA", "SINUS BRADYCARDIA")) denom <- dsin1 |> - filter(TRTVAR %in% c("Placebo", "Xanomeline High Dose")) |> - group_by(TRTVAR) |> - summarise(N = length(unique(USUBJID))) |> + filter(.data[["TRTVAR"]] %in% c("Placebo", "Xanomeline High Dose")) |> + group_by(.data[["TRTVAR"]]) |> + summarise(N = length(unique(.data[["USUBJID"]]))) |> ungroup() freq <- dsin1 |> - filter(TRTVAR %in% c("Placebo", "Xanomeline High Dose") & - eval(parse(text = ae_pre_process$a_subset))) |> - group_by(TRTVAR, AEBODSYS, AEDECOD) |> - summarise(n = length(unique(USUBJID))) |> + filter(.data[["TRTVAR"]] %in% c("Placebo", "Xanomeline High Dose")) |> + group_by(.data[["TRTVAR"]], .data[["AEBODSYS"]], .data[["AEDECOD"]]) |> + summarise(n = length(unique(.data[["USUBJID"]]))) |> ungroup() exp <- left_join(denom, freq, by = "TRTVAR") -idvar <- c("AEBODSYS", "AEDECOD") -exp1 <- exp |> - mutate(TRTVAR = case_when( - TRTVAR == "Placebo" ~ "ctrlgrp", - TRTVAR == "Xanomeline High Dose" ~ "trtgrp" - )) |> - tidyr::pivot_wider(id_cols = any_of(c(idvar)), names_from = TRTVAR, values_from = c(N, n)) |> - mutate( - temp1 = N_ctrlgrp - n_ctrlgrp, - temp2 = N_trtgrp - n_trtgrp - ) mat <- matrix(c(2, 7, 3, 6), nrow = 2) + # testcase 1 test_that("Test Case 1: Check if the function gives expected statistic values", { - risk <- suppressWarnings(epitools::riskratio.wald(mat, conf.level = 1 - 0.05)) + risk <- suppressWarnings(epitools::riskratio.wald(mat, conf.level = 1 - 0.05, correction = TRUE)) risk_val <- round(risk$measure[2, 1], 3) pval <- round(risk$p.value[2, 3], 4) @@ -52,14 +45,13 @@ test_that("Test Case 1: Check if the function gives expected statistic values", ciu <- round(risk$measure[2, 3], 2) expected <- exp |> - filter(AEDECOD == "NAUSEA") |> + filter(.data[["AEDECOD"]] == "NAUSEA") |> mutate( RISK = risk_val, PVALUE = pval, RISKCIL = cil, RISKCIU = ciu, - PCT = round((n * 100) / N, 2), - TRTVAR = as.character(TRTVAR) + PCT = (.data[["n"]] * 100) / .data[["N"]] ) risk_s <- risk_stat( @@ -71,26 +63,28 @@ test_that("Test Case 1: Check if the function gives expected statistic values", trtgrp = "Xanomeline High Dose", statistics = "Risk Ratio", alpha = 0.05, - cutoff = 2, + cutoff_where = "PCT > 2", sort_opt = "Ascending", sort_var = "Count" ) actual <- risk_s |> - rename(AEBODSYS = BYVAR1, AEDECOD = DPTVAL, N = TOTAL_N, n = FREQ) |> - filter(AEDECOD == "NAUSEA") |> + rename(all_of(c("AEBODSYS" = "BYVAR1", "AEDECOD" = "DPTVAL", "N" = "TOTAL_N", "n" = "FREQ"))) |> + filter(.data[["AEDECOD"]] == "NAUSEA") |> mutate( - N = as.integer(N), - n = as.integer(n) + N = as.integer(.data[["N"]]), + n = as.integer(.data[["n"]]) ) |> - select(TRTVAR, N, AEBODSYS, AEDECOD, n, RISK, PVALUE, RISKCIL, RISKCIU, PCT) + select(all_of( + c("TRTVAR", "N", "AEBODSYS", "AEDECOD", "n", "RISK", "PVALUE", "RISKCIL", "RISKCIU", "PCT") + )) expect_equal(actual$RISK, expected$RISK) expect_equal(actual$PVALUE, expected$PVALUE) expect_equal(actual, expected, ignore_attr = TRUE) }) -# testcae 2 +# test case 2 test_that("Test Case 2: Check if the function works as expected for risk difference", { risk <- suppressWarnings(riskdiff_wald(mat, conf.level = 1 - 0.05)) @@ -101,13 +95,12 @@ test_that("Test Case 2: Check if the function works as expected for risk differe cil <- round(risk$measure[2, 3], 4) expected <- exp |> - filter(AEDECOD == "NAUSEA") |> + filter(.data[["AEDECOD"]] == "NAUSEA") |> mutate( RISK = risk_val, - PVALUE = pval, - TRTVAR = as.character(TRTVAR) + PVALUE = pval ) |> - arrange(desc(RISK)) + arrange(.data[["AEDECOD"]]) risk_s <- risk_stat( datain = dsin1, @@ -118,26 +111,25 @@ test_that("Test Case 2: Check if the function works as expected for risk differe trtgrp = "Xanomeline High Dose", statistics = "Risk Difference", alpha = 0.05, - cutoff = 0, - sort_opt = "Descending", - sort_var = "RiskValue" + sort_opt = "Alphabetical" ) actual <- risk_s |> - rename(AEBODSYS = BYVAR1, AEDECOD = DPTVAL, N = TOTAL_N, n = FREQ) |> - filter(AEDECOD == "NAUSEA") |> + rename(all_of(c("AEBODSYS" = "BYVAR1", "AEDECOD" = "DPTVAL", "N" = "TOTAL_N", "n" = "FREQ"))) |> + filter(.data[["AEDECOD"]] == "NAUSEA") |> mutate( - N = as.integer(N), - n = as.integer(n) + N = as.integer(.data[["N"]]), + n = as.integer(.data[["n"]]) ) |> - select(TRTVAR, N, AEBODSYS, AEDECOD, n, RISK, PVALUE) + select(all_of(c("TRTVAR", "N", "AEBODSYS", "AEDECOD", "n", "RISK", "PVALUE"))) + expected$RISK <- -1 * (expected$RISK) expect_equal(actual$RISK, expected$RISK) expect_equal(actual$PVALUE, expected$PVALUE) expect_equal(actual, expected, ignore_attr = TRUE) }) -# test case 1 +# test case 3 test_that("riskdiff_wald: check if the function works as expected", { evts <- 4 @@ -145,36 +137,14 @@ test_that("riskdiff_wald: check if the function works as expected", { control_evts <- 3 cne <- 8 - expected_output <- (evts / (evts + non_evts)) - (control_evts / (control_evts + cne)) + expected_output <- (control_evts / (control_evts + cne)) - (evts / (evts + non_evts)) actual <- suppressWarnings(riskdiff_wald(matrix(c(evts, control_evts, non_evts, cne), nrow = 2))) actual_output <- actual$measure[2, 1] expect_equal(actual_output, expected_output, ignore_attr = TRUE) }) -# test case 2 - -test_that("riskdiff_wald: check for error if `y` argument is not NULL", { - evts <- 4 - non_evts <- 6 - control_evts <- 3 - cne <- 8 - input <- matrix(c(evts, control_evts, non_evts, cne), nrow = 2) - - expect_error( - suppressWarnings( - riskdiff_wald( - x = input, - y = 2, - conf.level = 0.95, - rev = c("neither", "rows", "columns", "both"), - correction = FALSE, - verbose = FALSE - ) - ), - regexp = paste("y argument should be NULL") - ) -}) +# test case 4 test_that("risk_stat: returns empty data frame when cutoff is too high", { actual <- risk_stat( @@ -186,7 +156,7 @@ test_that("risk_stat: returns empty data frame when cutoff is too high", { trtgrp = "Xanomeline High Dose", statistics = "Risk Ratio", alpha = 0.05, - cutoff = 500, + cutoff_where = "FREQ > 500", sort_opt = "Ascending", sort_var = "Count" ) diff --git a/tests/testthat/test-riskdiff_wald.R b/tests/testthat/test-riskdiff_wald.R deleted file mode 100644 index 81de577..0000000 --- a/tests/testthat/test-riskdiff_wald.R +++ /dev/null @@ -1,36 +0,0 @@ -# test case 1 - -test_that("check if the function works as expected", { - evts <- 4 - non_evts <- 6 - control_evts <- 3 - cne <- 8 - - expected_output <- (evts / (evts + non_evts)) - (control_evts / (control_evts + cne)) - actual <- riskdiff_wald(matrix(c(evts, control_evts, non_evts, cne), nrow = 2)) - actual_output <- actual$measure[2, 1] - - expect_equal(expected_output, actual_output) -}) - -# test case 2 - -test_that("check for error if `y` argument is not NULL", { - evts <- 4 - non_evts <- 6 - control_evts <- 3 - cne <- 8 - input <- matrix(c(evts, control_evts, non_evts, cne), nrow = 2) - - expect_error( - riskdiff_wald( - x = input, - y = 2, - conf.level = 0.95, - rev = c("neither", "rows", "columns", "both"), - correction = FALSE, - verbose = FALSE - ), - regexp = paste("y argument should be NULL") - ) -}) diff --git a/tests/testthat/test-scatter_plot.R b/tests/testthat/test-scatter_plot.R new file mode 100644 index 0000000..f46fe81 --- /dev/null +++ b/tests/testthat/test-scatter_plot.R @@ -0,0 +1,43 @@ +library(carver) +library(dplyr) +data(adsl) + +mentry_df <- adlb |> + mentry( + subset = "PARAMCD %in% c('ALT', 'BILI') & !is.na(ANRHI)", + byvar = NA_character_, + trtvar = "TRTA", + trtsort = "TRTAN", + subgrpvar = NA_character_, + trttotalyn = "N", + add_grpmiss = "N", + pop_fil = "SAFFL" + ) |> + group_by(.data[["USUBJID"]], .data[["TRTVAR"]], .data[["PARAMCD"]]) |> + summarise(AVAL_N = max(.data[["AVAL"]])) |> + tidyr::pivot_wider( + id_cols = c("USUBJID", "TRTVAR"), names_from = "PARAMCD", values_from = "AVAL_N" + ) |> + mutate(XVAR = .data[["ALT"]], YVAR = .data[["BILI"]]) +fig <- mentry_df |> + scatter_plot( + axis_opts = plot_axis_opts(), + series_var = "TRTVAR", + series_labelvar = "TRTVAR", + series_opts = list( + shape = c(16, 17, 18), + color = scales::hue_pal()(3), + size = c(2, 2, 3) + ), + legend_opts = list( + label = "Treatment", + pos = "bottom", + dir = "horizontal" + ), + plot_title = "Scatter Plot of maximum ALT vs BILI" + ) + +test_that("scatter_plot works as expected", { + expect_snapshot(print(tibble::as_tibble(fig[["data"]]), n = Inf)) + purrr::walk(c("mapping", "theme", "labels"), \(y) expect_snapshot(fig[[y]])) +}) diff --git a/tests/testthat/test-stat_utils.R b/tests/testthat/test-stat_utils.R new file mode 100644 index 0000000..fad001b --- /dev/null +++ b/tests/testthat/test-stat_utils.R @@ -0,0 +1,96 @@ +# Test stat Utils functions + +# Function: fmtrd +test_that("Test fmtrd function for calculation and precision", { + # 1: Applying fmtrd function with mean + # Test Data + sample_data <- c(10.23, 20, NA, 40, 50, 75.567) + mean_1 <- round_f(mean(sample_data, na.rm = TRUE), 2) + max_1 <- round_f(max(sample_data, na.rm = TRUE), 2) + expect_equal(fmtrd("mean")(sample_data), mean_1) + expect_equal(fmtrd("max")(sample_data), max_1) + # Significant decimal resolved correctly + mean_2 <- round_f(mean(sample_data, na.rm = TRUE), 3) + expect_equal(fmtrd("mean", d = 3)(sample_data), mean_2) +}) + +test_that("Test parse_stats", { + actual <- parse_stats( + statvar = c("mean(sd)", "median(minmax)", "stderr"), + statdec = c("3(2)", "2(1)", "3") + ) + expected <- setNames( + c("3", "2", "2", "1", "1", "3"), + c("mean", "sd", "median", "min", "max", "stderr") + ) + expect_equal(actual, expected) + actual1 <- parse_stats( + statvar = c("mean(sd)", "sd"), + statdec = "" + ) + expect_equal(actual1, c("mean" = "2", "sd" = "2")) + actual2 <- parse_stats( + statvar = c("mean", "sd"), + statdec = 2 + ) + expect_equal(actual2, c("mean" = 2, "sd" = 2)) +}) + +dist <- rnorm(20) +test_that("Test summary_functions", { + stats <- c( + "mean", "q1", "geomean", "geosd", "geomean_lowci", "geomean_upci", + "outliers", "n", "newstat" + ) + actual <- summary_functions( + statvar = stats, + statdec = rep(2, 8) + ) + expect_named(actual, stats) + expect_equal(actual$newstat(), "_NO_STAT") + logx <- log(dist) + margin <- qt(0.975, df = length(logx) - 1) * sd(logx, na.rm = TRUE) / sqrt(length(logx)) + expected <- round_f(exp(mean(logx, na.rm = TRUE) + c(-1, 1) * margin), 2) + expect_equal(actual$geomean_lowci(dist), expected[1]) + expect_equal(actual$geomean_upci(dist), expected[2]) + expect_true(is.character(actual$outliers(dist))) +}) + +test_that("Test summary_functions outputs", { + stats <- c( + "mean", "q1", "geomean", "geosd", "geomean_lowci", "geomean_upci", + "outliers", "n", "newstat" + ) + actual <- summary_functions( + statvar = stats, + statdec = rep(2, 8) + ) + expect_named(actual, stats) + expect_equal(actual$newstat(), "_NO_STAT") +}) + +test_that("Test Tukey's stats", { + exp <- min(dist[(dist >= (quantile(dist, 0.25, na.rm = TRUE) - 1.5 * IQR(dist, na.rm = TRUE))) & + (dist <= quantile(dist, 0.25, na.rm = TRUE))], na.rm = TRUE) + expect_equal(whiskerlow(dist), exp) + exp2 <- max(dist[(dist <= (quantile(dist, 0.75, na.rm = TRUE) + 1.5 * IQR(dist, na.rm = TRUE))) & + (dist >= quantile(dist, 0.75, na.rm = TRUE))], na.rm = TRUE) + expect_equal(whiskerup(dist), exp2) +}) + +test_that("Test derv_stats", { + actual <- msumstat(adsl, + dptvar = "AGE", + statvar = "stderr~mean(sd)", + sigdec = "2~3(2)" + ) + testout <- msumstat(adsl, + dptvar = "AGE", + statvar = "stderr~mean~sd", + sigdec = "2~3~2" + ) + expected <- testout$gsum |> + dplyr::mutate(`mean(sd)` = paste0(.data[["mean"]], " (", .data[["sd"]], ")")) |> + select(all_of(names(actual$gsum))) + expect_equal(actual$gsum, expected) +}) diff --git a/tests/testthat/test-tbl_display.R b/tests/testthat/test-tbl_display.R index ee2b100..a28f08b 100644 --- a/tests/testthat/test-tbl_display.R +++ b/tests/testthat/test-tbl_display.R @@ -12,7 +12,7 @@ adsl_entry <- mentry( adsl_sum <- adsl_summary( datain = adsl_entry, vars = "AGEGR1/AGEGR1N~AGE-S~SEX/SEXN~RACE/RACEN", - stat_vars = "N~Meansd" + stat_vars = "n~mean(sd)" ) tbl_data <- adsl_sum |> display_bign_head( @@ -50,7 +50,7 @@ tbl_data1 <- adsl_cat |> addrowvars = NA ) tbl1 <- tbl_data1 |> - tbl_display(bylabel = "Ethnicity") + tbl_display(bylabel = "Ethnicity", boldheadyn = "Y") test_that("tbl_processor works standard", { expect_s3_class(tbl_data, "data.frame") @@ -63,3 +63,26 @@ test_that("tbl_processor works without trt/dpt", { expect_snapshot(print(tbl_data1, n = Inf, width = Inf)) expect_true(class(tbl1) == "flextable") }) + +test_that("tbl_processor works with keepvars", { + testdata <- adsl_cat |> + mutate(NewCol = "Keepthis") + tbl_data2 <- testdata |> + display_bign_head( + mentry_data = adsl_entry1, + notrthead = "Participants, n (%)" + ) |> + tbl_processor( + disp_value_col = "N", + addrowvars = NA, + keepvars = "NewCol" + ) + expect_s3_class(tbl_data2, "data.frame") + expect_true("NewCol" %in% colnames(tbl_data2)) + expect_true(unique(tbl_data2$NewCol) == "Keepthis") +}) + +test_that("Empty_tbl works", { + tbl_empty <- empty_tbl() + expect_snapshot(tbl_empty) +}) diff --git a/tests/testthat/test-tornado_plot.R b/tests/testthat/test-tornado_plot.R index b545076..17f2894 100644 --- a/tests/testthat/test-tornado_plot.R +++ b/tests/testthat/test-tornado_plot.R @@ -1,18 +1,17 @@ -data(tornado_plot_data) +data("adsl") +data("adae") tornado_df <- process_tornado_data( - dataset_adsl = tornado_plot_data[["adsl"]], - dataset_analysis = tornado_plot_data[["adae"]], + dataset_adsl = adsl, + dataset_analysis = adae, adsl_subset = "SAFFL == 'Y'", - analysis_subset = NA_character_, - ae_filter = "Treatment emergent", + analysis_subset = "TRTEMFL == 'Y'", obs_residual = "30", fmq_data = NA, - ae_catvar = "AESEV", - trtvar = "ARMCD", - trt_left = "A", - trt_right = "A", - pop_fil = "Overall Population", + ae_catvar = "AESEV/AESEVN", + trtvar = "ARM", + trt_left = "Xanomeline High Dose", + trt_right = "Xanomeline Low Dose", pctdisp = "TRT", denom_subset = NA_character_, legendbign = "N", @@ -46,18 +45,16 @@ plot_out <- tornado_plot( test_that("Test Case 1: process_tornado_data throws expected error message", { expect_error( process_tornado_data( - dataset_adsl = tornado_plot_data[["adsl"]], + dataset_adsl = adsl, dataset_analysis = data.frame(), adsl_subset = "SAFFL == 'Y'", - analysis_subset = NA_character_, - ae_filter = "Treatment emergent", + analysis_subset = "TRTEMFL == 'Y'", obs_residual = "30", fmq_data = NA, ae_catvar = "AESEV", - trtvar = "ARMCD", - trt_left = "A", - trt_right = "A", - pop_fil = "Overall Population", + trtvar = "ARM", + trt_left = "Xanomeline High Dose", + trt_right = "Xanomeline Low Dose", pctdisp = "TRT", denom_subset = NA_character_, legendbign = "N", @@ -98,7 +95,7 @@ test_that("Test Case 4: tornado_plot throws expected error message", { test_that("Test Case 5: tornado_plot creates tornado plot", { purrr::walk( - plot_out, c("mapping", "theme", "labels"), + c("mapping", "theme", "labels"), \(y) expect_snapshot(plot_out[[y]]) ) }) diff --git a/tests/testthat/test-utils.R b/tests/testthat/test-utils.R index 48dd687..1953176 100644 --- a/tests/testthat/test-utils.R +++ b/tests/testthat/test-utils.R @@ -47,78 +47,7 @@ test_that("Case 2: With or without 'N'", { expect_equal(agen_start, c("AGEGR1N")) }) - -############################################################################# -# summary_functions - -test_that("Test 1: Summary functions return all functions", { - ui_sigDec <- 2 - list_stats <- summary_functions(ui_sigDec) - # Test - expect_named(list_stats, c( - "mean", "min", "max", "median", "iqr", "var", "sum", "sd", "q25", - "q75", "p1", "p10", "p5", "p90", "p95", "p99", "meansd", "range", - "q1q3", "medianrange", "whiskerlow", "whiskerup", "outliers", - "geom_lowci", "geom_upci", "geommean", "n" - )) -}) - -test_that("Test 2: Summary function returns expected values", { - list_stats <- summary_functions(2)[c("meansd", "q1q3", "n", "outliers", "range")] - actstats <- iris |> - group_by(Species) |> - summarise_at(.vars = "Sepal.Width", .funs = list_stats) - fn_outlier <- function(x) { - x <- x[!is.na(x)] - paste(unique(x[x < min( - x[(x >= (quantile(x, 0.25) - 1.5 * IQR(x))) & (x <= quantile(x, 0.25))] - ) | - x > max( - x[(x <= (quantile(x, 0.75) + 1.5 * IQR(x))) & (x >= quantile(x, 0.75))] - )]), collapse = "~") - } - expstats <- iris |> - group_by(Species) |> - summarise( - meansd = paste0( - round_f(mean(.data[["Sepal.Width"]]), 2), - " (", round_f(sd(.data[["Sepal.Width"]]), 3), ")" - ), - q1q3 = paste0( - "(", round_f(quantile(.data[["Sepal.Width"]], 0.25), 2), ", ", - round_f(quantile(.data[["Sepal.Width"]], 0.75), 2), ")" - ), - n = as.character(n()), - outliers = fn_outlier(.data[["Sepal.Width"]]), - range = paste0( - "(", round_f(min(.data[["Sepal.Width"]]), 2), ", ", - round_f(max(.data[["Sepal.Width"]]), 2), ")" - ) - ) - expect_equal(actstats, expstats) -}) - -test_that("Test 3: Summary function returns expected values", { - set.seed(123) - test_data <- rnorm(100, mean = 10, sd = 2) - expected_geom_lowci <- exp(mean(log(test_data), na.rm = TRUE) - - qt(0.975, df = length(test_data) - 1) * - sd(log(test_data)) / sqrt(length(test_data))) - expected_geom_upci <- exp(mean(log(test_data), na.rm = TRUE) + - qt(0.975, df = length(test_data) - 1) * - sd(log(test_data)) / sqrt(length(test_data))) - expected_geommean <- exp(mean(log(test_data), na.rm = TRUE)) - - expect_equal(summary_functions()$geom_lowci(test_data), paste(expected_geom_lowci)) - expect_equal(summary_functions()$geom_upci(test_data), paste(expected_geom_upci)) - expect_equal(summary_functions()$geommean(test_data), paste(expected_geommean)) -}) - -############################################################################# - # Function: split_section_headers - - # Test Data adsl_entry <- mentry( @@ -242,19 +171,6 @@ test_that("Test round_f() works", { expect_equal(round_f(13.4, 2), "13.40") expect_equal(round_f(12.243, 1), "12.2") }) -# Function: fmtrd -test_that("Test fmtrd function for calculation and precision", { - # 1: Applying fmtrd function with mean - # Test Data - sample_data <- c(10.23, 20, NA, 40, 50, 75.567) - mean_1 <- round_f(mean(sample_data, na.rm = TRUE), 2) - max_1 <- round_f(max(sample_data, na.rm = TRUE), 2) - expect_equal(fmtrd("mean")(sample_data), mean_1) - expect_equal(fmtrd("max")(sample_data), max_1) - # Significant decimal resolved correctly - mean_2 <- round_f(mean(sample_data, na.rm = TRUE), 3) - expect_equal(fmtrd("mean", d = 3)(sample_data), mean_2) -}) test_that("ord_summ_df works as expected", { actual <- iris |> @@ -400,3 +316,97 @@ test_that("display_bign_head works as expected without treatment/subgrp", { select(-all_of("CVALUE")) expect_equal(actual, exp, ignore_attr = TRUE) }) + +test_that("sparse_vals works as expected", { + data_entry <- mentry( + adsl, + byvar = "SEX", + trtvar = "TRT01A", + trtsort = "TRT01AN", + subset = "SAFFL == 'Y'" + ) |> + mutate(DPTVAL = .data[["AGEGR1"]], DPTVALN = .data[["AGEGR1N"]]) + count <- data_entry |> + dplyr::filter(.data[["SEX"]] == "F") |> + group_by(across(all_of(c("BYVAR1", "TRTVAR", "DPTVAL")))) |> + summarise(FREQ = length(unique(.data[["USUBJID"]]))) + actual <- sparse_vals( + count, + data_sparse = data_entry, + sparseyn = "N", + sparsebyvalyn = "Y", + "BYVAR1", + character(0), + "BYVAR1N", + character(0) + ) + expect_s3_class(actual, "data.frame") + expect_equal(setdiff(unique(actual$BYVAR1), unique(count$BYVAR1)), "M") + expect_equal(unique(actual$FREQ[actual$BYVAR1 == "M"]), 0) + count1 <- data_entry |> + dplyr::filter(.data[["AGEGR1"]] != "<65") |> + group_by(across(all_of(c("BYVAR1", "TRTVAR", "DPTVAL")))) |> + summarise(FREQ = length(unique(.data[["USUBJID"]]))) + actual1 <- sparse_vals( + count1, + data_sparse = data_entry, + sparseyn = "Y", + sparsebyvalyn = "N", + "BYVAR1", + character(0), + "BYVAR1N", + character(0) + ) + expect_s3_class(actual1, "data.frame") + expect_equal(setdiff(unique(actual1$DPTVAL), unique(count1$DPTVAL)), "<65") + actual2 <- sparse_vals( + count1, + data_sparse = data_entry, + sparseyn = "N", + sparsebyvalyn = "N", + "BYVAR1", + character(0), + "BYVAR1N", + character(0) + ) + expect_s3_class(actual2, "data.frame") + expect_equal(actual2, count1) +}) + +test_that("sparse_vals with summary stat", { + data_entry <- mentry( + adsl, + byvar = "SEX", + trtvar = "TRT01A", + trtsort = "TRT01AN", + subset = "SAFFL == 'Y'" + ) + sums <- data_entry |> + dplyr::filter(.data[["SEX"]] == "F") |> + group_by(across(all_of(c("BYVAR1", "TRTVAR")))) |> + summarise(mean = as.character(mean(.data[["AGE"]], na.rm = TRUE))) + actual <- sparse_vals( + sums, + data_sparse = data_entry, + sparseyn = "N", + sparsebyvalyn = "Y", + "BYVAR1", + character(0), + "BYVAR1N", + character(0), + fillvar = "mean", + fill_with = "-" + ) + expect_s3_class(actual, "data.frame") + expect_equal(setdiff(unique(actual$BYVAR1), unique(sums$BYVAR1)), "M") + expect_equal(unique(actual$mean[actual$BYVAR1 == "M"]), "-") +}) + +test_that("dataset_vignette works", { + actual <- dataset_vignette(adsl, c("USUBJID", "TRT01A"), subset = "AGE >= 88") + expdata <- filter(adsl, .data[["AGE"]] >= 88) + expect_true("datatables" %in% class(actual)) + expect_s3_class(actual$x$data, "data.frame") + expect_equal(nrow(actual$x$data), nrow(expdata)) + expect_equal(ncol(actual$x$data), ncol(expdata)) +}) diff --git a/vignettes/adsl_summary.Rmd b/vignettes/adsl_summary.Rmd new file mode 100644 index 0000000..082e1ce --- /dev/null +++ b/vignettes/adsl_summary.Rmd @@ -0,0 +1,153 @@ +--- +title: "Subject Level Summary Table" +output: + rmarkdown::html_vignette: + highlight: haddock + code_folding: show + df_print: paged +vignette: > + %\VignetteIndexEntry{Subject Level Summary Table} + %\VignetteEngine{knitr::rmarkdown} + %\VignetteEncoding{UTF-8} +--- +```{=html} + +``` +```{=html} + +``` +```{=html} + +``` + +# Introduction + +This article describes creating reports which can be classified as ADSL Summary Tables using `adsl_summary` function. Example here is created using `ADSL` domain. + +**Note:** *All examples assume CDISC ADaM format as input unless otherwise specified.* + +# Programming Flow + +- [Read in Data](#readdata) +- [Preprocess Data](#preprocess) +- [ADSL Summary Table](#summarisation) +- [ADSL Table Display](#output) + +## Read in Data {#readdata} + +```{r message=FALSE, warning=FALSE} +library(carver) +library(dplyr) +library(purrr) # nolint +data(adsl) +``` + +## Preprocess Data {#preprocess} + +Before creating `adsl_summary`, it is required to use the pre-processing function: `mentry` which serves as an essential step in preparing the data for summarisation. + +### `mentry()` + +The next step in pre-processing involves the usage of `mentry` function to read and process data +with subsets and variables. It takes in the `adsl` as input . The input data gets processed +based on `TRT`(mandatory variable for generating columns in the final table), `BY`(optional variable used to group rows in the final table) and/or `SUBGROUP`(optional variable used to add subgroups under the columns-TRT in the final table) variables and filtered by subset conditions. + +**Note:** *For additional information such as parameters info, refer to the mentry() documentation.* + +```{r message=FALSE, warning=FALSE} +mentry_df <- adsl |> + mentry( + subset = NA_character_, + byvar = NA_character_, + trtvar = "TRT01A", + trtsort = "TRT01AN", + subgrpvar = NA_character_, + trttotalyn = "Y", + add_grpmiss = "N", + pop_fil = "SAFFL" + ) +``` + +```{r, echo=FALSE, message=FALSE, warning=FALSE} +dataset_vignette(as.data.frame(mentry_df)) +``` + +## ADSL Summary Table {#summarisation} + +This step is used in creating the ADSL summary table using the 'adsl_summary' function. + +The following are the arguments for the table: + +- `datain`: The input data for table generation. The output data from `mentry_df` function. +- `vars`: Names of `adsl` variables to display in final output which are tilde-separated, Add `"-S"` for numeric variables. +- `stat_vars`: Statistics to display in table for numeric vars, tilde-separated. +- `pctdisp`: Denominator to calculate percentages by. +Values: `"TRT", "VAR", "COL", "SUBGRP", "SGRPN", "CAT", "NONE", "NO", "DPTVAR"`. +- `total_catyn` To return a 'Total' row for categorical analysis in `vars`. Values: `"Y"/"N"` +- `total_catlabel` Label for total category row. eg- "All"/"Total" +- `miss_catyn` To include empty/blank values as `miss_catlabel` in categories of `dptvar` variable or not. Values: `"Y"/"N"` +- `miss_catlabel` Label for missing values +- `a_subset` Analysis Subset condition; tilde-separated for each variable in `vars`. +- `denom_subset` Subset condition to be applied to dataset for calculating denominator, tilde-separated for categorical variables within `vars`. + +```{r message=FALSE, warning=FALSE} +adsl_sum <- mentry_df |> + adsl_summary( + vars = "AGEGR1/AGEGR1N~AGE-S~SEX/SEXN~RACE/RACEN", + stat_vars = "N~Range~Meansd~Median~IQR", + pctdisp = "TRT", + total_catyn = "N", + total_catlabel = "Total", + miss_catyn = "N", + miss_catlabel = "Missing", + a_subset = "AGE<65~AGE>80~SEX=='F'~NA", + denom_subset = NA_character_ + ) +``` + +```{r, echo=FALSE, message=FALSE, warning=FALSE} +dataset_vignette(as.data.frame(adsl_sum)) +``` + +## ADSL Table Display {#output} + +### Prepare data for general table display +This step is used creating the ADSL summary table using 'tbl_processor' function to prepare data for general table display. + +The following are the arguments: + +- `datain` Input dataframe. The output data from `adsl_summary` function. +- `dptlabel` Tilde-separated labels to set to category variables in data. +If analysis vars (`DPTVAR`) contains `AGEGR1, RACE`; `dptlabel` may be `"Age Group~Race"`. +- `statlabel` Tilde-separated labels corresponding to each Statistic in data. +- `extra_df` Additional dataframe, to merge with `datain`. +- `extra_mergeby` Variables to merge `extra_df` by, if present. +- `dropvars` Variables additional to standard present in input data to be removed from output +- `disp_value_col` Hide/Show value column from the final display. +- `addrowvars` Group Variable(s) to be removed as a column and instead used as row headers in the value column. + +### Create flextable output from display templates +This step is used creating the ADSL summary table using 'tbl_display' to create flextable output from display templates. + +The following are the arguments: + +- `datain` Input dataframe. The output data from `tbl_processor` function. +- `bylabel` Change `BYVAR` names to label, if any. +- `dpthead` String to become name of the column containing categories (`DPTVAL`) in output. +- `font` Font face for text inside table +- `fontsize` Font size for text inside table + +### ADSL Table Display Output {#output} +The ADSL Summary Table is generated successfully. Below is the Table generated: + +```{r message=FALSE, warning=FALSE} +adsl_sum |> + display_bign_head(mentry_data = mentry_df) |> + tbl_processor( + statlabel = "N~Range~Meansd~Median~IQR", + dptlabel = "Age Group~NONE~Sex~Race", + addrowvar = "DPTVAR" + ) |> + tbl_display() |> + flextable::autofit() +``` diff --git a/vignettes/tornado_plot.Rmd b/vignettes/tornado_plot.Rmd index 3d201fe..6d509bd 100644 --- a/vignettes/tornado_plot.Rmd +++ b/vignettes/tornado_plot.Rmd @@ -1,5 +1,5 @@ --- -title: "Adverse Events Tornado Plot for Oncology Studies" +title: "Adverse Events Tornado Plot" output: rmarkdown::html_vignette: highlight: haddock @@ -43,17 +43,20 @@ This article describes creating the Adverse Events Tornado Plot for Oncology To start, load required libraries and the in-built example `adae` and `adsl` dataset. ```{r data} -library(tlfcarver) +library(carver) library(dplyr) library(rlang) library(ggplot2) -data(tornado_plot_data) +data("adae") +data("adsl") ``` ## Process Data with Subsets and Variables {#processdata} -Before creating Oncology specific `tornado plot`, it's essential to use the `process_tornado_data()`. This function helps prepare the data for visualization, making it a crucial step. With this function, users can customize many parts of the plot to match their specific data and analysis needs. This function block consists mainly `adsl_merge()`, `ae_pre_processor()` and `mentry()` functions to combine ADSL variables, perform adverse-event specific pre-processing and filter records/set grouping variables. It also filters out the maximum severity based on the given inputs. Below, we'll explain the parameters used in `process_waterfall_data`:- +Before creating Adverse Events `tornado plot`, it's essential to use the `process_tornado_data()`. This function helps prepare the data for visualization, making it a crucial step. With this function, users can customize many parts of the plot to match their specific data and analysis needs. +While it is recommended that this be used for Oncology data, it can also work with non-Therapeutic Area specific ADaM datasets, which is shown in this example. +This function block consists mainly `adsl_merge()`, `ae_pre_processor()` and `mentry()` functions to combine ADSL variables, perform adverse-event specific pre-processing and filter records/set grouping variables. It also filters out the maximum severity based on the given inputs. Below, we'll explain the parameters used in `process_tornado_data`:- - `dataset_adsl`: This parameter is used to pass the variable containing `ADSL` dataset. @@ -75,8 +78,6 @@ Before creating Oncology specific `tornado plot`, it's essential to use the `pro - `trtsort`: This parameter is used for sorting the treatment variable. -- `ae_filter`: This parameter is condition to filter data set by vector of adverse event types. Valid values: "ANY", "ANY EVENT", "TREATMENT EMERGENT", "SERIOUS", "DRUG-RELATED", "RELATED", "MILD", "MODERATE", "SEVERE", "RECOVERED/RESOLVED", "RECOVERING/RESOLVING", "NOT RECOVERING/NOT RESOLVING", "FATAL", "GRADE N". - - `obs_residual`: This parameter is used to pass a period (numeric) to extend the observation period. If passed as NA, overall study duration is considered for analysis. eg. if 5, only events occurring upto 5 days past the TRTEDT are considered.. @@ -87,8 +88,6 @@ eg. if 5, only events occurring upto 5 days past the TRTEDT are considered.. - `denom_subset`: This parameter is a condition which is used to subset data set for calculating denominator. Default value is `NA`. - `pctdisp`: This parameter is a method that is used to calculate denominator (for %). Valid values: `"TRT"`, `"VAR"`, `"COL"`, `"SUBGRP"`, `"CAT"`, `"NONE"`, `"NO"`, `"DPTVAR"`, `"BYVARxyN"`. - -- `pop_fil`: This parameter filters the data set by population. eg: `"SAFFL"` - `legendbign`: This parameter determines whether `N` should be displayed in the legend. The default value is `Y` which suggests that by default, `N` is displayed in legend. Default value is `N`. @@ -96,31 +95,27 @@ eg. if 5, only events occurring upto 5 days past the TRTEDT are considered.. NOTE: Default/Example values are provided to give users a starting point. However, these values can be modified as necessary to better suit the specific data and visualization objectives. -The first step for creating `tornado_plot` for Oncology is to read the required datasets into the environment. In this example, `ADSL` and `ADAE` are used. +The first step for creating `tornado_plot` for Adverse Events is to read the required datasets into the environment. In this example, `ADSL` and `ADAE` are used. -Below is an example of calling `process_tornado_data` function for preprocessing the data for oncology tornado plot. +Below is an example of calling `process_tornado_data` function for preprocessing the data for tornado plot. ```{r tornado_plot_data, message=FALSE, warning=FALSE} -df <- - process_tornado_data( - dataset_adsl = tornado_plot_data[["adsl"]], - dataset_analysis = tornado_plot_data[["adae"]], - adsl_subset = "SAFFL == 'Y'", - analysis_subset = NA_character_, - ae_filter = "Treatment emergent", - obs_residual = "30", - fmq_data = NA, - ae_catvar = "AESEV", - trtvar = "ARMCD", - trt_left = "A", - trt_right = "A", - trtsort = NA_character_, - pop_fil = "Overall Population", - pctdisp = "TRT", - denom_subset = NA_character_, - legendbign = "N", - yvar = "AESOC" - ) +df <- process_tornado_data( + dataset_adsl = adsl, + dataset_analysis = adae, + adsl_subset = "SAFFL == 'Y'", + analysis_subset = "TRTEMFL == 'Y'", + obs_residual = "30", + fmq_data = NA, + ae_catvar = "AESEV/AESEVN", + trtvar = "ARM", + trt_left = "Xanomeline High Dose", + trt_right = "Xanomeline Low Dose", + pctdisp = "TRT", + denom_subset = NA_character_, + legendbign = "N", + yvar = "AESOC" +) ``` The `process_tornado_data` returns `data.frame` which gets stored in `df` above. A pre-processed dataset which is the input for Oncology tornado plot. @@ -171,7 +166,7 @@ plot <- tornado_plot( ), legend_opts = list( label = "Severity", - pos = c(0.15, 0.15), + pos = c(0.2, 0.15), dir = "vertical" ), series_opts = series_opts,