Using Logistic Regression to Inform Decision Trees in Classifying Valvular Heart Disease
By: Miguel Sotelo
Tags: Aortic Stenosis, Logistic Regression, Healthcare, Mpirik Research, Data Science

Methods and Results

Our work is completed in R (4.0.3). The summary of our workflow is:

Generate phrases typically found in echo reports that indicate severe AS, and create a set of 10,000 synthetic echos where roughly 14% of the population have indications of severe AS with an AVA ranging between 0.55 and 1.2 cm2. “Identify” which echos contain severe AS using natural language processing (NLP) through regular expressions (REGEX). Estimate the logistic regression between AVA and severe AS, plot the logistic curve, receiver operating characteristic (ROC) curve, and obtain a threshold for AVA to classify severe AS.

First, we load the required packages, and create some custom functions to create our synthetic dataset

# load required libraries

library(stringi) # creating random strings

library(stats) # modeling and stats

library(graphics) # plotting

library(caret) # model performance # create the echo report based on the cdf and number of

# patients. This samples from the cdf and obtains an aortic

# stenosis phrase input, and adds random phrases before and

# after to create a fake "echo report"

create_echo_report <- function(cdf, n_patients) {

echo_report <- rep(NA, n_patients)

random_phrase <- stringi::stri_rand_lipsum(n_patients, start_lipsum = TRUE)

for (i in 1:n_patients) {

phrase_input <- cdf[sample(100, 1)]

echo_report[i] <- paste(

random_phrase[i],

phrase_input,

random_phrase[i]

)

}

return(echo_report)

} # Create a vector of ava based on what we find in the echo

# report. This ensures that low AVA is found in severe AS

# echo reports

# as_locations: indices where severe AS is found

create_ava <- function(as_locations, n_patients) {

ava <- rep(NA, n_patients)

for (i in 1:n_patients) {

if (as_locations[i] == TRUE) {

ava[i] <- runif(1, min = 0.55, max = 1.2)

} else {

ava[i] <- runif(1, min = 0.95, max = 3)

}

}

return(ava)

}

Next, we will define some parameters.

# generate n_patients echocardiogram reports, some

# containing aortic stenosis NLP # first, set the seed, number of patients, and the phrases

# in the echo report that define aortic stenosis

set.seed(100)

n_patients <- 10000 # randomly select from distribution of phrases based on

# weight to give realistic prevalence of AS in roughly 14% of

# the patients

percent_as <- 14

aortic_stenosis_phrases <- data.frame(

phrase = c(

"severe aortic stenosis",

"sev AS",

"severe aortic valve stenosis",

"mod-sev aortic stenosis",

"no aortic stenosis",

stri_rand_strings(1, 10)

),

probability = c(

percent_as / 4,

percent_as / 4,

percent_as / 4,

percent_as / 4,

(100 - percent_as) / 2,

(100 - percent_as) / 2

)

)

aortic_stenosis_phrases$phrase <- as.character(aortic_stenosis_phrases$phrase)

Next, we will create a set of 10,000 echo reports using our parameters and custom functions

# fill in cdf of aortic stenosis phrases so that we can

# randomly sample from them

as_cdf <- sample(

x = aortic_stenosis_phrases$phrase,

size = n_patients,

replace = TRUE,

prob = aortic_stenosis_phrases$probability /

sum(aortic_stenosis_phrases$probability)

)

echo_report <- create_echo_report(as_cdf, n_patients) # use REGEX and NLP to identify patients from the 10,000

# that have severe AS NLP

as_locations <- grepl("sev(ere)? (aortic (valve )?stenosis|as)", echo_report)

message(paste0(

"aortic stenosis is in ",

100.0 * length(as_locations[as_locations == TRUE]) / length(as_locations),

"% of the patients"

)) # create synthetic ava data to correlate with AS NLP

aortic_valve_area <- create_ava(as_locations, n_patients) # create synthetic echo data.frame of echo reports and AVA

patient_data_frame <- data.frame(

echo_report = echo_report,

aortic_valve_area = aortic_valve_area,

as_locations = as_locations

)

Typically, we would do preprocessing on the data to ensure data formats are what we would expect. Since we generated this data set, preprocessing is not required.

Now it is time to estimate the logistic regression using maximum likelihood estimation (glm)

# binomial logistic regression

