Commit cf262bdf authored by Petar Horki's avatar Petar Horki

Commit before merge.

parent cd9cd5c6
......@@ -150,8 +150,7 @@ Factory.Dict <- function() {
#'
#' @details
#' Fill the global `_myDict`variable with definitions of the 'Condition:255573'\cr
#' and 'Condition:317009' variables.
#' '' definitions.\cr
#' and 'Condition:317009' variables.\cr
#' Returns the associated dictionary entries without printing them.
#'
#' @export
......@@ -239,6 +238,46 @@ DataModel.BodyMeasurementTestData <- function() {
invisible(Get(c('Measurement:3024171', 'Measurement:3027018', 'Measurement:40762499')))
}
#==============================================================================
#' DataModel.SynpuffConditionTestData
#'
#' @description
#' Fill the global dictionary variable with a selection of condition test\cr
#' data, also available in the synpuff data set.
#'
#' @details
#' Fill the global `_myDict`variable with the following variable definitions:\cr
#' 'Condition:201826', 'Condition:319835'.\cr
#' Returns the associated dictionary entries without printing them.
#'
#' @export
DataModel.SynpuffConditionTestData <- function() {
#----------------------------------------------------------------------------
Set('Condition:201826', 'entityType', 'Participant')
Set('Condition:201826', 'isRepeatable', FALSE)
Set('Condition:201826', 'valueType', 'boolean') # TODO überprüfen
Set('Condition:201826', 'Attribute', Attribute('Clinical Finding', 'label', 'en'))
Set('Condition:201826', 'Attribute', Attribute('Type II diabetes mellitus', 'description', 'en'))
Set('Condition:319835', 'entityType', 'Participant')
Set('Condition:319835', 'isRepeatable', FALSE)
Set('Condition:319835', 'valueType', 'boolean') # TODO überprüfen
Set('Condition:319835', 'Attribute', Attribute('Clinical Finding', 'label', 'en'))
Set('Condition:319835', 'Attribute', Attribute('Congestive heart disease', 'description', 'en'))
#----------------------------------------------------------------------------
# Return the associated dictionary entries
invisible(Get(c('Condition:201826', 'Condition:319835')))
}
#==============================================================================
#' DataModel.SynpuffMeasurementTestData
#'
......@@ -248,7 +287,7 @@ DataModel.BodyMeasurementTestData <- function() {
#'
#' @details
#' Fill the global `_myDict`variable with the following variable definitions:\cr
#' 'Measurement2212648:', 'Measurement:4192940'.\cr
#' 'Measurement:2212648:', 'Measurement:2212093'.\cr
#' Returns the associated dictionary entries without printing them.
#'
#' @export
......@@ -267,19 +306,19 @@ DataModel.SynpuffMeasurementTestData <- function() {
#----------------------------------------------------------------------------
#
Set('Measurement:4192940', 'entityType', 'Participant')
Set('Measurement:2212093', 'entityType', 'Participant')
Set('Measurement:4192940', 'isRepeatable', FALSE)
Set('Measurement:2212093', 'isRepeatable', FALSE)
Set('Measurement:4192940', 'valueType', 'boolean') # TODO überprüfen
Set('Measurement:2212093', 'valueType', 'boolean') # TODO überprüfen
Set('Measurement:4192940', 'Attribute', Attribute('LOINC:', 'label', 'en'))
Set('Measurement:2212093', 'Attribute', Attribute('LOINC:', 'label', 'en'))
Set('Measurement:4192940', 'Attribute', Attribute('', 'description', 'en'))
Set('Measurement:2212093', 'Attribute', Attribute('', 'description', 'en'))
#----------------------------------------------------------------------------
# Return the associated dictionary entries
invisible(Get(c('Measurement:2212648', 'Measurement:4192940')))
invisible(Get(c('Measurement:2212648', 'Measurement:2212093')))
}
#==============================================================================
......@@ -2198,58 +2237,8 @@ GetCohortFromId <- function(id, baseUrl){
# TODO add test
}
#==============================================================================
#' DataPackage.FromDict
#'
#' @description
#' Create a DataPackage structure from dictionary entries
#'
#' @details
#' Create a DataPackage from corresponding dictionary entries.
#'
#' @param dictIn The dictionary containing the DataPackage entries.
#'
#' @export
DataPackage.FromDict <- function(dictIn) {
# check if the package is available
if (!requireNamespace("tidyr", quietly = TRUE)) {
stop("Package \"tidyr\" needed for this function to work. Please install it.",
call. = FALSE)
}
if (0 != dim(dictIn)[1]) {
# TODO
} else {
# TODO unit test
myDataPackage <- DataPackage()
}
return(myDataPackage)
}
#==============================================================================
#' GetDataGroups
GetDataGroups <- function(dataGroupDomainID) {
# check if the package is available
if (!requireNamespace("purrr", quietly = TRUE)) {
stop("Package \"purrr\" needed for this function to work. Please install it.",
call. = FALSE)
}
myDataGroups <-
dataGroupDomainIDIn %>%
map(DataGroupClosure) %>% # generate functions for creating the DataGroups
map( ~ .x()) %>% # generate variables by executing the above functions
# FIXXME hier braucht man wahrscheinlich einen Wräper rund um die "unite/intersect" Funktionen
reduce(bind_rows) # bind the DataGroups
return(myVariables)
}
#==============================================================================
#' Factory.MapDataPackage
#' Factory.DataPackage
#'
#' @description
#' Construct and return a function for mapping a data package.
......@@ -2272,33 +2261,28 @@ GetDataGroups <- function(dataGroupDomainID) {
#' @param dataGroupDomainIDIn Set of dataGroupDomainIDs to map.
#'
#' @export
Factory.MapDataPackage <- function(dataGroupDomainIDIn) {
Factory.DataPackage <- function(dataGroupDomainIDIn) {
# Aggregate concept IDS by the domain IDs.
myAggConceptIDsByDomainID <- AggConceptIDsByDomainID(dataGroupDomainIDIn)
myMapFun = function(connectionIn) {
myAggConceptIDsByDomainID %>%
# FIXME use `_DF_DATA_GROUP_DOMAIN_NAME` in place of 'dataGroupDomainID'
map( ~ `_MapClass.Get`(connectionIn,
do.call(paste0("RenderCohort", .$dataGroupDomainID),
list(.$aggConceptIDs)))) %>%
reduce( ~ left_join, by = c("SUBJECT_ID", "VISIT_OCCURRENCE_ID"))
myDataGroupFun = function(connectionIn, cohortDefinitionIDIn) {
# generate functions for creating the dataPackages
# FIXME use `_DF_DATA_GROUP_DOMAIN_NAME` in place of 'dataGroupDomainID'
pmap(list(dataGroupDomainID = myAggConceptIDsByDomainID$dataGroupDomainID,
aggConceptIDs = myAggConceptIDsByDomainID$aggConceptIDs),
function(dataGroupDomainID, aggConceptIDs) {
DataGroupClosure(dataGroupDomainID, aggConceptIDs)
}
) %>%
map( ~ .x(connectionIn, cohortDefinitionIDIn)) %>% # execute the above functions
reduce(left_join, by = c("SUBJECT_ID", "VISIT_OCCURRENCE_ID")) # join the dataPackages
}
# myResults <- pmap(list(dataGroupDomainIDIn = myAggConceptIDsByDomainID$dataGroupDomainID,
# aggConceptIDsIn = myAggConceptIDsByDomainID$aggConceptIDs),
# function(dataGroupDomainIDIn, aggConceptIDsIn) {
# `_MapClass.Get`(myOmopConn,
# do.call(paste0("RenderCohort", dataGroupDomainIDIn),
# list(myCohortDefinition, aggConceptIDsIn)))
# }
# ) %>% reduce(left_join, by = c("SUBJECT_ID", "VISIT_OCCURRENCE_ID"))
return(myMapFun)
return(myDataGroupFun)
}
#==============================================================================
#' DataGroup
#' DataGroupClosure
#'
#' @description
#' Create ...
......@@ -2306,12 +2290,18 @@ Factory.MapDataPackage <- function(dataGroupDomainIDIn) {
#' @details
#' Create ...
#'
#' @param IDIn
#' ...
#' @param dataGroupDomainIDIn
#' @param aggConceptIDIn
#'
#' @export
DataGroup <- function(IDIn, ...) {
# TODO
DataGroupClosure <- function(dataGroupDomainIDIn, aggConceptIDIn) {
myDataGroupFun <- function(connectionIn, cohortDefinitionIDIn) {
`_MapClass.Get`(connectionIn,
do.call(paste0("RenderCohort", dataGroupDomainIDIn),
list(cohortDefinitionIDIn, aggConceptIDIn)))
}
return(myDataGroupFun)
}
#==============================================================================
......
o Tutorial for Multiprocessing in Julia: writing a Module
(Quelle: https://discourse.imbi.uni-freiburg.de/t/tutorial-for-multiprocessing-in-julia-writing-a-module/744)
Link: https://techytok.ml/multiprocessing-in-julia-module/?utm_source=share&utm_medium=ios_app&utm_name=iossmf
Lessons to learn:
Automatic creation of folders needed for a new module
Most efficient way to implement summation via Distributed: @distributed (+) for
@everywhere , @sync , @distributed , SharedArray
Using Submodules via
include("SubModule.jl") # Exchanged by your file name
using .SubMod1 # Exchanged by your Submodule name
Progress bar:
p = Progress(length(x),"Progress: ")
update!(p, 0)
for i = 1:length(x)
# some hard computations....
next!(p)
end
Distributed computing:
using Distributed
addprocs(n) # e.g. addprocs(2)
Activate environment when activating your new module
@everywhere using Pkg
@everywhere Pkg.activate("PathToYourNewModule")
@evverywhere using YourNewModule
Precompiling your module to speed up the loading: Add __precompile__() before your module
\ No newline at end of file
......@@ -238,6 +238,61 @@ test_that("select with simple subquery ('LIKE') SQL Template is rendered as expe
# CloseOmopConnection(omopConn)
# })
#====================================================================
test_that("RenderCohortCondition is rendered as expected", {
myDictFun <- Factory.Dict()
# initialize dictionary
myDictFun()
# load the dictionary with synpuff condition test data concepts
DataModel.SynpuffConditionTestData()
myCohortDefinition = 2
myDict <- Get()
myDomains <- c('Condition:201826', 'Condition:319835')
expect_true(all(distinct(myDict, domain)$domain %in% myDomains, TRUE))
myDF <- AggConceptIDsByDomainID()
myAggConditionConceptIDs <- noquote(str_split(myDF$aggConceptIDs["Condition" == myDF$dataGroupDomainID], ', '))
renderedSql <- RenderCohortCondition(myCohortDefinition, myAggConditionConceptIDs[[1]])
expect_that(renderedSql, equals("WITH koh AS (\r\nSELECT subject_id, cohort_start_date, cohort_end_date\r\nFROM synpuf_results.cohort \r\nWHERE 2 = cohort_definition_id \r\n), vis AS ( \r\nSELECT DISTINCT person_id, visit_occurrence_id\r\nFROM koh \r\nINNER JOIN \r\n synpuf_cdm.visit_occurrence AS v ON\r\n koh.subject_id = v.person_id \r\n AND v.visit_start_date >= cohort_start_date \r\n AND v.visit_end_date <= cohort_end_date \r\n) \r\nSELECT\r\n koh.subject_id,\r\n vis.visit_occurrence_id,\r\n cond.condition_occurrence_id,\r\n cond.condition_concept_id \r\nFROM koh\r\nINNER JOIN \r\n vis ON\r\n koh.subject_id = vis.person_id \r\nINNER JOIN \r\n synpuf_cdm.condition_occurrence AS cond ON\r\n vis.visit_occurrence_id = cond.visit_occurrence_id\r\n AND cond.condition_concept_id IN (201826,319835)\r\n;"))
})
#====================================================================
test_that("RenderCohortMeasurement is rendered as expected", {
myDictFun <- Factory.Dict()
# initialize dictionary
myDictFun()
# load the dictionary with synpuff measurement test data concepts
DataModel.SynpuffMeasurementTestData()
myCohortDefinition = 2
myDict <- Get()
myDomains <- c('Measurement:2212648', 'Measurement:2212093')
expect_true(all(distinct(myDict, domain)$domain %in% myDomains, TRUE))
myDF <- AggConceptIDsByDomainID()
myAggMeasurementConceptIDs <- noquote(str_split(myDF$aggConceptIDs["Measurement" == myDF$dataGroupDomainID], ', '))
renderedSql <- RenderCohortMeasurement(myCohortDefinition, myAggMeasurementConceptIDs[[1]])
expect_that(renderedSql, equals("WITH koh AS (\r\nSELECT subject_id, cohort_start_date, cohort_end_date\r\nFROM synpuf_results.cohort \r\nWHERE 2 = cohort_definition_id \r\n), vis AS ( \r\nSELECT DISTINCT person_id, visit_occurrence_id\r\nFROM koh \r\nINNER JOIN \r\n synpuf_cdm.visit_occurrence AS v ON\r\n koh.subject_id = v.person_id \r\n AND v.visit_start_date >= cohort_start_date \r\n AND v.visit_end_date <= cohort_end_date \r\n) \r\nSELECT\r\n koh.subject_id,\r\n vis.visit_occurrence_id,\r\n meas.measurement_id,\r\n meas.measurement_concept_id,\r\n meas.value_as_number \r\nFROM koh\r\nINNER JOIN \r\n vis ON\r\n koh.subject_id = vis.person_id \r\nINNER JOIN \r\n synpuf_cdm.measurement AS meas ON\r\n vis.visit_occurrence_id = meas.visit_occurrence_id\r\n AND meas.measurement_concept_id IN (2212648,2212093)\r\n;"))
})
#====================================================================
test_that("No error occured during SQL execution", {
......@@ -826,6 +881,42 @@ test_that("DataModel.BodyMeasurementTestData declares body measurement related v
expect_true(all(distinct(myDict, domain)$domain %in% myDomains, TRUE))
})
#====================================================================
test_that("DataModel.SynpuffConditionTestData declares the following variables in the global dictionary: 'Condition:255573', 'Condition:317009'", {
myDictFun <- Factory.Dict()
# initialize dictionary
myDict <- myDictFun()
DataModel.SynpuffConditionTestData()
myDomains = c('Condition:201826', 'Condition:319835')
myKeys <- c('entityType', 'isRepeatable', 'valueType', 'Attribute', 'Category')
expect_true(all(distinct(myDict, key)$key %in% myKeys, TRUE))
expect_true(all(distinct(myDict, domain)$domain %in% myDomains, TRUE))
})
#====================================================================
test_that("DataModel.SynpuffMeasurementTestData declares the following variables in the global dictionary: 'Measurement:2212648', 'Measurement:2212093'", {
myDictFun <- Factory.Dict()
# initialize dictionary
myDict <- myDictFun()
DataModel.ConditionTestData()
myDomains = c('Measurement:2212648', 'Measurement:2212093')
myKeys <- c('entityType', 'isRepeatable', 'valueType', 'Attribute', 'Category')
expect_true(all(distinct(myDict, key)$key %in% myKeys, TRUE))
expect_true(all(distinct(myDict, domain)$domain %in% myDomains, TRUE))
})
#====================================================================
test_that("data model for demographics is declared", {
......@@ -2476,7 +2567,7 @@ test_that("dataGroupDomainIDs can be extracted from a global dictionary, along w
myMeasurementConceptIDs <- c("3024171, 3027018, 40762499")
myDF <- AggConceptIDsByDomainID()
myDF <- AggConceptIDsByDomainID(myDataGroupDomainIDs)
expect_true(all(myDF[[`_DF_DATA_GROUP_DOMAIN_NAME`]] %in% myDataGroupDomainIDs, TRUE))
......@@ -2484,6 +2575,33 @@ test_that("dataGroupDomainIDs can be extracted from a global dictionary, along w
expect_equal(myDF["Measurement" == myDF[`_DF_DATA_GROUP_DOMAIN_NAME`], ]$aggConceptIDs, myMeasurementConceptIDs)
})
#====================================================================
test_that("calling AggConceptIDsByDomainID without parameters is equal to calling AggConceptIDsByDomainID with a parameter containing all unique dataGroupDomainIDs", {
myDictFun <- Factory.Dict()
# initialize dictionary
myDictFun()
# load the dictionary with condition and body measurement test data concepts
DataModel.ConditionTestData()
DataModel.BodyMeasurementTestData()
myDict <- Get()
myDataGroupDomainIDs <- c("Condition", "Measurement")
myDF <- AggConceptIDsByDomainID(myDataGroupDomainIDs)
myNoParamDF <- AggConceptIDsByDomainID()
expect_equal(myDF["Condition" == myDF[`_DF_DATA_GROUP_DOMAIN_NAME`], ]$aggConceptIDs,
myNoParamDF["Condition" == myDF[`_DF_DATA_GROUP_DOMAIN_NAME`], ]$aggConceptIDs)
expect_equal(myDF["Measurement" == myDF[`_DF_DATA_GROUP_DOMAIN_NAME`], ]$aggConceptIDs,
myNoParamDF["Measurement" == myDF[`_DF_DATA_GROUP_DOMAIN_NAME`], ]$aggConceptIDs)
})
# UNCOMMENT ME BEGIN
# #====================================================================
#
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment