Merge pull request #206 from darwin-eu-dev/issue_204

hide columns and document
darwin-eu · Sep 30, 2024 · 4d1660e · 4d1660e
2 parents c1396af + 695ab25
commit 4d1660e
Show file tree

Hide file tree

Showing 15 changed files with 93 additions and 94 deletions.
diff --git a/R/tableCharacteristics.R b/R/tableCharacteristics.R
@@ -26,6 +26,8 @@
 #' `tidyColumns(result)`.
 #' @param groupColumn Columns to group by. See options with
 #' `tidyColumns(result)`.
+#' @param hide Columns to hide from the visualisation. See options with
+#' `tidyColumns(result)`.
 #'
 #' @examples
 #' \donttest{
@@ -48,7 +50,8 @@
 tableCharacteristics <- function(result,
                                  type = "gt",
                                  header = c("cdm_name", "cohort_name"),
-                                 groupColumn = NULL) {
+                                 groupColumn = NULL,
+                                 hide = character()) {
   # initial checks
   result <- omopgenerics::validateResultArgument(result)
   omopgenerics::assertChoice(type, c("gt", "flextable", "tibble"))
@@ -78,7 +81,8 @@ tableCharacteristics <- function(result,
     estimateName = estimateName,
     header = header,
     groupColumn = groupColumn,
-    type = type
+    type = type,
+    hide = hide
   )
 
   return(tab)

diff --git a/R/tableCohortAttrition.R b/R/tableCohortAttrition.R
@@ -26,6 +26,8 @@
 #' `tidyColumns(result)`.
 #' @param groupColumn Columns to group by. See options with
 #' `tidyColumns(result)`.
+#' @param hide Columns to hide from the visualisation. See options with
+#' `tidyColumns(result)`.
 #'
 #' @return A visual table.
 #'
@@ -47,7 +49,8 @@
 tableCohortAttrition <- function(result,
                                  type = "gt",
                                  header = "variable_name",
-                                 groupColumn = c("cdm_name", "cohort_name")) {
+                                 groupColumn = c("cdm_name", "cohort_name"),
+                                 hide = c("variable_level", "reason_id", "estimate_name")) {
   # initial checks
   result <- omopgenerics::validateResultArgument(result)
   omopgenerics::assertChoice(type, c("gt", "flextable", "tibble"))
@@ -70,7 +73,7 @@ tableCohortAttrition <- function(result,
     header = header,
     groupColumn = groupColumn,
     type = type,
-    hide = c("variable_level", "reason_id", "estimate_name")
+    hide = hide
   )
 
   return(tab)

diff --git a/R/tableCohortCount.R b/R/tableCohortCount.R
@@ -19,13 +19,14 @@
 #' `r lifecycle::badge("experimental")`
 #'
 #' @param result A summarise_characteristics object.
-#' @param type Type of desired formatted table, possibilities: "gt",
-#' "flextable", "tibble".
-#' @param header A vector containing which elements should go into the header
-#' in order. Allowed are: `cdm_name`, `group`, `strata`, `additional`,
-#' `variable`, `estimate`, `settings`.
-#' @param groupColumn Column to use as group labels.
-#' @param hide Columns to drop from the output table.
+#' @param type Type of table. Check supported types with
+#' `visOmopResults::tableType()`.
+#' @param header Columns to use as header. See options with
+#' `tidyColumns(result)`.
+#' @param groupColumn Columns to group by. See options with
+#' `tidyColumns(result)`.
+#' @param hide Columns to hide from the visualisation. See options with
+#' `tidyColumns(result)`.
 #'
 #' @examples
 #' \donttest{

diff --git a/R/tableCohortOverlap.R b/R/tableCohortOverlap.R
@@ -19,15 +19,16 @@
 #' `r lifecycle::badge("experimental")`
 #'
 #' @param result A summariseOverlapCohort result.
-#' @param type Type of desired formatted table, possibilities: "gt",
-#' "flextable", "tibble".
-#' @param header A vector containing which elements should go into the header
-#' in order. Allowed are: `cdm_name`, `group`, `strata`, `additional`,
-#' `variable`, `estimate`, `settings`.
-#' @param groupColumn Column to use as group labels.
-#' @param hide Columns to drop from the output table.
 #' @param uniqueCombinations Whether to display unique combinations
 #' reference - comparator.
+#' @param type Type of table. Check supported types with
+#' `visOmopResults::tableType()`.
+#' @param header Columns to use as header. See options with
+#' `tidyColumns(result)`.
+#' @param groupColumn Columns to group by. See options with
+#' `tidyColumns(result)`.
+#' @param hide Columns to hide from the visualisation. See options with
+#' `tidyColumns(result)`.
 #'
 #' @examples
 #' \donttest{
@@ -43,11 +44,11 @@
 #' @export
 #'
 tableCohortOverlap <- function(result,
+                               uniqueCombinations = TRUE,
                                type = "gt",
                                header = c("variable_name"),
                                groupColumn = c("cdm_name"),
-                               hide = c("variable_level"),
-                               uniqueCombinations = TRUE) {
+                               hide = c("variable_level")) {
   # validate result
   result <- omopgenerics::validateResultArgument(result)
   omopgenerics::assertChoice(type, c("gt", "flextable", "tibble"))

diff --git a/R/tableCohortTiming.R b/R/tableCohortTiming.R
@@ -28,6 +28,8 @@
 #' `tidyColumns(result)`.
 #' @param groupColumn Columns to group by. See options with
 #' `tidyColumns(result)`.
+#' @param hide Columns to hide from the visualisation. See options with
+#' `tidyColumns(result)`.
 #'
 #' @return A formatted table of the summariseCohortTiming result.
 #'
@@ -66,7 +68,8 @@ tableCohortTiming <- function(result,
                               uniqueCombinations = TRUE,
                               type = "gt",
                               header = visOmopResults::strataColumns(result),
-                              groupColumn = NULL) {
+                              groupColumn = NULL,
+                              hide = "variable_level") {
   # initial checks
   result <- omopgenerics::validateResultArgument(result)
   omopgenerics::assertChoice(timeScale, c("days", "years"))
@@ -103,7 +106,7 @@ tableCohortTiming <- function(result,
     header = header,
     groupColumn = groupColumn,
     type = type,
-    hide = "variable_level"
+    hide = hide
   )
 
   return(tab)

diff --git a/R/tableLargeScaleCharacteristics.R b/R/tableLargeScaleCharacteristics.R
@@ -27,6 +27,8 @@
 #' `tidyColumns(result)`.
 #' @param groupColumn Columns to group by. See options with
 #' `tidyColumns(result)`.
+#' @param hide Columns to hide from the visualisation. See options with
+#' `tidyColumns(result)`.
 #'
 #' @export
 #'
@@ -65,7 +67,8 @@ tableLargeScaleCharacteristics <- function(result,
                                              visOmopResults::strataColumns(result),
                                              "variable_level"
                                            ),
-                                           groupColumn = c("table_name", "type", "analysis")) {
+                                           groupColumn = c("table_name", "type", "analysis"),
+                                           hide = character()) {
   # validate result
   result <- omopgenerics::validateResultArgument(result)
   omopgenerics::assertChoice(type, c("gt", "flextable", "tibble"))
@@ -102,43 +105,9 @@ tableLargeScaleCharacteristics <- function(result,
     header = header,
     settingsColumns = c("table_name", "type", "analysis"),
     groupColumn = groupColumn,
-    type = type
+    type = type,
+    hide = hide
   )
 
   return(tab)
 }
-cleanHeader <- function(header, strata) {
-  header[header == "cdm name"] <- "CDM name"
-  header[header == "cohort name"] <- "Cohort name"
-  header[header == "window name"] <- "Window"
-  if ("strata" %in% header) {
-    id <- which(header == "strata")
-    header <- append(header, strata, after = id)
-    header <- header[header != "strata"]
-  }
-}
-orderWindow <- function(res) {
-  windows <- res |>
-    dplyr::select("window_name") |>
-    dplyr::distinct() |>
-    dplyr::pull()
-  win <- windows |>
-    stringr::str_split(pattern = " ") |>
-    lapply(function(x) {
-      if (length(x) == 3) {
-        if (x[2] == "to") {
-          return(dplyr::tibble(
-            lower = as.numeric(x[1]), upper = as.numeric(x[3])
-          ))
-        }
-      }
-      return(dplyr::tibble(lower = NA, upper = NA))
-    })
-  names(win) <- windows
-  tib <- dplyr::bind_rows(win, .id = "window_name") |>
-    dplyr::arrange(.data$lower, .data$upper) |>
-    dplyr::mutate("window_id" = dplyr::row_number())
-  res <- res |>
-    dplyr::left_join(tib, by = "window_name")
-  return(res)
-}
diff --git a/README.Rmd b/README.Rmd
@@ -56,7 +56,7 @@ The package contain three types of functions:
 
 ### Mock data
 
-Althought the package provides some simple mock data for testing (`mockCohortCharacteristics()`), for these examples we will use the GiBleed dataset that can be downloaded using the CDMConnector package that will give us some more real results.
+Although the package provides some simple mock data for testing (`mockCohortCharacteristics()`), for these examples we will use the GiBleed dataset that can be downloaded using the CDMConnector package that will give us some more real results.
 
 ```{r}
 library(CDMConnector)
@@ -211,7 +211,7 @@ Disconnect from your database using `CDMConnector::cdmDisconnect()` to close the
 mockDisconnect(cdm)
 ```
 
-### Recomendations
+### Recommendations
 
 Although it is technically possible, we do not recommend to pipe table or plot functions with the summarise ones. The main reason is that summarise functions take some time to run, a large scale characterisation in a big cdm object can take a few hours. If we pipe the output to a table/plot function we loose the summarise result object. In fact, some times we would send code around to be ran in others database and what we want to export is the summarised_result objects and not the table or plot which we would like to build after compiling results from different cdm objects.
 

diff --git a/README.md b/README.md
@@ -75,7 +75,7 @@ The package contain three types of functions:
 
 ### Mock data
 
-Althought the package provides some simple mock data for testing
+Although the package provides some simple mock data for testing
 (`mockCohortCharacteristics()`), for these examples we will use the
 GiBleed dataset that can be downloaded using the CDMConnector package
 that will give us some more real results.
@@ -120,7 +120,7 @@ result |>
 #> $ variable_level   <chr> NA, NA, NA, NA
 #> $ estimate_name    <chr> "count", "count", "count", "count"
 #> $ estimate_type    <chr> "integer", "integer", "integer", "integer"
-#> $ estimate_value   <chr> "137", "2679", "13907", "137"
+#> $ estimate_value   <chr> "13907", "2679", "137", "137"
 #> $ additional_name  <chr> "overall", "overall", "overall", "overall"
 #> $ additional_level <chr> "overall", "overall", "overall", "overall"
 ```
@@ -165,8 +165,8 @@ result |>
   plotCohortAttrition()
 ```
 
-<div class="grViz html-widget html-fill-item" id="htmlwidget-277e5a8214cb8e2afc92" style="width:100%;height:480px;"></div>
-<script type="application/json" data-for="htmlwidget-277e5a8214cb8e2afc92">{"x":{"diagram":"digraph {\n\ngraph [layout = \"neato\",\n       outputorder = \"edgesfirst\",\n       bgcolor = \"white\"]\n\nnode [fontname = \"Helvetica\",\n      fontsize = \"10\",\n      shape = \"circle\",\n      fixedsize = \"true\",\n      width = \"0.5\",\n      style = \"filled\",\n      fillcolor = \"aliceblue\",\n      color = \"gray70\",\n      fontcolor = \"gray50\"]\n\nedge [fontname = \"Helvetica\",\n     fontsize = \"8\",\n     len = \"1.5\",\n     color = \"gray80\",\n     arrowsize = \"0.5\"]\n\n  \"1\" [label = \"Initial events\nN subjects = 2,679\nN records = 13,908\", shape = \"box\", penwidth = \"2\", color = \"black\", fillcolor = \"#F0F8FF\", fontname = \"Calibri\", fontsize = \"11\", fontcolor = \"black\", height = \"0.6\", width = \"1.44\", pos = \"1,2.1!\"] \n  \"2\" [label = \"Final events\nN subjects = 2,679\nN records = 13,907\", shape = \"box\", penwidth = \"2\", color = \"black\", fillcolor = \"#F0F8FF\", fontname = \"Calibri\", fontsize = \"11\", fontcolor = \"black\", height = \"0.6\", width = \"1.44\", pos = \"1,0.7!\"] \n  \"3\" [label = \"N subjects = 0\nN records = 1\", shape = \"box\", color = \"black\", fillcolor = \"#C0C0C0\", fontname = \"Calibri\", fontsize = \"9\", fontcolor = \"black\", height = \"0.4\", width = \"1.2\", pos = \"3,1.4!\"] \n  \"4\" [label = \"join exposures separated by\n1 or less days\", shape = \"box\", color = \"black\", fillcolor = \"#FFFFFF\", fontname = \"Calibri\", fontsize = \"10\", fontcolor = \"back\", height = \"0.4\", width = \"2.16\", pos = \"1,1.4!\"] \n\"1\"->\"2\" [color = \"black\"] \n\"4\"->\"3\" [color = \"black\"] \n}","config":{"engine":"dot","options":null}},"evals":[],"jsHooks":[]}</script>
+<div class="grViz html-widget html-fill-item" id="htmlwidget-7a2e91c189cd0fba8e9d" style="width:100%;height:480px;"></div>
+<script type="application/json" data-for="htmlwidget-7a2e91c189cd0fba8e9d">{"x":{"diagram":"digraph {\n\ngraph [layout = \"neato\",\n       outputorder = \"edgesfirst\",\n       bgcolor = \"white\"]\n\nnode [fontname = \"Helvetica\",\n      fontsize = \"10\",\n      shape = \"circle\",\n      fixedsize = \"true\",\n      width = \"0.5\",\n      style = \"filled\",\n      fillcolor = \"aliceblue\",\n      color = \"gray70\",\n      fontcolor = \"gray50\"]\n\nedge [fontname = \"Helvetica\",\n     fontsize = \"8\",\n     len = \"1.5\",\n     color = \"gray80\",\n     arrowsize = \"0.5\"]\n\n  \"1\" [label = \"Initial events\nN subjects = 2,679\nN records = 13,908\", shape = \"box\", penwidth = \"2\", color = \"black\", fillcolor = \"#F0F8FF\", fontname = \"Calibri\", fontsize = \"11\", fontcolor = \"black\", height = \"0.6\", width = \"1.44\", pos = \"1,2.1!\"] \n  \"2\" [label = \"Final events\nN subjects = 2,679\nN records = 13,907\", shape = \"box\", penwidth = \"2\", color = \"black\", fillcolor = \"#F0F8FF\", fontname = \"Calibri\", fontsize = \"11\", fontcolor = \"black\", height = \"0.6\", width = \"1.44\", pos = \"1,0.7!\"] \n  \"3\" [label = \"N subjects = 0\nN records = 1\", shape = \"box\", color = \"black\", fillcolor = \"#C0C0C0\", fontname = \"Calibri\", fontsize = \"9\", fontcolor = \"black\", height = \"0.4\", width = \"1.2\", pos = \"3,1.4!\"] \n  \"4\" [label = \"join exposures separated by\n1 or less days\", shape = \"box\", color = \"black\", fillcolor = \"#FFFFFF\", fontname = \"Calibri\", fontsize = \"10\", fontcolor = \"back\", height = \"0.4\", width = \"2.16\", pos = \"1,1.4!\"] \n\"1\"->\"2\" [color = \"black\"] \n\"4\"->\"3\" [color = \"black\"] \n}","config":{"engine":"dot","options":null}},"evals":[],"jsHooks":[]}</script>
 
 ### Characteristics
 
@@ -202,9 +202,9 @@ tableCohortTiming(result, header = "cdm_name", type = "flextable")
 
 ``` r
 plotCohortTiming(
-  result, 
-  uniqueCombinations = TRUE, 
-  facet = "cdm_name", 
+  result,
+  uniqueCombinations = TRUE,
+  facet = "cdm_name",
   colour = c("cohort_name_reference", "cohort_name_comparator"),
   timeScale = "years"
 )
@@ -214,10 +214,10 @@ plotCohortTiming(
 
 ``` r
 plotCohortTiming(
-  result, 
+  result,
   plotType = "density",
-  uniqueCombinations = FALSE, 
-  facet = "cdm_name", 
+  uniqueCombinations = FALSE,
+  facet = "cdm_name",
   colour = c("cohort_name_comparator"),
   timeScale = "years"
 )
@@ -287,7 +287,7 @@ delete the created mock data:
 mockDisconnect(cdm)
 ```
 
-### Recomendations
+### Recommendations
 
 Although it is technically possible, we do not recommend to pipe table
 or plot functions with the summarise ones. The main reason is that

diff --git a/man/figures/README-unnamed-chunk-9-1.png b/man/figures/README-unnamed-chunk-9-1.png
diff --git a/man/tableCharacteristics.Rd b/man/tableCharacteristics.Rd
diff --git a/man/tableCohortAttrition.Rd b/man/tableCohortAttrition.Rd
diff --git a/man/tableCohortCount.Rd b/man/tableCohortCount.Rd
diff --git a/man/tableCohortOverlap.Rd b/man/tableCohortOverlap.Rd