model_glm <- stats::glm(as_locations ~ aortic_valve_area,

data = patient_data_frame,

family = binomial(link = "logit")

)

We will leave the details of what the glm does and how to interpret its outputs to other resources. We wrote on its interpretation in clinical settings; additionally, this post does a great job of walking through a classification example using logistic regression.

The model tells us that AVA is a strong predictor of severe AS (OR = -12). This is a very high odds ratio due to how we constructed the data, but of note is the negative sign, indicating that a lowering AVA increases the odds of having severe AS.

Since our goal is to obtain a cut-off threshold that can be implemented in the clinic for AS classification, we will calculate the decision boundary based on a cut-off threshold (50%).

# decision boundary based on ratio of the coefficients

recommended_threshold <- -coef(model_glm)[1] / coef(model_glm)[2] # plot the logistic using graphics

graphics::plot(as_locations ~ aortic_valve_area,

data = patient_data_frame,

col = "#1D8BF9", pch = "x", ylim = c(-0.2, 1.2),

main = paste(

"Using Logistic Regression for Classification, threshold found at",

signif(recommended_threshold, 2)

),

ylab = "probability of aortic stenosis",

xlab = "aortic valve area"

)

graphics::abline(h = 0, lty = 3)

graphics::abline(h = 1, lty = 3)

graphics::abline(h = 0.5, lty = 2)

graphics::curve(stats::predict(model_glm,

data.frame(aortic_valve_area = x),

type = "response"

),

add = TRUE, lwd = 3, col = "#F94F1D"

)

graphics::abline(v = recommended_threshold, lwd = 2)

Logistic Regression shows an adequate decision boundary roughly at 1 cm² (x axis, aortic valve area) for 50% classification

We can see that the cut-off threshold based on the decision boundary is 1.01 cm2 ! Of course, our data set was created with the intention of yielding that result.

We can finally calculate our model’s performance by using the `caret` library and writing a wrapper function

# wrapper function to calculate model performance

# threshold is given in probability

model_performance <- function(model_glm, threshold, observed) {

# confusion matrix

model_glm_pred <- ifelse(predict(model_glm,

type = "response"

) > threshold,

"Yes",

"No"

)

train_table <- table(

predicted = model_glm_pred,

observed = observed

) train_con_mat <- confusionMatrix(train_table,

positive = "Yes"

)

performance <- c(

train_con_mat$overall["Accuracy"],

train_con_mat$byClass["Sensitivity"],

train_con_mat$byClass["Specificity"]

) return(list(

train_con_mat = train_con_mat,

performance = performance

))

} # model performance

observed <- ifelse(as_locations, "Yes", "No")

model_performance(model_glm, 0.5, observed)

The resulting accuracy, sensitivity, and specificity are 0.94, 0.72, and 0.97, respectively.

The following is used to show how we might obtain a cut-off threshold for AVA by optimizing the sensitivity and specificity:

library(pROC)

predicted <- stats::predict(model_glm, data.frame(aortic_valve_area = aortic_valve_area), type = "response") roc_obj <- pROC::roc(observed, predicted)

roc_obj$auc

coords <- pROC::coords(roc_obj, "best", "threshold", transpose = TRUE)

# the first value is the cut-off probability threshold

coords

plot(roc_obj) # sort the ava and predicted probability of AS so that we can obtain the AVA threshold ava_sorted <- aortic_valve_area[order(aortic_valve_area, decreasing = FALSE)]

predicted_sorted <- predicted[order(aortic_valve_area, decreasing = FALSE)]

recommended_threshold2 <- ava_sorted[which(predicted_sorted < coords[1])[1]]

Using the probability threshold of 0.096 (AVA threshold of 1.2), we were able to optimize the resulting accuracy, sensitivity, and specificity to 0.89, 1.0, and 0.88, respectively.

model_performance(model_glm, coords[1], observed)

As we can see, lowering the probability threshold (and increasing the AVA cut off threshold) improves model performance. In this case, since there was such a high distinction in AVA between no AS and severe AS, the effect of changing the probability threshold had limited impact on overall model performance.

In a real world situation, especially when studying lesser known diseases, it would be up to the research team and clinicians to finalize the appropriate threshold for AVA. However, logistic regression did a fantastic job at determining a narrow range for the clinicians and researchers to consider.