A tutorial to explanatory modeling and statistical causal inference | Towards Data Science

Perhaps a positive side-effect of the recent pandemic and the associated lockdown is that we get to materialize projects that had been set aside. For a while I’ve wanted to write an article about statistical model interpretation and all I needed was time, motivation, and data. This Kaggle dataset consists of 1085 COVID-19 cases sampled in the city of Wuhan between December 2019 and March 2020, and it was one of the first published datasets to contain records at patient-level. This TDS article provides a nice overview of the data and its fields. Having records at patient-level means that there is enough granularity to derive medical insights about how a person’s individual attributes relate to the risk of dying from exposure to COVID-19.
This guide to explanatory modeling requires an intermediate understanding of the following topics:
Probability theory and distributions
Statistical estimation and inference
Machine learning concepts such as logistic regression and bagging
Computational statistics concepts such as bootstrap resampling
The R programming language
A mortality risk analysis requires a response variable with records on the event of death. We will consequently try to express this response as a function of predictor variables, which are directly or indirectly related to the effect of COVID-19 on man’s health. The purpose of an explanatory model is to explain rather than predict the outcome of death, where the objective of explanation is the application of statistical inference in order to:
identify predictor variables with statistically significant impact to the event of death
estimate the magnitude of impact of the significant predictors
quantify the uncertainty of our estimates
In other words, we’re interested in a model that will be used for inference rather than prediction or — to state it more accurately — one that favors causal inference over predictive inference. It’s crucial to understand the distinction between the two as it determines our rationale behind our choice of modeling approach. Explanatory analysis requires a less flexible (high bias) but more interpretable model, which uses probabilistic reasoning to approximate a hypothesized data generation process. After a model selection procedure is performed, the resulting “best” model may include predictors that have a significant effect on the response albeit without necessarily improving predictive accuracy.
Seemingly, a good choice of model would be the binomial logit model, commonly known as binary logistic regression. Given the lack of tools for inference after model selection as well as our intention to validate causal hypotheses, we will use domain knowledge to handpick the independent variables which are assumed to have a direct or indirect effect on the event of death; then we will quantify their effect by fitting our data into the data generation process that our model assumes. The purpose of this article is to implement a pipeline for explanatory modeling, which shows how to use a small and sparse dataset to derive medical insights on COVID-19. For this purpose, I’ve selectively combined theoretical concepts with code snippets in the R programming language. In order to reach the desirable result, the following steps are taken:
Definition of a generalized linear model
Data imputation versus data removal
Model selection with asymptotic criteria
Model validation with bootstrap inference
Model interpretation
The codebase used in this work can be found here.
Let’s start off by loading the necessary libraries and data.
# Load required libraries:library(mice)library(VIM)library(jtools)library(ggplot2)library(gridExtra)options(repr.plot.width = 14, repr.plot.height = 8)# Load COVID-19 data:dat0 = read.csv('./data/COVID19_line_list_data.csv',                 header = T, sep = ',')print(names(dat0))
In a predictive modeling scenario we could, at this point, pick any amount of variables we want and then let a model selection algorithm decide for us which ones to consider. In an explanatory modeling scenario, however, inference after algorithmic model selection is not a viable option. An intense variable selection process is expected to bias coefficient p-values and deprive us from using the model’s asymptotic properties. There are various ways to overcome this phenomenon but, in order to explain causal effects, we must rely on domain knowledge to isolate the variables that we consider impactful. For example, an obvious selection of variables would be those related to a patient’s age, gender, country of origin, date on which symptoms started, date on which hospitalization took place, and whether he/she is native to Wuhan. Variables such as ‘symptom’, ‘recovered’, ‘hosp_visit_date’ and ‘exposure_start’ seem relevant but are simply too sparse to be of any use.
dat1 = dat0[c("location", "country", "gender", "age", "reporting.date", "symptom_onset", "hosp_visit_date", "visiting.Wuhan", "from.Wuhan", "death", "recovered", "symptom")]print(head(dat1, 5))
After isolating the most relevant predictors, our new dataset should look like this:
# Binarize response:dat1$y = 0dat1$y[dat1$death==1] = 1   dat1$y = as.factor(dat1$y)
We have a binary response variable that represents the event of death and we’re ready to dig deeper into the modeling process.
Without intending to go into too much detail, I think it’s important to go through some basic steps in order to understand how model interpretability is obtained.
Recall that in a binomial logit model, the response variable is a random vector that follows a Binomial or Bernoulli distribution:
where P(Y=1)=p, for all observations i=1,...,N.
This is an important difference from linear regression where the stochastic element comes from the covariates and not the response. Our model makes several other assumptions and the first step in the analysis should be to make sure that our scenario meets them.
The first assumption on the distribution of the response has been already laid down, but it can be expanded with the assumption that its expected value E[Y=1]=np, for all i, can be linked to the linear combination of the covariates:
which is equivalent to:
for observations i=1,...,N, explanatory variables j=1,...,M, and link function g. Secondly, explanatory variables X are assumed to be independent of each other and uncorrelated. Thirdly, observations too are assumed to be independent of each other and uncorrelated. Some further assumptions have to do with the limitations of Maximum Likelihood Estimation on the size of data. It is well known that MLE tends to overfit when the number of parameters increases beyond a certain limit but, luckily, our data is nowhere near that danger zone.
A more generic assumption is that our data is the result of random sampling. This is particularly important in the case of prediction, as the distribution of the response variable (sample class balance) has a direct effect on the estimate of the intercept term and, therefore, on model predictions. On the bright side, slope coefficients remain unaffected. In other words, non-representative class balance in logistic regression has a direct effect on prediction but not interpretation. Since our goal is the latter, we can proceed without making the balanced sample assumption.
We can now define our model as a Binomial GLM. Recall that any GLM is defined by three components:
a stochastic component
a systematic component
a link function
Suppose that random variable Y maps the binary outcome of a COVID-19 case as a Bernoulli trial, such that:
where p is the probability of observing the outcome of death P(Y=1) in a single patient, N is the number of patients with observed values for Y, and n is the number of trials per patient (in our case, n=1, for all n). This is our stochastic component.
Let η be the expectation of Y, E[Y]=η, and suppose that there exists a function g(.) such that g(η) be a linear combination of the covariates:
For X=x, for all j, the RHS of the above equation is our systematic component.
We choose g(.)=logit(.) as the link function whose inverse, logistic(.), can squeeze the output of our model inside the [0,1] interval, which also happens to be the desired range for E[Y]=η=p, for n=1. Therefore, by plugging η=np=p into our link function g(.), we get:
from which we derive the final structure of our model:
Leaving out index i for simplicity’s sake, we have:
The stochastic component can now be rewritten as:
NB: This last expression explains why logistic regression is literally a regression and not classification.
This step involves inspecting variance and sparsity in our dataset, as well as generating new predictors. After having defined our GLM and checked its assumptions, we can move on to inspect class balance in our data:
table(dat1$y)
The dataset agrees with our prior knowledge on the mortality rate of COVID-19, which places our analysis into the realm of rare event detection. Using domain knowledge on COVID-19 we can instantly consider ‘age’ and ‘gender’ as relevant predictors but we can also try to create new predictors. Something that could be informative is the time between the day the first symptoms appeared and the day the individual got hospitalized. We can easily create this predictor by taking the distance in days between hospitalization date and symptom onset date.
# Cast 'Date' types:dat1$hosp_visit_date = as.character(dat1$hosp_visit_date)dat1$symptom_onset = as.character(dat1$symptom_onset)dat1$hosp_visit_date = as.Date(dat1$hosp_visit_date, format="%m/%d/%y")dat1$symptom_onset = as.Date(dat1$symptom_onset, format="%m/%d/%y")dat1$from.Wuhan = as.factor(dat1$from.Wuhan)# Create 'days before hospitalization' variable:dat1$days_before_hosp = as.numeric(as.Date(dat1$hosp_visit_date, format="%m/%d/%y") - as.Date(dat1$symptom_onset, format="%m/%d/%y"))dat1$days_before_hosp[dat1$days_before_hosp < 0] = NA
So the variable that counts the days between symptom onset and hospitalization can be added to our model later on in the model selection process. The current state of the data seems to include quite a few missing values (appearing as ‘NA’) so it would be insightful to visualize the sparsity landscape.
# Plot missing values:aggr(dat1, col = c('green','red'), numbers = TRUE, sortVars = TRUE,      labels = names(dat1), cex.axis = .5, gap = 2,      ylab = c("Proportion in variable","Proportion in dataset"))
The above table shows the proportion of missing values in every variable. The same insight is visualized on the barplot below (left image).
The grid on the right illustrates the proportion of missing values of individual predictions over all values in the dataset. For example, the last row of the matrix, which is full green, tells us that 39% of our datasets cases have no missing values throughout all variables. The row before that tells us that 20% of cases are missing in the first three variables (order of appearance), the row before that shows 15% missing values in the first 5 variables, and so on.
Clearly, there’s a lot of missing data and it’s scattered all over, so the choice between removal and imputation is not that obvious. Before trying to answer this question, we should try fitting a baseline model using few but substantial predictors. We want to have a model fitted on a dataset that is close to the raw dataset, but instead of imputation we will perform missing value removal. Variables with sparsity or low variance (such as ‘country’, ‘hosp_visit_date’, ‘symptom_onset’) should be left out and, to minimize data removal, variables included into the baseline model should have as little missing values as possible.
The model selection process will involve fitting several candidate models until we run into the one that’s closest to the “true” model. At every comparison, candidate models will be evaluated with respect to specific asymptotic criteria (to be explained).
We’ll start off with a very simple model that regresses mortality rate against variables ‘age’ and ‘gender’.
Expressing mortality risk as a function of age and gender allows us to rewrite our GLM from equation [1] as:
# Loading custom functions used in the analysis:source('../input/glmlib/myglm-lib.r') #modify path as required
We fit the model using R’s standard ‘glm’ function and inspect goodness-of-fit with the help of the ‘jtools’ package and some custom functions. We use the ‘summ’ function from package ‘jtools’ to get a nicely presented summary of model diagnostics. It should be noted that R’s built-in ‘glm’ function removes by default all rows with ‘NA’ values, so we’re being informed in the summary that only 825 out of our total 1082 observations were used in training. We also see reports on goodness-of-fit statistics and criteria such as AIC, BIC, Deviance, which can be used for model selection under certain conditions.
#---------------------------------------------# Model 0: gender + age#---------------------------------------------# Train model:gfit0 = glm(y~gender+age, data = dat1, binomial)# Summarize and inspect:summ(gfit0, confint = TRUE, pvals = TRUE, digits = 3)
Let’s provide some context for this output.
Recall that the deviance is a generalization of the sum of squared residuals in ordinary least squares regression, so it expresses the distance of the current model from the saturated model as a function of the difference of their respective log-likelihoods l(.). Therefore, the (scaled) deviance of the current model is obtained by:
which follows the asymptotic distribution:
Naturally, the deviance is always positive and inversely proportional to goodness-of-fit, with D = 0 indicating the perfect fit. The null deviance D0 is the deviance of intercept-only (null) model — the worst possible model:
— obtained by setting:
into the above formula. Ds is the deviance of the saturated model — the best possible model — a model that has n parameters for n sample size, whose likelihood is equal to 1 and deviance is equal to 0.
The deviance can be used to assess whether any two models are equal. This can be done by testing the null hypothesis that all the extra coefficients of the larger model are equal to zero. For any given pair of nested models m1 and m2, the comparison can be done by the statistic:
In other words, for two nested models to be equal, the difference of their corresponding deviances should follow a χ2 distribution with k degrees of freedom being equal to the difference of their corresponding degrees of freedom. Consequently, this means that we can also test whether an arbitrary model is statistically equal to either the null model (for a very bad fit) or the saturated model (for a very good fit). The code for these comparisons is provided below:
# Comparing current model to the null model (LTR):pval_m0 = 1 - pchisq(gfit0$null.deviance - gfit0$deviance, gfit0$df.null - gfit0$df.residual)round(pval_m0, 3)
The above comparison tests the null hypothesis:
i.e. whether the current model is equal to the intercept-only model. Naturally, we want this null to be rejected in order for the current model not be deemed useless, so we expect a p-value below the accepted decision threshold (conventionally 0.05).
# Comparing current model to the saturated model (Deviance test):pval_ms = 1 - pchisq(gfit0$deviance, df = gfit0$df.residual)round(pval_ms, 3)
Here, we test the null:
i.e. whether the current model is statistically equal to the saturated model. Failing to reject the null is the desired outcome, albeit it can’t serve as evidence for the null’s acceptance.
We can assess the statistical significance of model coefficients by looking at their p-values. There is a lot of discussion these days about the reliability of p-values so I believe some explanation is due about how those p-values are obtained what they really mean. Recall that inference in GLM is asymptotic and the true distributions of fitted coefficients are unknown. The asymptotic properties of MLE give us a Gaussian distribution for model coefficients:
where where I(β) denotes the Fisher information matrix. Solving for Normal(0,1) in the RHS, we derive the Wald statistic for j=0,...,M:
which we use to compute confidence intervals and apply hypothesis tests (as we do with the t-statistic in linear regression). We can, therefore, compute the 100(1−α)% confidence intervals for the coefficients using:
Naturally, we can also use the asymptotic distribution of the coefficients to conduct formal hypothesis tests regarding their significance by testing the null hypothesis:
which uses the Wald statistic and is commonly known as the Wald test.
McFadden’s pseudo-R2 is a measure of explained variation defined as:
where we have the log-likelihood of the current model over 1 minus the log-likelihood of the intercept-only model. This equation is an adaptation of the R2 formula in linear regression 1−SSE/SST, however, the interpretation of the pseudo-R2 is the model’s proximity to the best fit, not the percentage of variance explained by the model. A rule of the thumb here is that a value between 0.2–0.4 generally indicates a “good” fit (ranging from good to very good).
Having gone through some aspects of goodness-of-fit, we realize that our baseline model is objectively not that bad. We’ve got significant p-values for the overall fit as well as one of our coefficients (using the Fisherian 95% confidence level), and we’ve got a decent pseudo-R2 of 0.20. Furthermore, we can use function ‘plot_summs’ from package ‘jtools’ to plot the asymptotic distributions of model coefficients and visualize the results of the Wald test by noticing how the tail of β2 (coefficient of Gender) includes the value of zero and does not reject the null :
# Asymptotic distribution of model coefficients (model 0)plot_summs(gfit0, scale = TRUE, plot.distributions = TRUE)
The above density plots can help us understand how asymptotic inference works. Asymptotic confidence intervals and p-values are computed by estimating integrals on this theoretical density plot and — under the right conditions — the output of asymptotic inference should match that of any objective non-asymptotic method such as (frequentist) Monte Carlo, bootstrap, or flat-prior Bayesian estimation.
It would be interesting to use the model’s predictive ability to visualize the effect of age on mortality risk, for both men and women. A reconstitution of the functional relation between mortality risk and age can be seen below:
# Mortality risk as a function of Age: x1 = data.frame(gender="male", age=1:90)plot(predict(gfit0, x1, type = "response"),     type = 'l', xlab = "Age", ylab = "Mortality risk")x2 = data.frame(gender="female", age=1:90)lines(predict(gfit0, x2, type = "response"), col="red")
This model is fine for a baseline, so we can start building up from here. The obvious next steps are to add more predictors into the model and see whether the fit improves. As previously seen, the bottleneck with this dataset is that we have too many missing values scattered throughout our predictors. If we continue adding variables and removing rows with missing values, our dataset is bound to be dangerously diminished. For example, variables ‘age’ and ‘gender’, that we used in our baseline, have already cost us 260 observations. Variable ‘days_before_hosp’ is intuitively an interesting predictor but if we add it into the baseline model and apply row-wise removal, the overall number of observations in our dataset will be reduced to half its original size. The same goes for variable ‘from.Wuhan’, which denotes whether the sampled individual was a native to Wuhan (more on the meaning of that predictor later). So if we were to exclude all rows in the dataset that have at least one missing value, we’re going to end up with a much smaller albeit complete dataset. On the other hand, if trust an imputation algorithm to “guess” all of our missing values, we’ll end up with a large portion of our data being the result of simulated observations. Given the current state of affairs, if we’re going to enrich the baseline model with more explanatory variables we’re facing two options:
Data removal: If we assume that our data is “missing at random” (MAR) or “missing completely at random” (MCAR), then removal of cases should be considered. However, if this assumption is wrong then we’re at risk of introducing bias into the resulting reduced dataset.
Data imputation: With the assumption that the data is “missing not at random” (MNAR), there is a wide range of imputation methods to choose from.
Neither of these approaches is necessarily wrong and there is no way for us to know a priori which one fits best our scenario, unless we have a clear understanding of why the data is missing. As we do not have this prior understanding in our case, it would be wise to use both approaches and generate both a reduced and an imputed dataset; then compare a model that was fitted on the former with one that was fitted on the latter. The comparison will not be straight-forward since the use of different datasets (in terms of row inputs) will result to models which will not be comparable by means of likelihood-based criteria such as AIC/BIC, Deviance, and McFadden’s pseudo-R2. The choice of the better approach will depend on the validation of the “missing at random” hypothesis. If the results of data removal are similar to those of data imputation we can safely assume that the missing data was in fact “missing at random”, in which case we will favor the imputed data over the reduced one.
As previously stated, two interesting variables that could be added the baseline mode are:
‘days_before_hosp’: the number of days taken between the appearance of the first COVID-19 symptoms and the patient’s subsequent hospitalization (created earlier)
‘from.Wuhan’: the factor indicating whether the patient was from Wuhan. Again, it is somewhat counter-intuitive for this latter variable to have a significant effect to mortality rate, but there will be a rational explanation along the way.
It should be noted that we intentionally refrain from automating this selection process, in an effort of keeping model comparisons down to a minimum. The purpose of this practice is to avoid dwelling into the realms of stepwise selection, a widespread technique which is nowadays wisely regarded as a statistical sin.
Our next candidate models will be of the following nested form:
At this point, we must create the imputed dataset. There are plenty of imputation methods to choose from depending on the nature, amount, and distribution of missing values in our data. Under a mild “missing at random” assumption, we decide that the best method for our scenario would be multiple imputation by chained equation, commonly known as the MICE algorithm. Using the ‘mice’ library, we can simulate values for all our missing data as shown below:
# Create imputed dataset using 'mice':dat1_obj <- mice(dat1[c("gender", "age", "days_before_hosp", "from.Wuhan", "country")], m=5, maxit = 50, method = 'pmm', seed = 400)dat1_imp = complete(dat1_obj)dat1_imp$y = dat1$y
Now we have our imputed dataset in ‘dat1_imp’. Next we’re going to refit the baseline model plus the two new candidate models on the newly imputed dataset and summarize their diagnostics. We’re refitting our baseline model because the multiple imputation has also filled in the missing data on Gender and Age that were previously automatically removed by the ‘glm’ function. We’re not expecting this to cause a dramatic change on the diagnostics of baseline model yet it’s essential to refit it to the exact same dataset as the new candidate models in order to make all models comparable to each other.
# Train models on imputed data:gfit1a = glm(y~gender+age, data = dat1_imp, binomial)gfit1b = glm(y~gender+age+days_before_hosp, data = dat1_imp, binomial)gfit1c = glm(y~gender+age+days_before_hosp+from.Wuhan, data = dat1_imp, binomial)# Compare fits:export_summs(gfit1a, gfit1b, gfit1c, scale = F, error_format = "[{conf.low}, {conf.high}]", digits = 3, model.names = c("model 1a", "model 1b", "model 1c"))plot_summs(gfit1a, gfit1b, gfit1c, scale = TRUE, plot.distributions = F, inner_ci_level = .95, model.names = c("model 1a", "model 1b", "model 1c"))
So now we have three nested models fitted on the same input cases that we can directly compare using likelihood-based criteria. As expected, there is a clear improvement in all aspects as we see both AIC and BIC values drop significantly, while pseudo-R2 has almost doubled in the third model. It’s safe to conclude that the model with both new variables is the one we should be focusing on.
The 95% confidence interval plot can be thought of as a “panoramic” view of the asymptotic distributions of coefficients which allows us to assess the consistency of estimation. Whether two confidence intervals overlap gives us an idea of whether the estimates of the same coefficients differ significantly between two models. This helps us detect the presence of multicollinearity, that may have been caused by the addition of new variables into the model.
One might wonder, at this point, what is the best way to compare models using likelihood-based measures. As a rule of the thumb, the Akaike information criterion (AIC) has been characterized as the asymptotic equivalent of leave-one-out cross validation, therefore it’s the better metric for the purpose of prediction. The Bayesian information criterion (BIC), on the other hand, has been previously cited to be the better criterion for finding the true model among a set of candidate models, which is what we need for the purpose of explanation. Note that the “true model” is the model with the correct functional form and the correct set of regressors regarding what best explain the response, but it is not necessarily the best model for making predictions (some variables required to interpret the response might compromise the precision of estimates without adding predictive value). With that in mind, we are going to be looking at BIC as the criterion for model selection.
We move onto fitting the same candidate models to a dataset that has undergone data removal.
The reduced dataset will be created by listwise deletion, i.e. the removal of an input case (observation) with one or more missing values. We create the following using the following code:
# Create reduced dataset for model 2:# (filter out rows with NA values)not_na_mask = !is.na(dat1$y) & !is.na(dat1$days_before_hosp) & !is.na(dat1$age) & !is.na(dat1$gender) & dat1$days_before_hosp >= 0dat2 = dat1[not_na_mask, ]table(dat2$y)
We can see the total number of observations being reduced by 40%. Now let’s see what the diagnostics of the fitted models will look like.
#------------------------------------------------------------------# Model 2: gender + age + time to hospitalization (on reduced # dataset)#------------------------------------------------------------------# Train model:gfit2a = glm(y~gender+age, data = dat2, binomial)gfit2b = glm(y~gender+age+days_before_hosp, data = dat2, binomial)gfit2c = glm(y~gender+age+days_before_hosp+from.Wuhan, data = dat2, binomial)# Merge model summaries:export_summs(gfit2a, gfit2b, gfit2c, scale = F, error_format = "[{conf.low}, {conf.high}]", digits = 3,  model.names = c("model 2a", "model 2b", "model 2c"))# Compare asymptotic distributions of coefficients:plot_summs(gfit2a, gfit2b, gfit2c, scale = TRUE, plot.distributions = F, inner_ci_level = .95, model.names = c("model 2a", "model 2b", "model 2c"))
Given how we reduced our dataset to about half its original size, the fit of this model is surprisingly good. The comparison of asymptotic distributions shows that the diagnostics of the three models fitted on the reduced dataset are as stable as the ones fitted on the imputed dataset. This is a positive result, indicating that the missing data is in fact missing at random as hypothesized, and that the imputation algorithm has done a good job at filling in missing values. This assumption is further strengthened in the next section, where we compare the best candidate models (in terms of BIC) from both datasets.
# Merge summaries of two models (imputed vs. reduced)export_summs(gfit1c, gfit2c, scale = TRUE, error_format = "[{conf.low}, {conf.high}]", digits = 3, model.names = c("model 1c", "model 2c"))# Compare asymptotic distributions of coefficients:p1 = plot_summs(gfit1c, gfit2c, scale = TRUE, plot.distributions = T, model.names = c("model 1c", "model 2c"))p2 = plot_summs(gfit1c, gfit2c, scale = TRUE, plot.distributions = F, inner_ci_level = .95, model.names = c("model 1c", "model 2c"))grid.arrange(p1, p2, ncol=2)
As already mentioned, likelihood-based scores are not directly comparable between models fitted on different datasets, still, given our rule of the thumb it’s safe to say a McFadden’s score of 0.56 indicates a very good fit on its own. Plotting the asymptotic distributions of the imputed dataset model’s coefficients next to those of the reduced model is a good way to compare standard errors and confirm that there is no radical change between the two approaches. The estimated coefficients of all predictors were found significant in both approaches, so we’re glad to observe that their inference remains consistent. The point estimate of the coefficient of Gender is higher in the model fitted to the reduced data, but its confidence interval overlaps with the one of the one fitted to the imputed model, therefore the inference between the two estimates is not significantly different.
By now we have enough evidence to believe that our missing data is, in fact, “missing at random” (MAR), i.e. the probability that a value is missing depends only on observed values and not on unobserved ones. If the MAR assumption holds, then MICE has done a good job at producing simulated observations that correctly represent the “real” missing data. Consequently, the model on the MICE-imputed dataset is consistent with the model on the reduced (listwise-deleted) dataset and, therefore, it’s safe to assume that both datasets are representative random subsamples of the population. We could, in theory, use any of the two datasets for the next steps of our analysis, but for the reasons of information gain we’ll go with the imputed dataset.
Having settled to the imputed dataset, we can proceed to the final stage of model selection that requires the creation and addition of a new predictor. We noticed that the addition of variable ‘from.Wuhan’ to the model improves the fit significantly by reducing BIC and increases pseudo-R2 by about .20. At this point, it isn’t obvious to us why a variable indicating whether a person is native to Wuhan should be of any relevance to mortality rate, let alone be so influential. Let’s have a closer look at this factor by testing the number of deaths per Wuhan natives versus non-natives.
There seems to be a striking difference between the mortality rates of those who are from Wuhan and those who are not. If we trust our data, such a counter-intuitive insight should not be ignored, but what could be the reason behind this difference? An unfortunate yet realistic assumption would be that people who are visitors in Wuhan either for business or tourism are, in average, of a higher income than the locals. We can challenge this assumption by comparing the death rates between those who are natives to Wuhan and those who are not. This can be achieved via a simple two-sample z-test for proportions and visualized as a barplot.
#-------------------------------------------------------------------#Inspecting proportion of mortality rate in Wuhan natives:#-------------------------------------------------------------------# Create dataframe:tmp = data.frame(rbind(  table(dat1_imp$y[dat1_imp$from.Wuhan==1]),  table(dat1_imp$y[dat1_imp$from.Wuhan==0])))names(tmp) = c("total", "deaths")tmp$death_rate = round(tmp$deaths/tmp$total, 3)tmp$from_wuhan = as.factor(c(1,0))# Compare proportions (deaths per cases between groups):se1 = sqrt(tmp$death_rate[1]*(1-tmp$death_rate[1])/tmp$total[1])  # Standard errors of proportions:se2 = sqrt(tmp$death_rate[2]*(1-tmp$death_rate[2])/tmp$total[2])tmp$prop_se = round(c(se1, se2), 4)print(tmp)print(prop.test(x = tmp$deaths, n = tmp$total, alternative = "greater"))# Barplot of proportions:ggplot(tmp, aes( y=death_rate, x=from_wuhan)) +  geom_bar(position="dodge", stat="identity", width=0.4,  color="black", fill="cyan", alpha=.2) +  geom_errorbar(aes(ymin=death_rate - prop_se, ymax=death_rate + prop_se), width=.1, position=position_dodge(.9))
Clearly, there’s a significant difference in the average mortality rate between Wuhan natives and non-natives. Let’s explore the same test for different covariates, such as the average number of days gone by before hospitalization between the two groups:
# Compare average number of days gone by before hospitalization # between both groups:d1 = dat1_imp$days_before_hosp[dat1_imp$from.Wuhan==1]d2 = dat1_imp$days_before_hosp[dat1_imp$from.Wuhan==0]sem1 = t.test(d1)$stderrsem2 = t.test(d1)$stderrtmp$avg_days = c(mean(d1), mean(d2))tmp$mean_se = c(sem1, sem2)print(tmp)t.test(d1, d2, alternative = "greater")# Barplot:b1 = ggplot(tmp, aes( y=avg_days, x=from_wuhan, fill=from_wuhan)) +   geom_bar(position="dodge", stat="identity", width = .4, alpha=1) +   geom_errorbar(aes(ymin=avg_days - mean_se, ymax=avg_days + mean_se), width=.1, position=position_dodge(.9)) # Boxplot:df = data.frame(days = c(d1, d2), from_wuhan = as.factor(c(numeric(length(d1))+1, numeric(length(d2)) )) )b2 = ggplot(df, aes( y=days, x=from_wuhan, fill=from_wuhan)) +   geom_boxplot(outlier.colour="black", outlier.shape=16,   outlier.size=2, notch=T) +  stat_summary(fun=mean, geom="point", shape=23, size=4) grid.arrange(b1, b2, ncol=2)
As suspected, there is also a significant difference in this test. The distance between their means may be small (3.70 versus 2.68), but their difference is statistically significant, which further strengthens our hypothesis about a latent connection between the factor ‘from.Wuhan’ and the individual’s socioeconomic status. At this point we can speculate that variable ‘from.Wuhan’ acts as confounding factor for another latent variable. In other words, there might be another predictor carrying all socioeconomic information, to which ‘from.Wuhan’ correlates. A logical assumption would be that this latent predictor is ‘country’, on the grounds that someone’s ethnicity is directly correlated to both his/her socioeconomic status as well as the event of being a native to Wuhan. We’ve already established that can’t add ‘country’ into the model because of its low variance, but we can ‘from.Wuhan’ under the assumption that it acts as its proxy. There has to be another latent variable that is more granular than ‘from.Wuhan’ and, at the time, is correlated to ‘country’.
We will introduce a country-level macroeconomic variable such as GDP (PPP), which expresses a country’s gross domestic product (at purchasing power parity) per capita. If there is a significant difference in the average GDP value per country between groups (from Wuhan, not from Wuhan), then our initial assumption about the patient’s wealth being associated to mortality rate will be further strengthened. Ultimately, this variable should also improve the fit of our model.
Let’s create a data vector for GDP, where the order of elements corresponds to the order of country names (as listed by ‘levels(dat$country)’):
# Adding GDP (PPP):dat = dat1_impdat$gdp = 0gdp_per_country = c(2182, 16091, 54799, 55171, 51991, 50904, 5004,                     52144, 20984, 29207, 14800, 49548, 48640, 55306,                     66527, 9027, 17832, 40337, 41582, 46827, 67891,                     15599, 34567, 3550, 10094, 30820, 105689, 46452,                     43007, 14509, 55989, 67558, 57214, 21361, 70441,                     48169, 67426, 8677)for(i in 1:length(gdp_per_country)){  country = levels(dat$country)[i]  country_inds = dat$country == country  dat$gdp[country_inds] = gdp_per_country[i]}
A new column called ‘gdp’ is now part of the imputed data. Let’s see what happens when we introduce that variable into our model.
The model with GDP will, therefore, be of the following form:
#----------------------------------------------------------------# Model 4: Adding GDP (PPP)#----------------------------------------------------------------# Fit model with GDP:gfit1d = glm(y~gender+age+days_before_hosp+from.Wuhan+gdp, data = dat, binomial)# Compare models with GDP with and without GDP:# Merge model summaries:export_summs(gfit1c, gfit1d, scale = F, error_format = "[{conf.low}, {conf.high}]", model.names = c("without GDP", "with GDP"))# Compare asymtotic distributions:f1 = plot_summs(gfit1c, gfit1d, scale = TRUE, plot.distributions = TRUE, model.names = c("without GDP", "with GDP"))f2 = plot_summs(gfit1c, gfit2c, scale = TRUE, plot.distributions = F, inner_ci_level = .95, model.names = c("without GDP", "with GDP"))grid.arrange(f1, f2, ncol=2)# Final model summary:summ(gfit1d, scale = F, plot.distributions = TRUE, inner_ci_level = .9, digits = 3)gfit = gfit1d   #rename final model
As speculated, adding GDP into our model has further improved the fit as shown by a significant reduction in BIC and an increase in pseudo-R2. Its coefficient may be very small (possibly due to the presence of ‘from.Wuhan’ in our model) but its impact is nonetheless significant. We can further compare the average GDP per group (Wuhan natives versus non-natives) to assess whether their difference is significant:
# Mean GDP per group (from Wuhan):d3 = dat$gdp[dat$from.Wuhan==1]d4 = dat$gdp[dat$from.Wuhan==0]t.test(d3, d4)sem3 = t.test(d3)$stderrsem4 = t.test(d4)$stderrtmp$avg_gdp = c(mean(d3), mean(d4))tmp$mean_se_gdp = c(sem3, sem4)# Barplot:f3 = ggplot(tmp, aes( y=avg_gdp, x=from_wuhan, fill=from_wuhan)) + geom_bar(position="dodge", stat="identity", width = .5) + geom_errorbar(aes(ymin=avg_gdp-mean_se_gdp, ymax=avg_gdp+mean_se_gdp), width=.1, position=position_dodge(.9)) # Boxplot:df = data.frame(days = c(d1, d2), gdp = c(d3, d4), from_wuhan = as.factor(c(numeric(length(d1))+1, numeric(length(d2)) )) )f4 = ggplot(df, aes( y=gdp, x=from_wuhan, fill=from_wuhan)) +   geom_boxplot(outlier.colour="black", outlier.shape=16,   outlier.size=2, notch=FALSE) +   stat_summary(fun=mean, geom="point", shape=23, size=4)grid.arrange(f3, f4, ncol=2)
Our hypothesis test confirms that the average GDP (PPP) in deceased patients from Wuhan is significantly different to the average GDP (PPP) from deceased patients who are not from Wuhan. This is a further confirmation in favor of our model’s coefficient p-values.
So far we’ve confirmed that the imputed dataset is the “best” dataset, and that the model with predictors ‘age’, ‘gender’, ‘days_before_hosp’, ‘from.Wuhan’, ‘gdp’, is the one closest to the “true” model. As a last step in our modeling process, we will use computational inference in order to assess coefficient stability and evaluate the homogeneity of our sample.
So far we’ve been through a conservative model selection process which has led to a model that we believe to be close to the true model. A final step in the validation process would be to test the stability of model coefficients through a bootstrap procedure. If our coefficients are found to be “stable” then our sample can be considered homogeneous and our estimates reliable. The stability of coefficients here is evaluated using two criteria:
The statistical significance of computational/bagged coefficient estimates (i.e. assessed when the empirical distribution does not include zero)
The closeness of computational/bagged estimates to asymptotic estimates (i.e. assessed when the distribution of the difference between the asymptotic and computational means does include zero)
Note that the purpose of bootstrap aggregation (bagging) and resampling, in this context, is not exactly identical to that of Random Forest. We will use random subsampling with replacement to train multiple models, but our goal is to create bagged estimates and bootstrap confidence intervals for model coefficients, not for model predictions. Bagging will be used to produce point estimates for model parameters (bagged coefficients), while the empirical bootstrap distributions and associated bootstrap confidence intervals of those bagged estimates will allow us to evaluate model stability of estimation. In its simplest form, this evaluation consists of testing the hypothesis that the bagged estimates are equal to the asymptotic estimates, which comes down to comparing the asymptotic distribution and the bootstrap distribution of the same parameter. One way to achieve this is by testing the null that the difference between bagged and asymptotic estimates is equal to zero. If we can show that the asymptotic estimate is likely not different from the computational (bootstrap) estimate, we can safely assume that we have converged to the “true” coefficients.
We use our custom function ‘bagged_glm’ to obtain bootstrap distributions for model parameters. The ‘alpha’ argument is used in model summary statistics, the ‘class_balancing’ flag resamples the undersampled class at 50% (not used), the ‘bag_pct’ argument determines the size of the training bag, and flag ‘ocv’ activates out-of-bad cross validation (equivalent to Random Forest’s out-of-bag error).
#-------------------------------------------------# Coefficient stability (final model):#-------------------------------------------------bagged_results = bagged_glm(dat = dat, gfit = gfit, alpha = 0.05, class_balancing = F, bag_pct = 0.80, ocv = T)coef_bags_df = bagged_results$coef_bags_df
Let’s have a look at the results of computational inference:
# Bootstrap means of transformed coefficients:cat(    "\n Bootstrap means of back-transformed coefficients:\n",    "Intercept: ", mean(coef_bags_df$`(Intercept)`),     "Gender: ", mean(coef_bags_df$gendermale),        "Age: ", mean(coef_bags_df$age),         "Days before hospitalization: ",      mean(coef_bags_df$days_before_hosp),    "From Wuhan: ", mean(coef_bags_df$from.Wuhan1),    "\n")# Compare with asymptotic values: (merge with table above)coefficients(gfit)confint(gfit)
# Test null distribution directly: H0: m2-m1 = 0 par(mfcol=c(3,2))for(i in 1:length(bagged_results$coef_bags_df)){  d = bagged_results$coef_bags_df[[i]] - coefficients(gfit)[i]  qtt = quantile(d, c(.975, .025))    att = t.test(d)  hist(d, col="lightblue", main = names(coefficients(gfit)[i]),   breaks = 30)  abline(v = 0, col="blue", lwd=3, lty=2)  abline(v = qtt[1], col="red", lwd=3, lty=2)  abline(v = qtt[2], col="red", lwd=3, lty=2)}dev.off()
As we see in the above histograms, the distribution of the difference d between bagged and asymptotic estimates μ2 - μ1 does include zero (blue line) within its bootstrap confidence interval (red lines). Therefore, the null hypothesis:
fails to be rejected at the 95% significance level. Even though the failure to reject a null hypothesis does not imply its acceptance, this finding combined to all our previous findings should suffice to assume the reliability of our estimation and allow us to move onto model interpretation.
As the long-awaited step in the analysis, we can finally move onto to interpreting the coefficients of our model. Recall that any binomial logit model (equation [1]) can be expressed as:
Solving for β0 yields:
Solving for βj yields:
and finally:
The value of β0 in expression [2] can be translated as the odds of the response being 1, when all continuous regressors are 0 and categorical regressors are at their base level. In our scenario, we can say that “the average probability of death when days before hospitalization, age of patient, and GDP, are at zero, and the patient is not a native to Wuhan”. Obviously, patient age and GDP being equal to 0 is a nonsensical interpretation but, as previously stated, we’re not interested in the direct interpretation of β0 in this analysis (otherwise we could have used an intercept correction technique). The interpretation of βj in expression [3] is the one that interests us, and it can be generically interpreted as the percentage change in the odds of the response (being equal to 1) for every unit-increase in regressor j, if x continuous, or for the transition from the base level to the current level if x is categorical; ceteris paribus. For this interpretation to make any sense, we must adapt it to our scenario and look at βj simply as:
“The percentage change in the probability of mortality”,
for whatever change corresponds to regressor j, all else being equal. We can apply this interpretation to the coefficients of our final model:
So let’s summarize the coefficients of our model in both raw and transformed form:
glm.transform(gfit, alpha = .10, logodds_str = "exp(beta)%", ci = T, stdout = F)
glm.plot(gfit, alpha = 0.10, logodds_str = "exp(beta)%", stdout = F)
We can keep the transformed coefficient as a factor and interpret the odds of Y to be a number of times higher to those of X, or we can use the percentage change form and say that the probability of Y changes by a certain proportion for every change in X, as explained. Personally, I find the latter interpretation to be more intuitive and below we can see its application on each of our model’s coefficients at the 90% confidence level:
[Age] — exp(β1): The risk of death for a patient with COVID-19 increases by roughly 11% for every yearly increase in age. (CI: 8.36%-14.97%)A more intuitive way to express this insight would be to multiply the transformed coefficient by a factor of 10 and derive a 114% increase in odds for a 10-year increase in age. We can, therefore, say that:COVID-19’s mortality risk almost doubles with every 10-year increase of age.
[Gender] — exp(β2): COVID-19’s mortality risk is 120% higher in men, compared to that of women. (CI: 8.67%-367%)
[daysBeforeHosp] — exp(β3): The risk of death for a patient with COVID-19 increases by 12% every day the patient stays unhospitalized after the first day he/she developed first symptoms. (CI: 2.7%-20.9%)
[fromWuhan] — exp(β4): COVID-19’s mortality risk is roughly 6 times higher for patients native to Wuhan. (CI: 231%-1577%)
[GDP] — exp(β5): COVID-19’s mortality risk is indirectly impacted by the patient’s country of origin GDP (PPP). The effect is too weak to quantify though, combined with ‘fromWuhan’, it likely implies a dependence between a patient’s chance to survive and their individual wealth.