createPs returns NaN

[ApproximateIdentity]

If I run the script below, the auc that is returned is NaN. It's not the same problem as in issue https://github.com/OHDSI/CohortMethod/issues/24 because in this case getdrugfromindication() is actually returning some ids.

library(SqlRender)
library(Cyclops)
library(CohortMethod)

# Login info.
connectionDetails <- createConnectionDetails(
    dbms = "redshift",
    user = Sys.getenv("USER"),
    password = Sys.getenv("MYPGPASSWORD"), 
    server = "omop-datasets.cqlmv7nlakap.us-east-1.redshift.amazonaws.com/truven",
    schema = "mslr_cdm4",
    port = "5439")

# The function that does the analysis.
test <- function() {
    drug_concept_id <- 1342001
    drug_concept_name <- "Enalaprilat"
    comparator_drug_concept_id <- 974166
    comparator_drug_concept_name <- "Hydrochlorothiazide"
    indication_concept_id <- 21001432
    indication_concept_name <- "Hypertension"

    lowBackPain = 194133

    # Get SNOMED-CT drug_concept_id from indication.
    drug_indication_concept_ids <- getdrugfromindication(
        connectionDetails,
        indication_concept_id)

    num_ids <- length(unique(drug_indication_concept_ids))
    print(num_ids)

    # Cohort Method.
    cohortdata <- getDbCohortData(
        connectionDetails,
        cdmSchema = connectionDetails$schema,
        resultsSchema = connectionDetails$schema,
        targetDrugConceptId = drug_concept_id,
        comparatorDrugConceptId = comparator_drug_concept_id,
        indicationConceptIds = drug_indication_concept_ids)

    num_persons <- length(unique(cohortdata$cohorts$personId))
    print(num_persons)
    num_covariates <- length(unique(cohortdata$covariates$covariateId))
    print(num_covariates)

    ps <- createPs(
        cohortdata,
        lowBackPain)

    auc <- computePsAuc(ps)
    print(auc)

    return(auc)
}

getdrugfromindication <- function(connectionDetails, indication_concept_id) {
    sql <- "
    SELECT DISTINCT
        c2.concept_id
    FROM (
        SELECT
            *
        FROM vocabulary.concept
        WHERE
            concept_id = @indication_concept_id
        ) t1 INNER JOIN vocabulary.concept_relationship cr1
            ON t1.concept_id = cr1.concept_id_1
        INNER JOIN vocabulary.concept c1
            ON cr1.concept_id_2 = c1.concept_id
            AND c1.vocabulary_id = 1
        INNER JOIN vocabulary.concept_ancestor ca1
            ON c1.concept_id = ca1.ancestor_concept_id
        INNER JOIN vocabulary.concept c2
            ON ca1.descendant_concept_id = c2.concept_id
            AND c2.vocabulary_id = 1
    ;
    "

    sql <- renderSql(
        sql = sql,
        indication_concept_id = indication_concept_id)$sql

    conn <- connect(connectionDetails)
    data <- dbGetQuery(conn, sql)
    dbDisconnect(conn)

    data$concept_id
}

auc <- test()

[schuemie]

The problem here is that there are no records in the drug_era table with drug_concept_id = 1342001, and therefore the treatment cohort is empty. I'll add some meaningful error messages to createPs(), but I really recommend using summary(cohortData) to diagnose any problems in fetching the data.

(Note: statements like length(unique(cohortdata$cohorts$personId)) require the ffbase package, which is no longer automatically loaded when you load CohortMethod).