From 1ee792ff3012f0608d6257e9ebe4d05207808716 Mon Sep 17 00:00:00 2001 From: Gowtham Rao Date: Mon, 30 Sep 2024 06:53:16 -0400 Subject: [PATCH] simplify some code --- R/ExtractConceptSetsInCohortDefinition.R | 12 +- R/ExtractConceptSetsInCohortDefinitionSet.R | 63 ++++------ R/GetConceptSetOccurrenceDate.R | 2 +- R/ResolveConceptSetExpression.R | 123 +++----------------- man/getConceptSetOccurrenceDate.Rd | 2 +- man/resolveConceptSetExpression.Rd | 4 +- 6 files changed, 50 insertions(+), 156 deletions(-) diff --git a/R/ExtractConceptSetsInCohortDefinition.R b/R/ExtractConceptSetsInCohortDefinition.R index 06d4358..e51546a 100644 --- a/R/ExtractConceptSetsInCohortDefinition.R +++ b/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 { diff --git a/R/ExtractConceptSetsInCohortDefinitionSet.R b/R/ExtractConceptSetsInCohortDefinitionSet.R index b88a4cf..438ddec 100644 --- a/R/ExtractConceptSetsInCohortDefinitionSet.R +++ b/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,11 +74,9 @@ 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) @@ -93,28 +84,20 @@ extractConceptSetsInCohortDefinitionSet <- 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) } diff --git a/R/GetConceptSetOccurrenceDate.R b/R/GetConceptSetOccurrenceDate.R index 397551b..9536460 100644 --- a/R/GetConceptSetOccurrenceDate.R +++ b/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() diff --git a/R/ResolveConceptSetExpression.R b/R/ResolveConceptSetExpression.R index 6c66095..ec1b19b 100644 --- a/R/ResolveConceptSetExpression.R +++ b/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) } diff --git a/man/getConceptSetOccurrenceDate.Rd b/man/getConceptSetOccurrenceDate.Rd index f830bd1..f59bacc 100644 --- a/man/getConceptSetOccurrenceDate.Rd +++ b/man/getConceptSetOccurrenceDate.Rd @@ -11,7 +11,7 @@ getConceptSetOccurrenceDate( subset = c("all"), limitToPersonDate = TRUE, restrictToObservationPeriod = TRUE, - tempEmulationSchema = NULL + tempEmulationSchema = getOption("sqlRenderTempEmulationSchema") ) } \arguments{ diff --git a/man/resolveConceptSetExpression.Rd b/man/resolveConceptSetExpression.Rd index 21cc45e..f87ce73 100644 --- a/man/resolveConceptSetExpression.Rd +++ b/man/resolveConceptSetExpression.Rd @@ -8,8 +8,8 @@ resolveConceptSetExpression( conceptSetExpression, connection = NULL, connectionDetails = NULL, - tempEmulationSchema = NULL, - vocabularyDatabaseSchema = "vocabulary" + tempEmulationSchema = getOption("sqlRenderTempEmulationSchema"), + vocabularyDatabaseSchema ) } \arguments{