#' Test rendering query
#'
#' Test rendering functionality
#'
#' @return
#' A query form string
#'
#' @export
renderTest<-function(){
SqlRender::loadRenderTranslateSql("temp.sql",
packageName="Cert",
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 Cert
#'
#' By using drug and lab-test list, user can generate dataset for Cert
#'
#' @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
generateCertDataSet<-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("CERT_0.6_CDMv4_Formatted.sql",
packageName="Cert",
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 Cert
#'
#' Summary data set of Cert algorithm
#'
#' @param connectionDetails
#' connectionDetails information
#' generated by DatabaseConnector::createConnectionDetails function
#'
#' @return
#' A data frame from summary table
#' generated by Cert algorithm
#'
#' @export
getCertResultDataSet<-function(connectionDetails){
conn<-DatabaseConnector::connect(connectionDetails)
renderedSql<-SqlRender::loadRenderTranslateSql("CERT_0.5_CDMv4_09.Summary_Formatted.sql",
packageName="Cert",
dbms=connectionDetails$dbms,
target_database=connectionDetails$target_database,
cdm_database=connectionDetails$cdm_database)
data<-DatabaseConnector::querySql(conn, renderedSql)
dbDisconnect(conn)
data
}
#' Get demographics data set of Cert
#'
#' Demographics data set of Cert algorithm
#'
#' @param connectionDetails
#' connectionDetails information
#' generated by DatabaseConnector::createConnectionDetails function
#'
#' @return
#' A data frame from demographics table
#' generated by Cert algorithm
#'
#' @export
getCertDemographics<-function(connectionDetails){
conn<-DatabaseConnector::connect(connectionDetails)
renderedSql<-SqlRender::loadRenderTranslateSql("CERT_0.5_CDMv4_10.Demographics_Formatted.sql",
packageName="Cert",
dbms=connectionDetails$dbms,
target_database=connectionDetails$target_database,
cdm_database=connectionDetails$cdm_database)
data<-DatabaseConnector::querySql(conn, renderedSql)
dbDisconnect(conn)
data
}
#' Get result data set of Cert for paired t-test
#'
#' It is necessary for run a paired t-test
#'
#' @param connectionDetails
#' connectionDetails information
#' generated by DatabaseConnector::createConnectionDetails function
#'
#' @return
#' A data frame from summary table
#' generated by subsetting summary data set
#'
#' @export
getDataForPairedTTest<-function(connectionDetails){
conn<-DatabaseConnector::connect(connectionDetails)
renderedSql<-SqlRender::loadRenderTranslateSql("CERT_0.5_CDMv4_07.Paired t-test_Formatted.sql",
packageName="Cert",
dbms=connectionDetails$dbms,
target_database=connectionDetails$target_database,
cdm_database=connectionDetails$cdm_database)
data<-DatabaseConnector::querySql(conn, renderedSql)
dbDisconnect(conn)
data
}
#' Get result data set of Cert for McNemar's test
#'
#' It is necessary for run a McNemar's test
#'
#' @param connectionDetails
#' connectionDetails information
#' generated by DatabaseConnector::createConnectionDetails function
#'
#' @return
#' A data frame from summary table
#' generated by subsetting summary data set
#'
#' @export
getDataForMcNemarTest<-function(connectionDetails){
conn<-DatabaseConnector::connect(connectionDetails)
renderedSql<-SqlRender::loadRenderTranslateSql("CERT_0.5_CDMv4_08.McNemar's test_Formatted.sql",
packageName="Cert",
dbms=connectionDetails$dbms,
target_database=connectionDetails$target_database,
cdm_database=connectionDetails$cdm_database)
data<-DatabaseConnector::querySql(conn, renderedSql)
dbDisconnect(conn)
data
}
#' Run paired t-test
#'
#' Extract data set and run paired t-test
#'
#' @param connectionDetails
#' connectionDetails information
#' generated by DatabaseConnector::createConnectionDetails function
#'
#' @return
#' A data frame
#' outcome of paired t-test
#'
#' @export
runPairedTTest<-function(connectionDetails){
paired<-getDataForPairedTTest(connectionDetails)
plyr::ddply(paired, .(DRUG_NAME,LAB_NAME,RESULT_TYPE), function(x){
broom::tidy(t.test(x$RESULT_BEFORE,x$RESULT_AFTER, paired=T))
})
}
#' Run McNemar's Test
#'
#' Extract data set and run McNemar's test
#'
#' @param connectionDetails
#' connectionDetails information
#' generated by DatabaseConnector::createConnectionDetails function
#'
#' @return
#' a data frame
#' outcome of McNemar's test
#'
#' @export
runMcNemarTest<-function(connectionDetails){
mcnemar<-getDataForMcNemarTest(connectionDetails)
plyr::ddply(mcnemar, .(DRUG_NAME,LAB_NAME,RESULT_TYPE), function(x){
broom::tidy(mcnemar.test(x$JUDGE_BEFORE,x$JUDGE_AFTER))
})
}
#' 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.