From fabf605543e5f89c00406749b1a744176dde23d9 Mon Sep 17 00:00:00 2001 From: Adam Black Date: Fri, 20 Aug 2021 12:52:08 -0400 Subject: [PATCH] Add OMOP header genearator function --- R/createDdl.R | 60 +++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 60 insertions(+) diff --git a/R/createDdl.R b/R/createDdl.R index d1a66dc..06bbca6 100644 --- a/R/createDdl.R +++ b/R/createDdl.R @@ -139,3 +139,63 @@ createForeignKeys <- function(cdmVersion){ } return(paste0(sql_result, collapse = "")) } + + + +# A helper function that will return a character string with the omop ascii art given a major and minor cdm version +# example: cat(createAsciiHeader(5, 3)) +createAsciiHeader <- function(major, minor) { + + stopifnot(is.numeric(major), is.numeric(minor), length(major) == 1, length(minor) == 1) + stopifnot(major %in% 0:99, minor %in% 0:99) + + # An inner function that returns an ascii art matrix for any number between 0 and 99 + numberMatrix <- function(num){ + stopifnot(is.numeric(num), num %in% 0:99) + + # An inner function that returns a 7x7 matrix of number ascii art for the number 0 through 9 + # for the number 1 a 7x5 matrix is returned because 1 is narrower than other numbers. + singleDigit <- function(num) { + nums <- c(' ### # ##### ##### # ####### ##### ####### ##### ##### # # ## # ## ## # # # ## # # ## ## # # # # ## # # # # # ## ## # # ##### ##### # # ###### ###### # ##### ####### # # # ######## ## # # # # # # # # # # # # # ## # # # ## # ### ##### ####### ##### # ##### ##### # ##### ##### ') + numsMatrix <- matrix(data = strsplit(nums, character(0))[[1]], nrow = 7, byrow = T) + cols <- seq(num*7+1, num*7+7, by = 1) + out <- numsMatrix[1:7, cols] + # the number 1 is narrower than the other numbers + if(num == 1) out<- out[1:7, 2:6] + out + } + + if(num < 10){ + return(singleDigit(num)) + } else { + space <- matrix(rep(" ", 7), nrow = 7) + return(cbind(singleDigit(floor(num/10)), space, singleDigit(num %% 10))) + } + } + + omop <- c('. + ####### # # ####### ###### ##### ###### # # . + # # ## ## # # # # # # # # ## ## # #. + # # # # # # # # # # # # # # # # # # #. + # # # # # # # ###### # # # # # # # #. + # # # # # # # # # # # # # #. + # # # # # # # # # # # # # # # . + ####### # # ####### # ##### ###### # # ## ') + + # convert to matrix and remove first column + omop <- matrix(strsplit(omop, character(0))[[1]], nrow = 7, byrow = TRUE) + omop <- omop[,c(-1, -2)] + + dot <- matrix(c(rep(" ", 3*4), rep("#", 3*3)), nrow = 7, byrow = TRUE) + space <- matrix(rep(" ", 7), nrow = 7) + newline <- matrix(rep("\n", 7, nrow = 7)) + + + header <- character(0) + headerMatrix <- cbind(omop, space, numberMatrix(major), space, dot, space, numberMatrix(minor), newline) + for(i in 1:7) { + header <- c(header, as.character(headerMatrix[i,])) + } + header <- paste(header, collapse = "") + return(header) +}