Clean up

.Rbuildignore

@@ -7,3 +7,5 @@
 ^LICENSE\.md$
 ^LICENSE_THIRD_PARTY\.md$
 ^\.github$
+^codecov\.yml$
+^tests/testthat/_snaps$

.github/workflows/style.yaml

@@ -0,0 +1,73 @@
+# Workflow derived from https://github.com/r-lib/actions/tree/v2/examples
+# Need help debugging build failures? Start at https://github.com/r-lib/actions#where-to-find-help
+on:
+  push:
+    paths: ["**.[rR]", "**.[qrR]md", "**.[rR]markdown", "**.[rR]nw", "**.[rR]profile"]
+
+name: Style
+
+jobs:
+  style:
+    runs-on: ubuntu-latest
+    env:
+      GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }}
+    steps:
+      - name: Checkout repo
+        uses: actions/checkout@v4
+        with:
+          fetch-depth: 0
+
+      - name: Setup R
+        uses: r-lib/actions/setup-r@v2
+        with:
+          use-public-rspm: true
+
+      - name: Install dependencies
+        uses: r-lib/actions/setup-r-dependencies@v2
+        with:
+          extra-packages: any::styler, any::roxygen2
+          needs: styler
+
+      - name: Enable styler cache
+        run: styler::cache_activate()
+        shell: Rscript {0}
+
+      - name: Determine cache location
+        id: styler-location
+        run: |
+          cat(
+            "location=",
+            styler::cache_info(format = "tabular")$location,
+            "\n",
+            file = Sys.getenv("GITHUB_OUTPUT"),
+            append = TRUE,
+            sep = ""
+          )
+        shell: Rscript {0}
+
+      - name: Cache styler
+        uses: actions/cache@v4
+        with:
+          path: ${{ steps.styler-location.outputs.location }}
+          key: ${{ runner.os }}-styler-${{ github.sha }}
+          restore-keys: |
+            ${{ runner.os }}-styler-
+            ${{ runner.os }}-
+
+      - name: Style
+        run: styler::style_pkg()
+        shell: Rscript {0}
+
+      - name: Commit and push changes
+        run: |
+          if FILES_TO_COMMIT=($(git diff-index --name-only ${{ github.sha }} \
+              | egrep --ignore-case '\.(R|[qR]md|Rmarkdown|Rnw|Rprofile)$'))
+          then
+            git config --local user.name "$GITHUB_ACTOR"
+            git config --local user.email "[email protected]"
+            git commit ${FILES_TO_COMMIT[*]} -m "Style code (GHA)"
+            git pull --ff-only
+            git push origin
+          else
+            echo "No changes to commit."
+          fi

.github/workflows/test-coverage.yaml

@@ -0,0 +1,50 @@
+# Workflow derived from https://github.com/r-lib/actions/tree/v2/examples
+# Need help debugging build failures? Start at https://github.com/r-lib/actions#where-to-find-help
+on:
+  push:
+    branches: [main, master]
+  pull_request:
+    branches: [main, master]
+
+name: test-coverage
+
+jobs:
+  test-coverage:
+    runs-on: ubuntu-latest
+    env:
+      GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }}
+
+    steps:
+      - uses: actions/checkout@v4
+
+      - uses: r-lib/actions/setup-r@v2
+        with:
+          use-public-rspm: true
+
+      - uses: r-lib/actions/setup-r-dependencies@v2
+        with:
+          extra-packages: any::covr
+          needs: coverage
+
+      - name: Test coverage
+        run: |
+          covr::codecov(
+            quiet = FALSE,
+            clean = FALSE,
+            install_path = file.path(normalizePath(Sys.getenv("RUNNER_TEMP"), winslash = "/"), "package")
+          )
+        shell: Rscript {0}
+
+      - name: Show testthat output
+        if: always()
+        run: |
+          ## --------------------------------------------------------------------
+          find ${{ runner.temp }}/package -name 'testthat.Rout*' -exec cat '{}' \; || true
+        shell: bash
+
+      - name: Upload test results
+        if: failure()
+        uses: actions/upload-artifact@v4
+        with:
+          name: coverage-test-failures
+          path: ${{ runner.temp }}/package

DESCRIPTION

@@ -27,5 +27,5 @@ Suggests:
 VignetteBuilder: knitr
 Encoding: UTF-8
 Roxygen: list(markdown = TRUE)
-RoxygenNote: 7.3.1
+RoxygenNote: 7.3.2
 Config/testthat/edition: 3

R/collect.R

