Merge pull request #37 from Merck/tidy_up_package

Tidy up package

R/format_sl_summary.R

@@ -101,7 +101,8 @@ format_sl_summary <- function(
   n_within <- length(within_tbl)
   n_row <- ncol(tbl[["n"]])
   within_tbl <- do.call(cbind, within_tbl)
-  within_tbl <- within_tbl[!duplicated(as.list(within_tbl))]
+
+  within_tbl <- within_tbl[, !duplicated(names(within_tbl))]
   within_tbl <- within_tbl[, c(
     1, do.call(c, lapply(
       2:(1 + n_group + ifelse("total" %in% display_col, 1, 0)),

R/react_base_char.R

@@ -80,7 +80,7 @@ react_base_char <- function(
   x_sl <- metadata_sl |>
     prepare_sl_summary(
       population = population,
-      analysis = "base_char",
+      analysis = metadata_sl$plan$analysis,
       parameter = sl_parameter
     ) |>
     format_base_char(display_col = display_sl, digits_prop = 2)

vignettes/Disposition.Rmd

@@ -33,14 +33,14 @@ To accomplish this using metalite.sl, four essential functions are required:
 
 - `prepare_disposition ()`:subset data for disposition analysis.
 
-- `format_trt_compliance()`: prepare analysis (mock) outdata with proper format.
+- `format_disposition()`: prepare analysis outdata with proper format.
 
-- `rtf_disposition ()`: transfer (mock) output dataset to RTF table.
+- `rtf_disposition ()`: transfer output dataset to RTF table.
 
 An example output:
 
 ```{r, out.width = "100%", out.height = "400px", echo = FALSE, fig.align = "center"}
-knitr::include_graphics("outtable/disposition.pdf")
+knitr::include_graphics("outtable/pdf/disposition.pdf")
 ```
 
 
@@ -69,12 +69,10 @@ adsl$TRTA <- factor(adsl$TRTA,
 adsl$EOSSTT <- sample(x = c("Participants Ongoing", "Discontinued"),
                       size = length(adsl$USUBJID), 
                       prob = c(0.8, 0.2), replace = TRUE)
+
 # Create a variable EOTSTT1 indicating the end of treatment status part 1
-adsl$EOTSTT1 <- sample(x = c("Completed", "Discontinued"),
-                      size = length(adsl$USUBJID), 
-                      prob = c(0.85, 0.15), replace = TRUE)
-adsl <- adsl %>%
-  mutate(DCTREAS = ifelse(DISCONFL == "Y", DCREASCD, "ZStatus Not Recorded"))
+adsl$EOTSTT1 <- ifelse(adsl$DISCONFL == "Y", "Discontinued", "Completed")
+adsl$DCTREAS<- ifelse(adsl$EOTSTT1 == "Discontinued" & adsl$EOSSTT == "Discontinued", adsl$DCREASCD, NA)
 head(adsl)
 
 ```
@@ -142,22 +140,6 @@ In the body of the function, it calls another function `prepare_sl_summary` with
 
 The result of `prepare_sl_summary` is then returned as the result of `prepare_disposition`.
 
-```{r}
-prepare_disposition <- function(meta,
-                              analysis = "disp",
-                              population = meta$plan[meta$plan$analysis==analysis,]$population,
-                              parameter = paste(meta$plan[meta$plan$analysis==analysis,]$parameter, collapse = ";") 
-) {
-  return(
-    prepare_sl_summary(meta,
-                       analysis = analysis,
-                       population = population,
-                       parameter = parameter
-    )
-  )
-}
-```
-
 The resulting output of the function `prepare_disposition()` comprises
 a collection of raw datasets for analysis and reporting.
 
@@ -221,7 +203,7 @@ x <- outdata |>
   format_disposition()
 
 x$tbl <- x$tbl %>%
-  mutate(name = ifelse(trimws(name) == "ZStatus Not Recorded", "    Status Not Recorded", name))
+  mutate(name = ifelse(trimws(name) == "Status Not Recorded", "    Status Not Recorded", name))
 
 x |>
   rtf_disposition(
@@ -232,7 +214,7 @@ x |>
 ```
 
 ```{r, out.width = "100%", out.height = "400px", echo = FALSE, fig.align = "center"}
-knitr::include_graphics("outtable/disposition.pdf")
+knitr::include_graphics("outtable/pdf/disposition.pdf")
 ```
 
 The rtf_trt_compliance() function also provides some commonly used arguments to customize the table.
@@ -243,7 +225,7 @@ x <- outdata |>
   format_disposition()
 
 x$tbl <- x$tbl %>%
-  mutate(name = ifelse(trimws(name) == "ZStatus Not Recorded", "    Status Not Recorded", name))
+  mutate(name = ifelse(trimws(name) == "Status Not Recorded", "    Status Not Recorded", name))
 
 x |>
   rtf_disposition(
@@ -256,5 +238,5 @@ x |>
 ```
 
 ```{r, out.width = "100%", out.height = "400px", echo = FALSE, fig.align = "center"}
-knitr::include_graphics("outtable/disposition1.pdf")
+knitr::include_graphics("outtable/pdf/disposition1.pdf")
 ```

vignettes/baseline-character.Rmd

@@ -205,7 +205,7 @@ raw datasets. Key arguments are:
 - `subgroup_var`: a character value of subgroup variable name in observation data saved in meta$data_observation.
 - `subgroup_header`: a character vector for column header hierarchy. The first element will be the first level header and the second element will be second level header.
 
-```{r}
+```{r, eval = FALSE}
 outdata <- prepare_base_char_subgroup(
   meta,
   population = "apat",
@@ -218,22 +218,22 @@ outdata <- prepare_base_char_subgroup(
 
 The output dataset contains commonly used statistics within each `subgroup_var`.
 
-```{r}
+```{r, eval = FALSE}
 outdata$out_all$`Placebo`
 outdata$out_all$`High Dose`
 outdata$out_all$`Low Dose`
 ```
 
 The information about subgroup saved with `outdata$group` and `outdata$subgroup`.
 
-```{r}
+```{r, eval = FALSE}
 outdata$group
 outdata$subgroup
 ```
 
 `n_pop`: participants in population within each `subgroup_var`.
 
-```{r}
+```{r, eval = FALSE}
 outdata$out_all$`Placebo`$n
 outdata$out_all$`High Dose`$n
 outdata$out_all$`Low Dose`$n
@@ -243,7 +243,7 @@ outdata$out_all$`Low Dose`$n
 
 `format_base_char_subgroup` to prepare analysis dataset before generate RTF output
 
-```{r}
+```{r, eval = FALSE}
 tbl <- format_base_char_subgroup(outdata)
 head(tbl$tbl)
 ```
@@ -252,7 +252,7 @@ head(tbl$tbl)
 
 `rtf_base_char_subgroup` to generate RTF output
 
-```{r warning=FALSE}
+```{r, warning=FALSE, eval = FALSE}
 outdata |>
   format_base_char_subgroup() |>
   rtf_base_char_subgroup(