simplify some code

R/ExtractConceptSetsInCohortDefinition.R

@@ -78,9 +78,13 @@ extractConceptSetsInCohortDefinition <-
           grepl("SourceConcept", x)) &
             !sapply(codesets, is.null)]
 
-        codeSetsIdsInPrimaryCriteria <- c(codeSetsIdsInPrimaryCriteria, codesets[[sourceConceptName]]) |>
-          unique() |>
-          sort()
+        if (length(sourceConceptName) > 0) {
+          codeSetsIdsInPrimaryCriteria <- c(codeSetsIdsInPrimaryCriteria, codesets[[sourceConceptName]]) |>
+            unique() |>
+            sort()
+        }
+
+        sourceConceptName <- NULL
 
         codeSetsIdsUsedToQuerySourceConceptsInPrimaryCriteria <- c(
           codeSetsIdsUsedToQuerySourceConceptsInPrimaryCriteria,
@@ -428,7 +432,7 @@ extractConceptSetExpressionsFromCohortExpression <-
           tidyr::tibble(
             conceptSetId = cohortExpression$ConceptSets[[i]]$id,
             conceptSetName = cohortExpression$ConceptSets[[i]]$name,
-            conceptSetExpression = cohortExpression$ConceptSets[[i]]$expression$items |> RJSONIO::toJSON(digits = 23)
+            conceptSetExpression = cohortExpression$ConceptSets[[i]]$expression |> RJSONIO::toJSON(digits = 23)
           )
       }
     } else {

R/ExtractConceptSetsInCohortDefinitionSet.R

@@ -32,43 +32,36 @@
 extractConceptSetsInCohortDefinitionSet <-
   function(cohortDefinitionSet) {
     # cohorts should be a dataframe with at least cohortId and json
-
+    
     conceptSets <- list()
     for (i in (1:nrow(cohortDefinitionSet))) {
       cohort <- cohortDefinitionSet[i, ]
-      cohortJsonAsList <- RJSONIO::fromJSON(
-        content = cohort$json,
-        digits = 23
-      )
+      cohortJsonAsList <- RJSONIO::fromJSON(content = cohort$json, digits = 23)
       conceptSetsInCohortDefinition <- NULL
       conceptSetsInCohortDefinition <-
-        try(
-          expr = extractConceptSetsInCohortDefinition(cohortExpression = cohortJsonAsList),
-          silent = TRUE
-        )
-
+        try(expr = extractConceptSetsInCohortDefinition(cohortExpression = cohortJsonAsList),
+            silent = TRUE)
+
       if (all(
         !is.null(conceptSetsInCohortDefinition),
         !class(conceptSetsInCohortDefinition) == "try-error"
       )) {
         conceptSets[[i]] <- conceptSetsInCohortDefinition |>
-          dplyr::select(dplyr::all_of(c("uniqueConceptSetId"))) |>
-          dplyr::mutate(cohortId = cohort$cohortId) |>
-          dplyr::relocate(dplyr::all_of(c("cohortId", "conceptSetId")))
+          dplyr::mutate(cohortId = cohort$cohortId)
       }
     }
     if (length(conceptSets) == 0) {
       return(NULL)
     }
     conceptSets <- dplyr::bind_rows(conceptSets) |>
-      dplyr::arrange(dplyr::all_of(c("cohortId", "conceptSetId")))
-
+      dplyr::arrange("cohortId", "conceptSetId")
+    
     conceptSetSig <- list()
     for (i in (1:nrow(conceptSets))) {
       conceptSetSig[[i]] <- conceptSets[i, ]
       conceptSetExpressionSignature <-
         convertConceptSetExpressionToDataFrame(conceptSetExpression = conceptSetSig[[i]]$conceptSetExpression |>
-          RJSONIO::fromJSON(digits = 23)) |>
+                                                 RJSONIO::fromJSON(digits = 23)) |>
         dplyr::select(
           .data$conceptId,
           .data$includeDescendants,
@@ -81,40 +74,30 @@ extractConceptSetsInCohortDefinitionSet <-
       conceptSetSig[[i]]$conceptSetExpressionSignature <-
         conceptSetExpressionSignature
       conceptSetSig[[i]] <- conceptSetSig[[i]] |>
-        dplyr::select(
-          .data$cohortId,
-          .data$conceptSetId,
-          .data$conceptSetExpressionSignature
-        ) |>
+        dplyr::select(.data$cohortId,
+                      .data$conceptSetId,
+                      .data$conceptSetExpressionSignature) |>
         dplyr::distinct()
     }
     conceptSetSig <- dplyr::bind_rows(conceptSetSig)
     uniqueConceptSets <- conceptSetSig |>
       dplyr::select(.data$conceptSetExpressionSignature) |>
       dplyr::distinct() |>
       dplyr::mutate(uniqueConceptSetId = dplyr::row_number())
-
+    
     conceptSetSig <- conceptSetSig |>
-      dplyr::inner_join(uniqueConceptSets,
-        by = "conceptSetExpressionSignature"
-      ) |>
+      dplyr::inner_join(uniqueConceptSets, by = "conceptSetExpressionSignature") |>
       dplyr::select(-.data$conceptSetExpressionSignature)
-
+    
     conceptSets <- conceptSets |>
-      dplyr::left_join(conceptSetSig, by = c(
-        "cohortId",
-        "conceptSetId"
-      )) |>
+      dplyr::select(-uniqueConceptSetId) |>
+      dplyr::left_join(conceptSetSig, by = c("cohortId", "conceptSetId")) |>
       dplyr::distinct() |>
-      dplyr::relocate(
-        .data$uniqueConceptSetId,
-        .data$cohortId,
-        .data$conceptSetId
-      ) |>
-      dplyr::arrange(
-        .data$uniqueConceptSetId,
-        .data$cohortId,
-        .data$conceptSetId
-      )
+      dplyr::relocate(.data$uniqueConceptSetId,
+                      .data$cohortId,
+                      .data$conceptSetId) |>
+      dplyr::arrange(.data$uniqueConceptSetId,
+                     .data$cohortId,
+                     .data$conceptSetId)
     return(conceptSets)
   }

R/GetConceptSetOccurrenceDate.R

@@ -53,7 +53,7 @@ getConceptSetOccurrenceDate <- function(connection,
                                         subset = c("all"),
                                         limitToPersonDate = TRUE,
                                         restrictToObservationPeriod = TRUE,
-                                        tempEmulationSchema = NULL) {
+                                        tempEmulationSchema = getOption("sqlRenderTempEmulationSchema")) {
   subset <- tolower(subset) |>
     stringr::str_trim() |>
     stringr::str_squish()

R/ResolveConceptSetExpression.R

@@ -32,118 +32,25 @@
 resolveConceptSetExpression <- function(conceptSetExpression,
                                         connection = NULL,
                                         connectionDetails = NULL,
-                                        tempEmulationSchema = NULL,
-                                        vocabularyDatabaseSchema = "vocabulary") {
+                                        tempEmulationSchema = getOption("sqlRenderTempEmulationSchema"),
+                                        vocabularyDatabaseSchema) {
   if (is.null(connection)) {
     connection <- DatabaseConnector::connect(connectionDetails)
     on.exit(DatabaseConnector::disconnect(connection))
   }
-
-  # convert concept set expression R object (list) to data frame
-  conceptSetExpressionDataFrame <-
-    convertConceptSetExpressionToDataFrame(
-      updateVocabularyFields = FALSE,
-      conceptSetExpression = conceptSetExpression,
+
+  conceptSetSql <- CirceR::buildConceptSetQuery(conceptSetJSON = conceptSetExpression |> RJSONIO::toJSON(digits = 23))
+
+  resolvedConceptIds <-
+    DatabaseConnector::renderTranslateQuerySql(
+      connection = connection,
+      sql = conceptSetSql,
+      vocabulary_database_schema = vocabularyDatabaseSchema,
+      snakeCaseToCamelCase = TRUE,
       tempEmulationSchema = tempEmulationSchema
-    )
-
-  # get all descendant concept ids (as dataframe) for concepts that have
-  # includeDescendants selected in conceptSetExpression
-  conceptIdsWithIncludeDescendants <-
-    conceptSetExpressionDataFrame |>
-    dplyr::filter(.data$includeDescendants == TRUE) |>
-    dplyr::pull(.data$conceptId)
-
-  if (length(conceptIdsWithIncludeDescendants) == 0) {
-    # get all resolved concept Ids
-    resolvedConceptIds <-
-      setdiff(
-        conceptSetExpressionDataFrame$conceptId,
-        conceptSetExpressionDataFrame |>
-          dplyr::filter(.data$isExcluded == TRUE) |>
-          dplyr::pull(.data$conceptId)
-      )
-  } else {
-    descendantConcepts <-
-      getConceptDescendant(
-        connection = connection,
-        connectionDetails = connectionDetails,
-        conceptIds = conceptIdsWithIncludeDescendants,
-        tempEmulationSchema = tempEmulationSchema,
-        vocabularyDatabaseSchema = vocabularyDatabaseSchema
-      )
-
-    # get all conceptIds (as dataframe) that are excluded in concept set expression
-    excludedConceptIds <- conceptSetExpressionDataFrame |>
-      dplyr::filter(.data$isExcluded == TRUE) |>
-      dplyr::select(.data$conceptId)
-
-    # get all conceptIds (as dataframe) that are excluded in concept set expression with descendants
-    excludedConceptIdsWithDescendants <- descendantConcepts |>
-      dplyr::filter(.data$ancestorConceptId %in% (
-        c(
-          conceptSetExpressionDataFrame |>
-            dplyr::filter(.data$isExcluded == TRUE) |>
-            dplyr::filter(.data$includeDescendants == TRUE) |>
-            dplyr::pull(.data$conceptId) |>
-            unique(),
-          0
-        ) |> unique()
-      )) |>
-      dplyr::select(.data$descendantConceptId) |>
-      dplyr::distinct()
-
-    # conceptIds in conceptSetExpression table
-    conceptIdsInConceptSetExpressionTableToBeIncluded <-
-      union(
-        x = conceptSetExpressionDataFrame |>
-          dplyr::pull(.data$conceptId) |>
-          unique(),
-        y = descendantConcepts |>
-          dplyr::pull(.data$descendantConceptId) |>
-          unique()
-      ) |> unique()
-
-
-    conceptIdsInConceptSetExpressionTableToBeExcluded <-
-      union(
-        x = excludedConceptIds |>
-          dplyr::pull(.data$conceptId) |>
-          unique(),
-        y = excludedConceptIdsWithDescendants |>
-          dplyr::pull(.data$descendantConceptId) |>
-          unique()
-      ) |>
-      unique()
-
-    # removed all excluded conceptIds including those with descendants == TRUE
-    resolvedConceptIdArray <-
-      setdiff(
-        x = conceptIdsInConceptSetExpressionTableToBeIncluded,
-        y = conceptIdsInConceptSetExpressionTableToBeExcluded
-      )
-
-    # get all resolved concept Ids
-    resolvedConceptIds <- dplyr::union(
-      conceptSetExpressionDataFrame |>
-        dplyr::filter(.data$isExcluded == FALSE) |>
-        dplyr::select(.data$conceptId),
-      descendantConcepts |>
-        dplyr::select(.data$descendantConceptId) |>
-        dplyr::rename("conceptId" = .data$descendantConceptId)
     ) |>
-      dplyr::filter(.data$conceptId %in% resolvedConceptIdArray) |>
-      dplyr::pull(.data$conceptId) |>
-      unique()
-  }
-
-  conceptIdDetails <-
-    getConceptIdDetails(
-      conceptIds = resolvedConceptIds,
-      connection = connection,
-      tempEmulationSchema = tempEmulationSchema,
-      vocabularyDatabaseSchema = vocabularyDatabaseSchema
-    )
-
-  return(conceptIdDetails)
+    dplyr::arrange(conceptId) |> 
+    dplyr::tibble()
+
+  return(resolvedConceptIds)
 }