Commit cfe849a8 authored by Petar Horki's avatar Petar Horki

fix: restoring master branch to a stable state

parent c09412a3
......@@ -17,6 +17,4 @@ importFrom("purrr", "%>%")
importFrom("jsonlite", "toJSON")
exportPattern("^[[:alpha:]]+")
export(`_MapClass.Get`)
export(`_MapClass.Parse`)
export(`_MapClass.Set`)
......@@ -607,342 +607,3 @@ UpdateVariableIndex <- function(variablesIn) {
return(myVariables)
}
#==============================================================================
#' `_MapClass.Get`
#'
#' @description
#' Gets ICD/OPS etc. code as input an yields results of sql query
#'
#' @details
#' ...\cr
#'
#' Assumption: ...ICD/OPS etc. lower level consists of leafs only.
#' "connection" parameter works.
#'
#' @param sourceCode The code to be mapped
#' @param connection The connection to omop database
#' @param searchChildren If TRUE will search through all children of code i.e. J44.*
#'
#'
#' @export
`_MapClass.Get` <- function(sourceCode, connection, searchChildren) {
# check if the needed variables for use as constants are defined
if (!exists("_MAP_CLASS_SQL_TEMPLATE") | !exists("_MAP_CLASS_DB_SCHEMA")) {
Constants()
}
# add '*' to sourceCode (i.e J44 -> J44*)
if(searchChildren) {
sourceCode = paste(sourceCode, "*", sep = "")
}
# replace '*' in given code parameter with % to use in sql
value1 = gsub("[*]", "%", sourceCode)
renderedSql <- SqlRender::render(`_MAP_CLASS_SQL_TEMPLATE`,
databaseSchema = `_MAP_CLASS_DB_SCHEMA`,
table1 = 'source_to_concept_map',
table2 = 'concept',
columns = c('SOURCE_CODE', 'TARGET_CONCEPT_ID', 'CONCEPT_NAME', 'DOMAIN_ID',
'CONCEPT_CLASS_ID', 'CONCEPT.VALID_START_DATE', 'CONCEPT.VALID_END_DATE',
'SOURCE_VOCABULARY_ID', 'STANDARD_CONCEPT'),
joinAttr1 = 'target_concept_id',
joinAttr2 = 'concept_id',
condition1 = 'source_code',
operator1 = 'LIKE',
value1 = sprintf("'%s'", value1),
limit = 10)
sqlResults <- ExecuteSQL(connection, renderedSql)
return(sqlResults)
}
#==============================================================================
#' `_MapClass.Parse`
#'
#' @description
#' Parses through table and gets the values later needed for Set() method
#'
#' @details
#' ...\cr
#'
#' Assumption: ...Results of `_MapClass.Get`() are available
#'
#' @param sqlResults The table returned by `_MapClass.Get`()
#' @export
`_MapClass.Parse` <- function(sqlResults) {
# vectors for the source codes and concept name
sourceNomCodes <- c() # sourceNomCodes
conceptNames <- c() # conceptNames
# get the source codes (if there are multiple) , concept name and source vocabulary id
for (i in 1:length(sqlResults[[1]])) {
# check only standard concepts, others will have value 'NA'
if (!is.na(sqlResults[['STANDARD_CONCEPT']][i])) {
conceptNames <- c(conceptNames, sqlResults[['CONCEPT_NAME']][i])
sourceNomCodes <- c(sourceNomCodes, sqlResults[['SOURCE_CODE']][i])
sourceVocabularyID <- sqlResults[['SOURCE_VOCABULARY_ID']][i]
}
}
# throw out duplicates
conceptNames <- unique(conceptNames)
sourceNomCodes <- unique(sourceNomCodes)
# test if only duplicates in sourceVocabularyID
if(1 != length(unique(sourceVocabularyID))) {
warning("Multiple source vocabulary IDs where only one is expected.")
}
sourceVocabularyID <- unique(sourceVocabularyID)
# need only one domain since it is constant
myDomain = paste(sqlResults[,'DOMAIN_ID'], ":", sqlResults[,'TARGET_CONCEPT_ID'], sep="")
attribute = "Primary diagnosis / Therapy / etc."
# Quick and dirty parameter workaround
myKeys = c('entityType', 'isRepeatable', 'valueType', 'Attribute', 'Attribute', 'Attribute')
myValues = list('Participant', 'FALSE', 'boolean', Attribute(attribute, 'label', 'en'),
Attribute(conceptNames[1], 'description', 'en'),
Attribute(paste(paste0(sourceVocabularyID, ':'), paste(sourceNomCodes, collapse=', '), sep=' '), 'source codes', 'en'))
return(list("myDomain"=myDomain, "myKeys"=myKeys, "myValues"=myValues))
}
#==============================================================================
#' `_MapClass.Set`
#'
#' @description
#' Applies set() function for given domain and key-value pairs
#'
#' @details
#' ...\cr
#'
#' Assumption: ...Results of `_MapClass.Get`() have been parsed and are available
#'
#' @param parsedResults vector which contains myDomain, myKeys and myValues
#' @export
`_MapClass.Set` <- function(parsedResults) {
myDomain <- parsedResults[[1]]
myKeys <- parsedResults[[2]]
myValues <- parsedResults[[3]]
for(i in 1:length(myKeys)) {
Set(domainIn=myDomain, keyIn=myKeys[[i]], valueIn=myValues[[i]])
}
return(list("myDomain"=myDomain, "myKeys"=myKeys, "myValues"=myValues))
}
#==============================================================================
#' MapClass
#'
#' @description
#' Template for executing multiple cohesive functions at once
#'
#' @details
#' Template for executing multiple cohesive functions at once
#' (i.e. `_MapClass.Get`(), `_MapClass.Parse`() and `_MapClass.Set`())\cr
#'
#' Assumption: ...Results of `_MapClass.Get`() have been parsed and are available\cr
#' ICD/OPS etc. lower level consists of leafs only.\cr
#' "connection" parameter works.
#' @param sourceCode code to be mapped
#' @param connection connection to database
#' @param searchChildren if TRUE, will search through child codes
#' @export
MapClass <- function(sourceCode, connection, searchChildren) {
getterResults <- `_MapClass.Get`(sourceCode, connection, searchChildren)
parserResults <- `_MapClass.Parse`(getterResults)
setterResults <- `_MapClass.Set`(parserResults)
}
#==============================================================================
#'
Factory.Map <- function(classification){
# TODO function that reads and returns sql from file(s) in inst/sql/postgres
# ... <- f(paste0("_MAP_", classification, "_DB_SCHEMA"))
myRenderedSql <- do.call(paste0("Render", classification), list(...))
# TODO where to call classification specific parser/setter parts?
# OPTION A
myMapFun = function(sourceCode, connection){
# OPTION B
getterResults <- `_MapClass.Get`(sourceCode, connection, myRenderedSql)
parserResults <- `_MapClass.Parse`(getterResults)
setterResults <- `_MapClass.Set`(parserResults)
return(setterResults)
}
return(myMapFun)
}
#==============================================================================
#'
RenderLOINC <- function(...) {
renderedSql <- SqlRender::render(sqlTemplate,
databaseSchema = databaseSchema,
table1 = 'concept',
columns = '*',
attr1 = 'concept_code',
attr2 = 'standard_concept',
operator1 = 'LIKE',
operator2 = 'LIKE',
value1 = sprintf("'%s'", value1),
value2 = sprintf("'%s'", 'S'),
limit = 10)
}
#==============================================================================
#'
RenderICD <- function(...) {
renderedSql <- SqlRender::render(`_MAP_CLASS_SQL_TEMPLATE`,
databaseSchema = `_MAP_CLASS_DB_SCHEMA`,
table1 = 'source_to_concept_map',
table2 = 'concept',
columns = c('SOURCE_CODE', 'TARGET_CONCEPT_ID', 'CONCEPT_NAME', 'DOMAIN_ID',
'CONCEPT_CLASS_ID', 'CONCEPT.VALID_START_DATE', 'CONCEPT.VALID_END_DATE',
'SOURCE_VOCABULARY_ID', 'STANDARD_CONCEPT'),
joinAttr1 = 'target_concept_id',
joinAttr2 = 'concept_id',
condition1 = 'source_code',
operator1 = 'LIKE',
value1 = sprintf("'%s'", value1),
limit = 10)
}
getLoinc <- function(loincCode, connection, searchChildren) {
sqlTemplate <- "Select @columns FROM @databaseSchema.@table1 WHERE @attr1 @operator1 @value1 AND @attr2 @operator2 @value2{0 != @limit}?{ LIMIT @limit};"
databaseSchema = 'vocabulary'
# add '*' to loincCode (i.e J44 -> J44*)
if(searchChildren) {
loincCode = paste(loincCode, "*", sep = "")
}
# replace '*' in given code parameter with % to use in sql
value1 = gsub("[*]", "%", loincCode)
renderedSql <- SqlRender::render(sqlTemplate,
databaseSchema = databaseSchema,
table1 = 'concept',
columns = '*',
attr1 = 'concept_code',
attr2 = 'standard_concept',
operator1 = 'LIKE',
operator2 = 'LIKE',
value1 = sprintf("'%s'", value1),
value2 = sprintf("'%s'", 'S'),
limit = 10)
sqlResults <- ExecuteSQL(connection, renderedSql)
#DatabaseConnector::disconnect(omopConn)
return(sqlResults)
}
parseLoinc <- function(sqlResults) {
# vectors for the source codes and concept name
conceptClassIds <- c()
conceptIds <- c()
conceptNames <- c() # conceptNames
# get the source codes (if there are multiple) , concept name and source vocabulary id
for (i in 1:length(sqlResults[[1]])) {
# check only standard concepts, others will have value 'NA'
if (!is.na(sqlResults[['STANDARD_CONCEPT']][i])) {
conceptNames <- c(conceptNames, sqlResults[['CONCEPT_NAME']][i])
conceptId <- c(conceptIds, sqlResults[['CONCEPT_ID']][i])
conceptClassId <- c(conceptClassIds, sqlResults[['CONCEPT_CLASS_ID']][i])
sourceVocabularyID <- sqlResults[['SOURCE_VOCABULARY_ID']][i]
domainId <- sqlResults[['DOMAIN_ID']][i]
}
}
# throw out duplicates
conceptNames <- unique(conceptNames)
conceptClassIds <- unique(conceptClassIds)
conceptIds <- unique(conceptIds)
# test if only duplicates in sourceVocabularyID
if(1 != length(unique(sourceVocabularyID))) {
warning("Multiple source vocabulary IDs where only one is expected.")
}
sourceVocabularyID <- unique(sourceVocabularyID)
# need only one domain since it is constant
myDomain = paste(sqlResults[,'DOMAIN_ID'], ":", sqlResults[,'CONCEPT_ID'], sep="")
attribute = conceptNames[[1]]
# Quick and dirty parameter workaround
myKeys = c('entityType', 'isRepeatable', 'valueType', 'Attribute', 'Attribute', 'Attribute')
myValues = list('Participant', 'FALSE', 'boolean', Attribute(attribute, 'label', 'en'),
Attribute(conceptNames[1], 'description', 'en'),
Attribute(paste(paste0(conceptClassIds, ':'), paste(conceptIds, collapse=', '), sep=' '), 'source codes', 'en'))
return(list("myDomain"=myDomain, "myKeys"=myKeys, "myValues"=myValues))
}
setLoinc <- function(parsedResults) {
myDomain <- parsedResults[[1]]
myKeys <- parsedResults[[2]]
myValues <- parsedResults[[3]]
for(i in 1:length(myKeys)) {
Set(domainIn=myDomain, keyIn=myKeys[[i]], valueIn=myValues[[i]])
}
return(list("myDomain"=myDomain, "myKeys"=myKeys, "myValues"=myValues))
}
#
# myFilePath = file.path("../..", "inst", "config.yml")
# myOmopParams <- config::get(file=myFilePath,"omop")
# create OMOP connection
omopConn <- OpenOmopConnection(dbmsIn = myOmopParams$dbms,
serverIn = myOmopParams$server,
userIn = myOmopParams$user,
portIn = myOmopParams$port,
passwordIn = myOmopParams$password,
schemaIn = myOmopParams$schema)
loincCode = '%8302-2%'
getResults <- getLoinc(loincCode, omopConn, FALSE)
parsedResults <- parseLoinc(sqlResults)
setResults <- setLoinc(parsedResults)
print(getResults)
% Generated by roxygen2: do not edit by hand
% Please edit documentation in R/functions.R
\name{Constants}
\alias{Constants}
\title{Constants}
\usage{
Constants()
}
\description{
Create global variables for use as constants.
}
\details{
Create the following global variables for use as constants variable:\cr
`_MAP_ICD_SQL_TEMPLATE`
`_MAP_ICD_DB_SCHEMA`
}
......@@ -2,7 +2,7 @@
% Please edit documentation in R/functions.R
\name{Factory.Dict}
\alias{Factory.Dict}
\title{Dict}
\title{Factory.Dict}
\usage{
Factory.Dict()
}
......
......@@ -15,8 +15,8 @@ the dictionary.}
dictionary.}
}
\description{
Given the domain(s) and key(s), get the values from the global dictionary.\cr
Returns the whole dictionary when called without parameters.
Given the domain(s) and key(s), get the matching entries from the global\cr
dictionary. Returns the whole dictionary when called without parameters.
}
\details{
Assumption: the global dictionary exists.
......
% Generated by roxygen2: do not edit by hand
% Please edit documentation in R/functions.R
\name{MapClass.Parse}
\alias{MapClass.Parse}
\title{MapClass.Parse}
\name{Keys}
\alias{Keys}
\title{Keys}
\usage{
MapClass.Parse(sqlResults)
Keys(domainIn)
}
\arguments{
\item{sqlResults}{The table returned by MapClass.Get()}
\item{valueIn}{The value(s)}
}
\description{
Parses through table and gets the values later needed for Set() method
Given the value(s), get the the matching entries from the global dictionary.
}
\details{
...\cr
Assumption: ...Results of MapClass.Get() are available
Assumption: the global dictionary exists.
}
% Generated by roxygen2: do not edit by hand
% Please edit documentation in R/functions.R
\name{MapClass.Get}
\alias{MapClass.Get}
\title{MapClass.Get}
\usage{
MapClass.Get(sourceCode, connection, searchChildren)
}
\arguments{
\item{sourceCode}{The code to be mapped}
\item{connection}{The connection to omop database}
\item{searchChildren}{If TRUE will search through all children of code i.e. J44.*}
}
\description{
Gets ICD/OPS etc. code as input an yields results of sql query
}
\details{
...\cr
Assumption: ...ICD/OPS etc. lower level consists of leafs only.
"connection" parameter works.
}
% Generated by roxygen2: do not edit by hand
% Please edit documentation in R/functions.R
\name{MapClass}
\alias{MapClass}
\title{MapClass}
\usage{
MapClass(sourceCode, connection, searchChildren)
}
\arguments{
\item{sourceCode}{code to be mapped}
\item{connection}{connection to database}
\item{searchChildren}{if TRUE, will search through child codes}
}
\description{
Template for executing multiple cohesive functions at once
}
\details{
Template for executing multiple cohesive functions at once
(i.e. MapClass.Get(), MapClass.Parse() and MapClass.Set())\cr
Assumption: ...Results of MapClass.Get() have been parsed and are available\cr
ICD/OPS etc. lower level consists of leafs only.\cr
"connection" parameter works.
}
% Generated by roxygen2: do not edit by hand
% Please edit documentation in R/functions.R
\name{MapClass.Set}
\alias{MapClass.Set}
\title{MapClass.Set}
\usage{
MapClass.Set(parsedResults)
}
\arguments{
\item{parsedResults}{vector which contains myDomain, myKeys and myValues}
}
\description{
Applies set() function for given domain and key-value pairs
}
\details{
...\cr
Assumption: ...Results of MapClass.Get() have been parsed and are available
}
......@@ -904,214 +904,3 @@ test_that("multiple variables can be defined automatically", {
expect_that(myEthnicityAttr$locale, equals(c("en", "en")))
})
#====================================================================
test_that("Getting sql results works", {
myFilePath = file.path("../..", "inst", "config.yml")
myOmopParams <- config::get(file = myFilePath, "omop")
# create OMOP connection
omopConn <- OpenOmopConnection(dbmsIn = myOmopParams$dbms,
serverIn = myOmopParams$server,
userIn = myOmopParams$user,
portIn = myOmopParams$port,
passwordIn = myOmopParams$password,
schemaIn = myOmopParams$schema)
sourceCode = 'J44' # NOTE: not a default value
searchChildren = FALSE
sqlResults <- `_MapClass.Get`(sourceCode, omopConn, searchChildren)
expect_that(sqlResults[,'SOURCE_CODE'], equals('J44'))
expect_that(sqlResults[,'TARGET_CONCEPT_ID'], equals(255573))
expect_that(sqlResults[,'CONCEPT_NAME'], equals('Chronic obstructive lung disease'))
expect_that(sqlResults[,'STANDARD_CONCEPT'], equals('S'))
expect_that(sqlResults[,'SOURCE_VOCABULARY_ID'], equals('ICD10GM'))
})
#====================================================================
test_that("Parsing sql results works", {
myFilePath = file.path("../..", "inst", "config.yml")
myOmopParams <- config::get(file = myFilePath, "omop")
# create OMOP connection
omopConn <- OpenOmopConnection(dbmsIn = myOmopParams$dbms,
serverIn = myOmopParams$server,
userIn = myOmopParams$user,
portIn = myOmopParams$port,
passwordIn = myOmopParams$password,
schemaIn = myOmopParams$schema)
sourceCode = 'J44' # NOTE: not a default value
searchChildren = FALSE
sqlResults <- `_MapClass.Get`(sourceCode, omopConn, searchChildren)
parsedResults <- `_MapClass.Parse`(sqlResults)
expect_that(parsedResults$myDomain, equals("Condition:255573"))
expect_that(parsedResults$myKeys, equals(c("entityType", "isRepeatable", "valueType",
"Attribute", "Attribute", "Attribute")))
expect_that(parsedResults$myValues[[1]], equals("Participant"))
expect_that(parsedResults$myValues[[2]], equals("FALSE"))
expect_that(parsedResults$myValues[[3]], equals("boolean"))
expect_that(parsedResults$myValues[[4]], equals(
tibble(
locale = "en",
name = "label",
value = "Primary diagnosis / Therapy / etc."
)
))
expect_that(parsedResults$myValues[[5]], equals(
tibble(
locale = "en",
name = "description",
value = "Chronic obstructive lung disease"
)
))
expect_that(parsedResults$myValues[[6]], equals(tibble(
locale = "en",
name = "source codes",
value = "ICD10GM: J44"
)))
})
#====================================================================
test_that("Parsed results are correctly set", {
myDictFun <- Factory.Dict()
myDict <- myDictFun()
myFilePath = file.path("../..", "inst", "config.yml")
myOmopParams <- config::get(file = myFilePath, "omop")
# create OMOP connection
omopConn <- OpenOmopConnection(dbmsIn = myOmopParams$dbms,
serverIn = myOmopParams$server,
userIn = myOmopParams$user,
portIn = myOmopParams$port,
passwordIn = myOmopParams$password,
schemaIn = myOmopParams$schema)
sourceCode = 'J44' # NOTE: not a default value
searchChildren = FALSE
sqlResults <- `_MapClass.Get`(sourceCode, omopConn, searchChildren)
parsedResults <- `_MapClass.Parse`(sqlResults)
setResults <- `_MapClass.Set`(parsedResults)
myDomain = setResults$myDomain
myKeys = setResults$myKeys
myValues = setResults$myValues
myDict <- Get(domainIn = myDomain, keyIn = myKeys[[1]])
expect_that(myDict$domain, equals(myDomain))
expect_that(myDict$key, equals(myKeys[[1]]))
expect_that(myDict$value[[1]]$value, equals(myValues[[1]]))
myDict <- Get(domainIn = myDomain, keyIn = myKeys[[2]])
expect_that(myDict$domain, equals(myDomain))
expect_that(myDict$key, equals(myKeys[[2]]))
expect_that(myDict$value[[1]]$value, equals(myValues[[2]]))
myDict <- Get(domainIn = myDomain, keyIn = myKeys[[3]])
expect_that(myDict$domain, equals(myDomain))
expect_that(myDict$key, equals(myKeys[[3]]))
expect_that(myDict$value[[1]]$value, equals(myValues[[3]]))
myDict <- Get(domainIn = myDomain, keyIn = myKeys[[4]])
expect_that(myDict$domain[[1]], equals(myDomain))
expect_that(myDict$key[[1]], equals(myKeys[[4]]))
expect_that(myDict$key[[2]], equals(myKeys[[4]]))
expect_that(myDict$key[[3]], equals(myKeys[[4]]))
expect_that(myDict$value[[1]], equals(myValues[[4]]))
expect_that(myDict$value[[2]], equals(myValues[[5]]))
expect_that(myDict$value[[3]], equals(myValues[[6]]))
})