R/clear.R

In OHDSI/Clear:

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