Merge pull request #2 from darwin-eu/release_0_4_0

v0.4.0

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: omopgenerics
 Title: Methods and Classes for the OMOP Common Data Model
-Version: 0.3.1.900
+Version: 0.4.0
 Authors@R: c(
     person(
         "Martí", "Català", email = "[email protected]", 
@@ -39,6 +39,7 @@ Imports:
     cli,
     dbplyr,
     dplyr,
+    generics,
     glue,
     lifecycle,
     methods,

NAMESPACE

@@ -70,11 +70,14 @@ S3method(summary,cohort_table)
 S3method(summary,summarised_result)
 S3method(suppress,summarised_result)
 S3method(tally,cdm_table)
+S3method(tidy,summarised_result)
 S3method(ungroup,cdm_table)
 S3method(union,cdm_table)
 S3method(union_all,cdm_table)
 export(achillesColumns)
 export(achillesTables)
+export(addSettings)
+export(additionalColumns)
 export(assertCharacter)
 export(assertChoice)
 export(assertClass)
@@ -114,9 +117,14 @@ export(exportCodelist)
 export(exportConceptSetExpression)
 export(exportSummarisedResult)
 export(filter)
+export(filterAdditional)
+export(filterGroup)
+export(filterSettings)
+export(filterStrata)
 export(getCohortId)
 export(getCohortName)
 export(getPersonIdentifier)
+export(groupColumns)
 export(importCodelist)
 export(importConceptSetExpression)
 export(importSummarisedResult)
@@ -139,27 +147,39 @@ export(newSummarisedResult)
 export(omopColumns)
 export(omopTableFields)
 export(omopTables)
-export(participants)
+export(pivotEstimates)
 export(readSourceTable)
 export(recordCohortAttrition)
 export(resultColumns)
 export(resultPackageVersion)
 export(settings)
+export(settingsColumns)
 export(sourceType)
+export(splitAdditional)
+export(splitAll)
+export(splitGroup)
+export(splitStrata)
+export(strataColumns)
 export(suppress)
 export(tableName)
 export(tableSource)
+export(tidy)
+export(tidyColumns)
 export(tmpPrefix)
 export(toSnakeCase)
 export(uniqueId)
 export(uniqueTableName)
+export(uniteAdditional)
+export(uniteGroup)
+export(uniteStrata)
 export(validateAgeGroupArgument)
 export(validateCdmArgument)
 export(validateCohortArgument)
 export(validateCohortIdArgument)
 export(validateConceptSetArgument)
 export(validateNameArgument)
 export(validateNameLevel)
+export(validateNewColumn)
 export(validateResultArguemnt)
 export(validateResultArgument)
 export(validateWindowArgument)
@@ -186,6 +206,7 @@ importFrom(dplyr,tally)
 importFrom(dplyr,ungroup)
 importFrom(dplyr,union)
 importFrom(dplyr,union_all)
+importFrom(generics,tidy)
 importFrom(rlang,":=")
 importFrom(rlang,.data)
 importFrom(rlang,.env)

R/addSettings.R

@@ -0,0 +1,78 @@
+#' Add settings columns to a `<summarised_result>` object
+#'
+#' @param result A `<summarised_result>` object.
+#' @param settingsColumn Settings to be added as columns, by default
+#' `settingsColumns(result)` will be added. If NULL or empty character vector,
+#' no settings will be added.
+#'
+#' @export
+#'
+#' @return A `<summarised_result>` object with the added setting columns.
+#' @examples {
+#'   library(dplyr)
+#'   library(omopgenerics)
+#'
+#'   x <- tibble(
+#'     "result_id" = as.integer(c(1, 2)),
+#'     "cdm_name" = c("cprd", "eunomia"),
+#'     "group_name" = "cohort_name",
+#'     "group_level" = "my_cohort",
+#'     "strata_name" = "sex",
+#'     "strata_level" = "male",
+#'     "variable_name" = "Age group",
+#'     "variable_level" = "10 to 50",
+#'     "estimate_name" = "count",
+#'     "estimate_type" = "numeric",
+#'     "estimate_value" = "5",
+#'     "additional_name" = "overall",
+#'     "additional_level" = "overall"
+#'   ) |>
+#'     newSummarisedResult(settings = tibble(
+#'       "result_id" = c(1, 2), "custom" = c("A", "B")
+#'     ))
+#'
+#'   x
+#'
+#'   x |> addSettings()
+#' }
+#'
+addSettings <- function(result,
+                        settingsColumn = settingsColumns(result)) {
+  # checks
+  if (is.null(attr(result, "settings"))) {
+    cli::cli_abort("result doesn't have a `settings` attribute")
+  }
+  settingsColumn <- checkSettingsColumns(settingsColumn, result)
+  set <- settings(result)
+
+  if (length(settingsColumn) == 0) {
+    return(result)
+  }
+
+  # add settings
+  toJoin <- settingsColumn[settingsColumn %in% colnames(result)]
+  result <- result |>
+    dplyr::left_join(
+      set |>
+        dplyr::select(dplyr::any_of(c("result_id", settingsColumn))),
+      by = c("result_id", toJoin)
+    )
+
+  return(result)
+}
+
+checkSettingsColumns <- function(settingsColumns, result, call = parent.frame()) {
+  set <- settings(result)
+  assertCharacter(x = settingsColumns, null = TRUE, call = call)
+  if (!is.null(settingsColumns)) {
+    assertTable(set, columns = settingsColumns)
+    settingsColumns <- settingsColumns[settingsColumns != "result_id"]
+    notPresent <- settingsColumns[!settingsColumns %in% colnames(set)]
+    if (length(notPresent) > 0) {
+      cli::cli_abort("The following `settings` are not present in settings attribute: {.var {notPresent}}.", call = call)
+    }
+  } else {
+    settingsColumns <- character()
+  }
+  return(invisible(settingsColumns))
+}