@@ -205,18 +205,17 @@ collect_baseline <- function(
 
   # variable lower level
   if (!is.null(par_var_lower)) {
-
     # Obtain number of subjects
-    pop_num_lower <- apply(pop_num, 1, function (x) {
+    pop_num_lower <- apply(pop_num, 1, function(x) {
       pop_lower <- pop[pop[[par_var]] == x[["name"]] & !is.na(pop[[par_var_lower]]), ]
       id_lower <- seq(pop_lower[[pop_id]])
       group_lower <- pop_lower[[pop_group]]
       varlower <- pop_lower[[par_var_lower]]
       stopifnot(inherits(varlower, c("factor", "character")))
       if (any(c("character") %in% class_var)) {
-      varlower <- factor(varlower, exclude = NULL)
+        varlower <- factor(varlower, exclude = NULL)
       }
-      
+
       if (length(varlower) > 0) {
         lower <- metalite::n_subject(id_lower, group_lower, par = varlower)
         max_length <- sapply(pop_num, function(x) max(nchar(x)))
@@ -231,16 +230,16 @@ collect_baseline <- function(
       }
     })
     pop_num <- do.call(rbind, pop_num_lower)
-    
+
     # Obtain proportion
-    pop_prop_lower <- apply(pop_prop, 1, function (x) {
+    pop_prop_lower <- apply(pop_prop, 1, function(x) {
       pop_lower <- pop[pop[[par_var]] == x[["name"]] & !is.na(pop[[par_var_lower]]), ]
       id_lower <- seq(pop_lower[[pop_id]])
       group_lower <- pop_lower[[pop_group]]
       varlower <- pop_lower[[par_var_lower]]
       stopifnot(inherits(varlower, c("factor", "character")))
       varlower <- factor(varlower, exclude = NULL)
-      
+
       if (length(varlower) > 0) {
         lower <- metalite::n_subject(id_lower, group_lower, par = varlower)
         for (i in seq(names(lower))) {
@@ -256,9 +255,8 @@ collect_baseline <- function(
       }
     })
     pop_prop <- do.call(rbind, pop_prop_lower)
-
   }
-  
+
   pop_n["var_label"] <- label
   pop_num["var_label"] <- label
   pop_prop["var_label"] <- label

R/format_base_char_subgroup.R

@@ -18,7 +18,7 @@
 
 #' Prepare data for Subgroup Analysis for Baseline Characteristic
 #'
-#' @param outdata A metadata object created by [prepare_base_char_subgroup()]. 
+#' @param outdata A metadata object created by [prepare_base_char_subgroup()].
 #' @param display Column wants to display on the table.
 #'   The term could be selected from `c("n", "prop", "total")`.
 #' @param display_stat A vector of statistics term name.
@@ -30,25 +30,23 @@
 #'
 #' @examples
 #' meta <- meta_sl_example()
-#' 
+#'
 #' outdata <- prepare_base_char_subgroup(
-#'           meta,
-#'           population = "apat",
-#'           parameter = "age",
-#'           subgroup_var = "TRTA",
-#'           subgroup_header = c("SEX","TRTA"),
-#'           display_subgroup_total = TRUE
+#'   meta,
+#'   population = "apat",
+#'   parameter = "age",
+#'   subgroup_var = "TRTA",
+#'   subgroup_header = c("SEX", "TRTA"),
+#'   display_subgroup_total = TRUE
 #' )
-#' 
+#'
 #' outdata |> format_base_char_subgroup()
-
 format_base_char_subgroup <- function(
     outdata,
-    display = c("n","prop","total"),
+    display = c("n", "prop", "total"),
     display_stat = c("mean", "sd", "median", "range")) {
-
   out_all <- outdata$out_all
-  
+
   outlst <- list()
   for (i in seq_along(out_all)) {
     tbl <- out_all[[i]] |>
@@ -57,42 +55,42 @@ format_base_char_subgroup <- function(
         digits_prop = 1,
         display_stat = display_stat
       )
-    
-    #names(tbl$tbl)[-1] <- paste0(names(out_all[i]), names(tbl$tbl)[-1])
-    names(tbl$tbl)[-1] <- ifelse(grepl("_label",names(tbl$tbl)[-1]) %in% "FALSE", paste0(names(out_all[i]), names(tbl$tbl)[-1]),names(tbl$tbl)[-1])
-    
+
+    # names(tbl$tbl)[-1] <- paste0(names(out_all[i]), names(tbl$tbl)[-1])
+    names(tbl$tbl)[-1] <- ifelse(grepl("_label", names(tbl$tbl)[-1]) %in% "FALSE", paste0(names(out_all[i]), names(tbl$tbl)[-1]), names(tbl$tbl)[-1])
+
     tbl$tbl$order <- as.numeric(rownames(tbl$tbl))
-    
+
     outlst[[i]] <- tbl$tbl
   }
-  
+
   names(outlst) <- names(out_all)
   outlst <- outlst[-length(outlst)]
-  
+
   i <- 1
   while (i < length(outlst)) {
     if (i == 1) {
-      tbl <- merge(outlst[[i]], outlst[[i + 1]], by = c("name","var_label","order"), all = TRUE)
+      tbl <- merge(outlst[[i]], outlst[[i + 1]], by = c("name", "var_label", "order"), all = TRUE)
     }
-    
+
     i <- i + 1
-    
+
     if (i > 1 && i < length(outlst)) {
-      tbl <- merge(tbl, outlst[[i + 1]], by = c("name","var_label","order"), all = TRUE)
+      tbl <- merge(tbl, outlst[[i + 1]], by = c("name", "var_label", "order"), all = TRUE)
     }
   }
-  
-  
+
+
   # If outdata$display_subgroup_total = FALSE, remove that part
-  #if (!outdata$display_subgroup_total) {
+  # if (!outdata$display_subgroup_total) {
   #  rm_tot <- names(outlst$Total) # Columns from Total Section
   #  rm_tot <- rm_tot[!rm_tot %in% c("name", "order")]
-    
+
   #  tbl <- tbl[, -which(names(tbl) %in% rm_tot)]
-  #}
-  
-  outdata$tbl <- tbl[order(tbl$order),]
+  # }
+
+  outdata$tbl <- tbl[order(tbl$order), ]
   outdata$display <- display
   outdata$display_stat <- display_stat
   outdata
-}
+}

R/format_sl_summary.R

@@ -41,21 +41,19 @@ format_sl_summary <- function(
     display_col = c("n", "prop", "total"),
     digits_prop = 1,
     display_stat = c("mean", "sd", "se", "median", "q1 to q3", "range")) {
-
-
   n_group <- length(outdata$group_label)
 
 
-  
+
   # Check if the "tbl" element exists in the "outdata" object
   if ("tbl" %in% names(outdata)) {
     # If the element exists, delete it
     outdata$tbl <- NULL
-  } 
-  
+  }
+
   # Select statistics want to display
   for (i in 1:length(outdata$var_type)) {
-    if ( ("integer" %in% outdata$var_type[[i]]) || ("numeric" %in% outdata$var_type[[i]]) ) {
+    if (("integer" %in% outdata$var_type[[i]]) || ("numeric" %in% outdata$var_type[[i]])) {
       n_num <- outdata$char_n[[i]]
       n_num_group <- n_num[which(!tolower(n_num$name)
       %in% c(

R/meta_sl.R

@@ -26,7 +26,7 @@
 #'   If there are multiple terms, they are separated by the semicolon (;).
 #' @param parameter_var A character value of parameter variable name.
 #'   If there are multiple variables, they are separated by the semicolon (;).
-#'   A group variable can be specified followed by a variable 
+#'   A group variable can be specified followed by a variable
 #'   and the hat symbol (^).
 #' @param parameter_labels A character vector of parameter label name.
 #'   The length of vector should be the same as the number of parameter terms.
@@ -65,7 +65,6 @@ meta_sl <- function(
     observation_subset = NULL,
     population_label = "All Participants as Treated",
     treatment_group = "TRT01A") {
-
   # Check input
   if (is.null(dataset_observation)) {
     dataset_observation <- dataset_population
@@ -84,11 +83,11 @@ meta_sl <- function(
     stop("The number of parameter labels should be the same as that of parameter terms.")
   }
   parameter_vars <- strsplit(unlist(strsplit(parameter_var, ";")), "^", fixed = TRUE)
-  
+
   meta <- metalite::meta_adam(
     population = as.data.frame(dataset_population),
     observation = as.data.frame(dataset_observation)
-    )|>
+  ) |>
     metalite::define_plan(plan = metalite::plan(
       analysis = analysis_term,
       population = population_term,
@@ -109,7 +108,7 @@ meta_sl <- function(
       var = names(dataset_observation),
       label = ""
     )
-  
+
   for (i in seq(parameter_terms)) {
     var <- parameter_vars[[i]]
     vargroup <- NULL
@@ -120,14 +119,15 @@ meta_sl <- function(
       vargroup <- parameter_vars[[i]][[2]]
     }
     if (!is.null(parameter_labels)) {
-      varlabel <- ifelse(!is.na(parameter_labels[i]), 
-                         parameter_labels[i], 
-                         attr(dataset_population[[var]], "label"))
+      varlabel <- ifelse(!is.na(parameter_labels[i]),
+        parameter_labels[i],
+        attr(dataset_population[[var]], "label")
+      )
     } else {
       varlabel <- attr(dataset_population[[var]], "label")
     }
-    
-    meta <- meta |> 
+
+    meta <- meta |>
       metalite::define_parameter(
         name = parameter_terms[[i]],
         var = var,
@@ -144,6 +144,6 @@ meta_sl <- function(
       var_name = unlist(parameter_vars)
     ) |>
     metalite::meta_build()
-  
+
   meta
-}
+}