R/cert.R

In OHDSI/Cert:

#' 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))
}