#' Test rendering query
#'
#' Test rendering functionality
#'
#' @return
#' a query form string
#'
#' @export
renderTest<-function(){
SqlRender::loadRenderTranslateSql("temp.sql",
packageName="Clear",
dbms="sql server")
}
#' Test query database
#'
#' Test query for check connection with database
#'
#' @param connectionDetails
#' connectionDetails information
#' generated by DatabaseConnector::createConnectionDetails function
#'
#' @return
#' a data frame
#'
#' @export
queryTest<-function(connectionDetails){
conn<-DatabaseConnector::connect(connectionDetails)
data<-DatabaseConnector::querySql(conn, paste0("select top 10 * from ",connectionDetails$cdm_database,".CONCEPT;"))
dbDisconnect(conn)
data
}
#' Generate Data set for Clear
#'
#' By using drug and lab-test list, user can generate dataset for Clear
#'
#' @param connectionDetails
#' connectionDetails information
#' generated by DatabaseConnector::createConnectionDetails function
#'
#' @param drug_list
#' Drug information list
#' generated by createTargetDrugDataFrame function
#'
#' @param labtest_list
#' Laboratory test information list
#' generated by createLabtestDataFrame function
#'
#' @param date_from
#' Begin date of history
#' By default 2001-01-01
#'
#' @param date_to
#' End date of history
#' By default 2010-03-31
#'
#' @return
#' Nothing
#'
#' @export
generateClearDataSet<-function(connectionDetails, drug_list=NA, labtest_list=NA
, date_from='2001-01-01', date_to='2010-03-31'){
conn<-DatabaseConnector::connect(connectionDetails)
if(!is.na(drug_list)){
DatabaseConnector::insertTable(conn, "TARGET_DRUG", drug_list)
}
if(!is.na(labtest_list)){
DatabaseConnector::insertTable(conn, "LABTEST_LIST", labtest_list)
}
renderedSql<-SqlRender::loadRenderTranslateSql("CLEAR_0.2_CDMv4_Formatted.sql",
packageName="Clear",
dbms=connectionDetails$dbms,
target_database=connectionDetails$target_database,
cdm_database=connectionDetails$cdm_database,
date_from=date_from,
date_to=date_to)
DatabaseConnector::executeSql(conn, renderedSql)
dbDisconnect(conn)
}
#' Get result data set of Clear
#'
#' Summary data set of Clear algorithm
#'
#' @param connectionDetails
#' connectionDetails information
#' generated by DatabaseConnector::createConnectionDetails function
#'
#' @return
#' a data frame from summary table
#' generated by Clear algorithm
#'
#' @export
getClearResultDataSet<-function(connectionDetails){
conn<-DatabaseConnector::connect(connectionDetails)
renderedSql<-SqlRender::loadRenderTranslateSql("CLEAR_0.2_CDMv4_Summary_Formatted.sql",
packageName="Clear",
dbms=connectionDetails$dbms,
target_database=connectionDetails$target_database,
cdm_database=connectionDetails$cdm_database)
data<-DatabaseConnector::querySql(conn, renderedSql)
dbDisconnect(conn)
data
}
#' Run exact 1:4 matching
#'
#' @param connectionDetails
#' connectionDetails information
#' generated by DatabaseConnector::createConnectionDetails function
#'
#' @return
#' A data frame
#' outcome of 1:4 matching adjusted for age and sex
#'
#' @export
runMatching<-function(connectionDetails){
match<-getDataForMatching(connectionDetails)
match[is.na(match)]<-"NA"
matched.data<-plyr::ddply(match[!(match$DRUG_NAME%in%("NA")),], .(DRUG_NAME), function(x){
x<-rbind(x,match[match$DRUG_NAME%in%("NA"),])
plyr::ddply(x, .(LAB_NAME,RESULT_TYPE), function(x){
matched<-MatchIt::matchit(!(DRUG_NAME%in%c("NA")) ~ as.numeric(AGE) + as.factor(SEX)
, distance="logit", method="nearest", caliper=0.1, ratio=4
, data=x)
cbind(IDX_DRUG=x[!(x$DRUG_NAME%in%c("NA")),c("DRUG_NAME")][1]
, match.data(matched))
})
})
}
#' Get result data set of Clear for matching
#'
#' @param connectionDetails
#' connectionDetails information
#' generated by DatabaseConnector::createConnectionDetails function
#'
#' @return
#' A data frame
#' generated by summary data set for matching
#'
#' @export
getDataForMatching<-function(connectionDetails){
conn<-DatabaseConnector::connect(connectionDetails)
renderedSql<-SqlRender::loadRenderTranslateSql("CLEAR_0.2_CDMv4_Match_Formatted.sql",
packageName="Clear",
dbms=connectionDetails$dbms,
target_database=connectionDetails$target_database,
cdm_database=connectionDetails$cdm_database)
data<-DatabaseConnector::querySql(conn, renderedSql)
dbDisconnect(conn)
data
}
#' Run exact 1:4 matching with data
#'
#' @param match
#' A data frame
#' generated by getDataForMatching function
#'
#' @return
#' A data frame
#' outcome of 1:4 matching adjusted for age and sex
#'
#' @export
runMatchingWithData<-function(match){
match[is.na(match)]<-"NA"
matched.data<-plyr::ddply(match[!(match$DRUG_NAME%in%("NA")),], .(DRUG_NAME), function(x){
x<-rbind(x,match[match$DRUG_NAME%in%("NA"),])
plyr::ddply(x, .(LAB_NAME,RESULT_TYPE), function(x){
matched<-MatchIt::matchit(!(DRUG_NAME%in%c("NA")) ~ as.numeric(AGE) + as.factor(SEX)
, distance="logit", method="nearest", caliper=0.1, ratio=4
, data=x)
cbind(IDX_DRUG=x[!(x$DRUG_NAME%in%c("NA")),c("DRUG_NAME")][1]
, match.data(matched))
})
})
}
#' Run conditional logistic regression
#'
#' @param matched.data
#' A data frame
#' generated by runMatching/runMatchingWithData function
#'
#' @return
#' A data frame
#' outcome of conditional logistic regression
#'
#' @export
runCLogit<-function(matched.data){
plyr::ddply(matched.data, .(IDX_DRUG), function(x){
x$DRUG_NAME<-factor(x$DRUG_NAME)
x$DRUG_NAME<-relevel(x$DRUG_NAME, "NA")
plyr::ddply(x, .(LAB_NAME,RESULT_TYPE), function(x){
broom::tidy(clog<-survival::clogit(JUDGE%in%c("NORMAL")~DRUG_NAME+strata(distance), data=x))
})
})
}
#' Create data frame for a target drug information
#'
#' @param name
#' Name of drug
#'
#' @param class
#' Classification of drug
#'
#' @param code
#' Drug code in a specific classification
#'
#' @return
#' A data frame
#'
#' @export
createTargetDrugDataFrame<-function(name,class,code){
df<-data.frame(DRUG_NAME=c(name),DRUG_CLASS=c(class),DRUG_CODE=c(code))
}
#' Add a target drug information into existing TargetDrugDataFrame
#'
#' @param origin
#' Name of existing TargetDrugDataFrame variable
#'
#' @param name
#' Name of drug
#'
#' @param class
#' Classification of drug
#'
#' @param code
#' Drug code in a specific classification
#'
#' @return
#' A data frame
#'
#' @export
addTargetDrugDataFrame<-function(origin,name,class,code){
df<-data.frame(DRUG_NAME=c(name),DRUG_CLASS=c(class),DRUG_CODE=c(code))
rbind(origin,df)
}
#' Create data frame for a laboratory test information
#'
#' @param id
#' OMOP CONCEPT ID of laboratory test
#'
#' @param name
#' Name of Laboratory test
#' this name will be used for aggregation
#'
#' @param type
#' Laboratory test abnormality type
#'
#' @return
#' A data frame
#'
#' @export
createLabtestDataFrame<-function(id,name,type){
df<-data.frame(LAB_ID=c(id),LAB_NAME=c(name),ABNORM_TYPE=c(type))
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.