1 The sore throat dataset

The sore throat dataset contains results of a study on throat soarness upon surgery with general anaesthesia. The variable sore encodes whether a patient experienced a sore throat on waking (0: no, 1: yes) as a function of the duration of the surgery (duration) in minutes and the type of device (variable type) used to secure the airway: laryngeal mask (“mask”) or tracheal tube (“tube”) (Data taken from Agresti 2002).

2 Goals

  • Explore the dataset
  • Fit a logit model using “type” and interpret the parameter estimate
  • Fit a logit model considering all predictors, interpret parameter estimates, and conduct inference about the effects.
library(tidyverse)
library(car)

3 Import data

sore <- read_csv("https://raw.githubusercontent.com/GTPB/PSLS20/master/data/sore.csv")
head(sore)
## # A tibble: 6 x 3
##   duration type   sore
##      <dbl> <chr> <dbl>
## 1       45 mask      0
## 2       15 mask      0
## 3       40 mask      1
## 4       83 tube      1
## 5       90 tube      1
## 6       25 tube      1
## set the type and sore variables as factors
sore <- sore %>%
  mutate(type = as.factor(type), sore = as.factor(sore))

4 Data Exploration

table(sore[,c("type","sore")])
##       sore
## type    0  1
##   mask  4 14
##   tube  9  8
plot(as.double(sore)~duration,pch=as.double(type),col=as.double(type), data=sore)
legend("bottomright",pch=1:2,col=1:2,legend=levels(sore$type))

5 Analysis: logistic regression

5.1 Type variable as only predictor

fitType=glm(sore~type,data=sore,family=binomial)
#inference/interpretation
summary(fitType)
## 
## Call:
## glm(formula = sore ~ type, family = binomial, data = sore)
## 
## Deviance Residuals: 
##    Min      1Q  Median      3Q     Max  
## -1.734  -1.128   0.709   0.709   1.228  
## 
## Coefficients:
##             Estimate Std. Error z value Pr(>|z|)  
## (Intercept)   1.2528     0.5669   2.210   0.0271 *
## typetube     -1.3705     0.7467  -1.836   0.0664 .
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for binomial family taken to be 1)
## 
##     Null deviance: 46.180  on 34  degrees of freedom
## Residual deviance: 42.578  on 33  degrees of freedom
## AIC: 46.578
## 
## Number of Fisher Scoring iterations: 4
confint(fitType)
## Waiting for profiling to be done...
##                  2.5 %     97.5 %
## (Intercept)  0.2275566 2.51346332
## typetube    -2.9292777 0.04379487
anova(fitType,test="LRT")
## Analysis of Deviance Table
## 
## Model: binomial, link: logit
## 
## Response: sore
## 
## Terms added sequentially (first to last)
## 
## 
##      Df Deviance Resid. Df Resid. Dev Pr(>Chi)  
## NULL                    34     46.180           
## type  1   3.6022        33     42.578   0.0577 .
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

Interpretation of the model coefficients:

14/4 # odds on sore throat when wearing mask
## [1] 3.5
exp(fitType$coef[1]) # odds on sore throat when wearing mask
## (Intercept) 
##         3.5
8/9 # odds on sore throat when having tube
## [1] 0.8888889
exp(fitType$coef[1]+fitType$coef[2]) # odds on sore throat when having tube
## (Intercept) 
##   0.8888889
(8/9)/(14/4) # odds ration type
## [1] 0.2539683
exp(fitType$coef[2]) # odds ration type
##  typetube 
## 0.2539683

Note that the model above did not account for differences in the duration of the treatment.

5.2 Model Selection

We first will fit a model with a main effects for type, duration and a type x duration interaction (full model, all variable and interaction terms are incorporated).

fitTypeDurationInt=glm(sore~type*duration,data=sore,family=binomial)
summary(fitTypeDurationInt,cor=TRUE)
## 
## Call:
## glm(formula = sore ~ type * duration, family = binomial, data = sore)
## 
## Deviance Residuals: 
##     Min       1Q   Median       3Q      Max  
## -1.9707  -0.3779   0.3448   0.7292   1.9961  
## 
## Coefficients:
##                   Estimate Std. Error z value Pr(>|z|)  
## (Intercept)        0.04979    1.46940   0.034   0.9730  
## typetube          -4.47224    2.46707  -1.813   0.0699 .
## duration           0.02848    0.03429   0.831   0.4062  
## typetube:duration  0.07460    0.05777   1.291   0.1966  
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for binomial family taken to be 1)
## 
##     Null deviance: 46.180  on 34  degrees of freedom
## Residual deviance: 28.321  on 31  degrees of freedom
## AIC: 36.321
## 
## Number of Fisher Scoring iterations: 6
## 
## Correlation of Coefficients:
##                   (Intercept) typetube duration
## typetube          -0.60                        
## duration          -0.92        0.55            
## typetube:duration  0.55       -0.91    -0.59
Anova(fitTypeDurationInt,test="LR",type=3)
## Analysis of Deviance Table (Type III tests)
## 
## Response: sore
##               LR Chisq Df Pr(>Chisq)  
## type            3.9458  1    0.04699 *
## duration        0.8069  1    0.36904  
## type:duration   1.8169  1    0.17768  
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
fitTypeDurationInt$coefficients
##       (Intercept)          typetube          duration typetube:duration 
##        0.04978674       -4.47224144        0.02847802        0.07460127
exp(fitTypeDurationInt$coef[1])
## (Intercept) 
##    1.051047
exp(fitTypeDurationInt$coef[2])
##   typetube 
## 0.01142169
exp(fitTypeDurationInt$coef[3])
## duration 
## 1.028887
#############
#odds on sore throat when wearing mask
exp(fitTypeDurationInt$coef[1])
## (Intercept) 
##    1.051047
#odds on sore throat when having tube
exp(fitTypeDurationInt$coef[1]+fitTypeDurationInt$coef[2])
## (Intercept) 
##  0.01200473
#odds ration type
exp(fitTypeDurationInt$coef[2]) 
##   typetube 
## 0.01142169

We can also fit the model without the interaction effect:

fitTypeDurationNoInt=glm(sore~type+duration,data=sore,family=binomial)
summary(fitTypeDurationNoInt,cor=TRUE)
## 
## Call:
## glm(formula = sore ~ type + duration, family = binomial, data = sore)
## 
## Deviance Residuals: 
##     Min       1Q   Median       3Q      Max  
## -2.3802  -0.5358   0.3047   0.7308   1.7821  
## 
## Coefficients:
##             Estimate Std. Error z value Pr(>|z|)   
## (Intercept) -1.41734    1.09457  -1.295  0.19536   
## typetube    -1.65895    0.92285  -1.798  0.07224 . 
## duration     0.06868    0.02641   2.600  0.00931 **
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for binomial family taken to be 1)
## 
##     Null deviance: 46.180  on 34  degrees of freedom
## Residual deviance: 30.138  on 32  degrees of freedom
## AIC: 36.138
## 
## Number of Fisher Scoring iterations: 5
## 
## Correlation of Coefficients:
##          (Intercept) typetube
## typetube -0.25               
## duration -0.83       -0.16
Anova(fitTypeDurationNoInt,test="LR",type=3)
## Analysis of Deviance Table (Type III tests)
## 
## Response: sore
##          LR Chisq Df Pr(>Chisq)    
## type       3.5134  1  0.0608744 .  
## duration  12.4396  1  0.0004203 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
confint(fitTypeDurationNoInt)
## Waiting for profiling to be done...
##                   2.5 %     97.5 %
## (Intercept) -3.80786158 0.61635531
## typetube    -3.64627873 0.07434058
## duration     0.02547651 0.13216711

We assessed the significance of the different covariates in the model by using a likelihood ratio tests (Anova function in R) because the p-values are more accurate than the p-values of the Wald-tests (summary function in R). The interaction between type and duration is not significant (p=0.178). Hence the interaction term can be removed from the model. In the model with main effects for type and duration, the duration effect is extremely significant (p$<$0.001). The main effect of type is not significant (p=0.061). However, since the effect of type is close to be statistically significant we will leave it in the model so as to estimate a “pure” effect for duration. If we remove type from the model and if the effect truly exists but there was not enough power for detecting it, then removing the type from the model might result in a biased parameter estimate for duration as it might capture a part of the effect of type.

6 Conclusion

The effect of the duration of surgery on the odds on a sore throat is extremely significant (p<0.001). If the time of surgery increases, patients have a higher probability to wake up with a sore throat. The odds ratio for a one minute increase in surgery duration is 1.07 (95% CI [1.03,1.14]). There is no significant interaction between the type of anaesthesia and duration of the surgery (p=0.117). While there is some evidence in the data suggesting that the use of a tube is beneficial, i.e. the odds on a sore throat is more than a factor of 5 lower when using an anaesthesia with a tube than with a mask (OR=0.19, 95% CI [0.02,1.08]), the latter effect is not statistically significant (p=0.061).


LS0tCnRpdGxlOiAiVHV0b3JpYWwgMTAuMjogTG9naXN0aWMgcmVncmVzc2lvbiBvbiB0aGUgc29yZSB0aHJvYXQgZGF0YXNldCIgICAKb3V0cHV0OgogICAgaHRtbF9kb2N1bWVudDoKICAgICAgY29kZV9kb3dubG9hZDogdHJ1ZSAgICAKICAgICAgdGhlbWU6IGNvc21vCiAgICAgIHRvYzogdHJ1ZQogICAgICB0b2NfZmxvYXQ6IHRydWUKICAgICAgaGlnaGxpZ2h0OiB0YW5nbwogICAgICBudW1iZXJfc2VjdGlvbnM6IHRydWUKLS0tCgojIFRoZSBzb3JlIHRocm9hdCBkYXRhc2V0CgpUaGUgc29yZSB0aHJvYXQgZGF0YXNldCBjb250YWlucyByZXN1bHRzIG9mIGEgc3R1ZHkgb24gdGhyb2F0IHNvYXJuZXNzIHVwb24gc3VyZ2VyeSB3aXRoIGdlbmVyYWwgYW5hZXN0aGVzaWEuICBUaGUgdmFyaWFibGUgc29yZSBlbmNvZGVzIHdoZXRoZXIgYSBwYXRpZW50IGV4cGVyaWVuY2VkIGEgc29yZSB0aHJvYXQgb24gd2FraW5nICgwOiBubywgMTogeWVzKSAgYXMgYSBmdW5jdGlvbiBvZiB0aGUgZHVyYXRpb24gb2YgdGhlIHN1cmdlcnkgKGR1cmF0aW9uKSBpbiBtaW51dGVzIGFuZCB0aGUgdHlwZSBvZiBkZXZpY2UgKHZhcmlhYmxlIHR5cGUpIHVzZWQgdG8gc2VjdXJlIHRoZSBhaXJ3YXk6IGxhcnluZ2VhbCBtYXNrICgibWFzayIpIG9yIHRyYWNoZWFsIHR1YmUgKCJ0dWJlIikgKERhdGEgdGFrZW4gZnJvbSBBZ3Jlc3RpIDIwMDIpLgoKIyBHb2FscwoKLSBFeHBsb3JlIHRoZSBkYXRhc2V0Ci0gRml0IGEgbG9naXQgbW9kZWwgdXNpbmcgInR5cGUiIGFuZCBpbnRlcnByZXQgdGhlIHBhcmFtZXRlciBlc3RpbWF0ZQotIEZpdCBhIGxvZ2l0IG1vZGVsIGNvbnNpZGVyaW5nIGFsbCBwcmVkaWN0b3JzLCBpbnRlcnByZXQgcGFyYW1ldGVyIGVzdGltYXRlcywgYW5kIGNvbmR1Y3QgaW5mZXJlbmNlIGFib3V0IHRoZSBlZmZlY3RzLgoKYGBge3IsIG1lc3NhZ2U9RkFMU0V9CmxpYnJhcnkodGlkeXZlcnNlKQpsaWJyYXJ5KGNhcikKYGBgCgojIEltcG9ydCBkYXRhCgpgYGB7ciwgbWVzc2FnZSA9RkFMU0V9CnNvcmUgPC0gcmVhZF9jc3YoImh0dHBzOi8vcmF3LmdpdGh1YnVzZXJjb250ZW50LmNvbS9HVFBCL1BTTFMyMC9tYXN0ZXIvZGF0YS9zb3JlLmNzdiIpCmhlYWQoc29yZSkKYGBgCgpgYGB7cn0KIyMgc2V0IHRoZSB0eXBlIGFuZCBzb3JlIHZhcmlhYmxlcyBhcyBmYWN0b3JzCnNvcmUgPC0gc29yZSAlPiUKICBtdXRhdGUodHlwZSA9IGFzLmZhY3Rvcih0eXBlKSwgc29yZSA9IGFzLmZhY3Rvcihzb3JlKSkKYGBgCgojIERhdGEgRXhwbG9yYXRpb24KCmBgYHtyfQp0YWJsZShzb3JlWyxjKCJ0eXBlIiwic29yZSIpXSkKYGBgCgpgYGB7cn0KcGxvdChhcy5kb3VibGUoc29yZSl+ZHVyYXRpb24scGNoPWFzLmRvdWJsZSh0eXBlKSxjb2w9YXMuZG91YmxlKHR5cGUpLCBkYXRhPXNvcmUpCmxlZ2VuZCgiYm90dG9tcmlnaHQiLHBjaD0xOjIsY29sPTE6MixsZWdlbmQ9bGV2ZWxzKHNvcmUkdHlwZSkpCmBgYAoKIyBBbmFseXNpczogbG9naXN0aWMgcmVncmVzc2lvbgoKIyMgVHlwZSB2YXJpYWJsZSBhcyBvbmx5IHByZWRpY3RvcgoKYGBge3J9CmZpdFR5cGU9Z2xtKHNvcmV+dHlwZSxkYXRhPXNvcmUsZmFtaWx5PWJpbm9taWFsKQojaW5mZXJlbmNlL2ludGVycHJldGF0aW9uCnN1bW1hcnkoZml0VHlwZSkKY29uZmludChmaXRUeXBlKQphbm92YShmaXRUeXBlLHRlc3Q9IkxSVCIpCmBgYAoKSW50ZXJwcmV0YXRpb24gb2YgdGhlIG1vZGVsIGNvZWZmaWNpZW50czoKCmBgYHtyfQoxNC80ICMgb2RkcyBvbiBzb3JlIHRocm9hdCB3aGVuIHdlYXJpbmcgbWFzawpleHAoZml0VHlwZSRjb2VmWzFdKSAjIG9kZHMgb24gc29yZSB0aHJvYXQgd2hlbiB3ZWFyaW5nIG1hc2sKCjgvOSAjIG9kZHMgb24gc29yZSB0aHJvYXQgd2hlbiBoYXZpbmcgdHViZQpleHAoZml0VHlwZSRjb2VmWzFdK2ZpdFR5cGUkY29lZlsyXSkgIyBvZGRzIG9uIHNvcmUgdGhyb2F0IHdoZW4gaGF2aW5nIHR1YmUKCig4LzkpLygxNC80KSAjIG9kZHMgcmF0aW9uIHR5cGUKZXhwKGZpdFR5cGUkY29lZlsyXSkgIyBvZGRzIHJhdGlvbiB0eXBlCmBgYAoKTm90ZSB0aGF0IHRoZSBtb2RlbCBhYm92ZSBkaWQgbm90IGFjY291bnQgZm9yIGRpZmZlcmVuY2VzIGluIHRoZSBkdXJhdGlvbiBvZiB0aGUgdHJlYXRtZW50LgoKIyMgTW9kZWwgU2VsZWN0aW9uCgpXZSBmaXJzdCB3aWxsIGZpdCBhIG1vZGVsIHdpdGggYSBtYWluIGVmZmVjdHMgZm9yIHR5cGUsIGR1cmF0aW9uIGFuZCBhIHR5cGUgeCBkdXJhdGlvbiBpbnRlcmFjdGlvbiAoZnVsbCBtb2RlbCwgYWxsIHZhcmlhYmxlIGFuZCBpbnRlcmFjdGlvbiB0ZXJtcyBhcmUgaW5jb3Jwb3JhdGVkKS4KCmBgYHtyfQpmaXRUeXBlRHVyYXRpb25JbnQ9Z2xtKHNvcmV+dHlwZSpkdXJhdGlvbixkYXRhPXNvcmUsZmFtaWx5PWJpbm9taWFsKQpzdW1tYXJ5KGZpdFR5cGVEdXJhdGlvbkludCxjb3I9VFJVRSkKQW5vdmEoZml0VHlwZUR1cmF0aW9uSW50LHRlc3Q9IkxSIix0eXBlPTMpCmBgYAoKYGBge3J9CmZpdFR5cGVEdXJhdGlvbkludCRjb2VmZmljaWVudHMKYGBgCgpgYGB7cn0KZXhwKGZpdFR5cGVEdXJhdGlvbkludCRjb2VmWzFdKQpleHAoZml0VHlwZUR1cmF0aW9uSW50JGNvZWZbMl0pCmV4cChmaXRUeXBlRHVyYXRpb25JbnQkY29lZlszXSkKYGBgCgpgYGB7cn0KIyMjIyMjIyMjIyMjIwojb2RkcyBvbiBzb3JlIHRocm9hdCB3aGVuIHdlYXJpbmcgbWFzawpleHAoZml0VHlwZUR1cmF0aW9uSW50JGNvZWZbMV0pCiNvZGRzIG9uIHNvcmUgdGhyb2F0IHdoZW4gaGF2aW5nIHR1YmUKZXhwKGZpdFR5cGVEdXJhdGlvbkludCRjb2VmWzFdK2ZpdFR5cGVEdXJhdGlvbkludCRjb2VmWzJdKQojb2RkcyByYXRpb24gdHlwZQpleHAoZml0VHlwZUR1cmF0aW9uSW50JGNvZWZbMl0pIApgYGAKCldlIGNhbiBhbHNvIGZpdCB0aGUgbW9kZWwgd2l0aG91dCB0aGUgaW50ZXJhY3Rpb24gZWZmZWN0OgoKYGBge3J9CmZpdFR5cGVEdXJhdGlvbk5vSW50PWdsbShzb3JlfnR5cGUrZHVyYXRpb24sZGF0YT1zb3JlLGZhbWlseT1iaW5vbWlhbCkKc3VtbWFyeShmaXRUeXBlRHVyYXRpb25Ob0ludCxjb3I9VFJVRSkKQW5vdmEoZml0VHlwZUR1cmF0aW9uTm9JbnQsdGVzdD0iTFIiLHR5cGU9MykKY29uZmludChmaXRUeXBlRHVyYXRpb25Ob0ludCkKYGBgCgpXZSBhc3Nlc3NlZCB0aGUgc2lnbmlmaWNhbmNlIG9mIHRoZSBkaWZmZXJlbnQgY292YXJpYXRlcyBpbiB0aGUgbW9kZWwgYnkgdXNpbmcgYSBsaWtlbGlob29kIHJhdGlvIHRlc3RzIChBbm92YSBmdW5jdGlvbiBpbiBSKSBiZWNhdXNlIHRoZSBwLXZhbHVlcyBhcmUgbW9yZSBhY2N1cmF0ZSB0aGFuIHRoZSBwLXZhbHVlcyBvZiB0aGUgV2FsZC10ZXN0cyAgKHN1bW1hcnkgZnVuY3Rpb24gaW4gUikuIApUaGUgaW50ZXJhY3Rpb24gYmV0d2VlbiB0eXBlIGFuZCBkdXJhdGlvbiBpcyBub3Qgc2lnbmlmaWNhbnQgKHA9MC4xNzgpLiBIZW5jZSB0aGUgaW50ZXJhY3Rpb24gdGVybSBjYW4gYmUgcmVtb3ZlZCBmcm9tIHRoZSBtb2RlbC4gCkluIHRoZSBtb2RlbCB3aXRoIG1haW4gZWZmZWN0cyBmb3IgdHlwZSBhbmQgZHVyYXRpb24sIHRoZSBkdXJhdGlvbiBlZmZlY3QgaXMgZXh0cmVtZWx5IHNpZ25pZmljYW50IChwJDwkMC4wMDEpLiBUaGUgbWFpbiBlZmZlY3Qgb2YgdHlwZSBpcyBub3Qgc2lnbmlmaWNhbnQgKHA9MC4wNjEpLiAKSG93ZXZlciwgc2luY2UgdGhlIGVmZmVjdCBvZiB0eXBlIGlzIGNsb3NlIHRvIGJlIHN0YXRpc3RpY2FsbHkgc2lnbmlmaWNhbnQgd2Ugd2lsbCBsZWF2ZSBpdCBpbiB0aGUgbW9kZWwgc28gYXMgdG8gZXN0aW1hdGUgYSAicHVyZSIgZWZmZWN0IGZvciBkdXJhdGlvbi4gCklmIHdlIHJlbW92ZSB0eXBlIGZyb20gdGhlIG1vZGVsIGFuZCBpZiB0aGUgZWZmZWN0IHRydWx5IGV4aXN0cyBidXQgdGhlcmUgd2FzIG5vdCBlbm91Z2ggcG93ZXIgZm9yIGRldGVjdGluZyBpdCwgdGhlbiByZW1vdmluZyB0aGUgdHlwZSBmcm9tIHRoZSBtb2RlbCBtaWdodCByZXN1bHQgaW4gYSBiaWFzZWQgcGFyYW1ldGVyIGVzdGltYXRlIGZvciBkdXJhdGlvbiBhcyBpdCBtaWdodCBjYXB0dXJlIGEgcGFydCBvZiB0aGUgZWZmZWN0IG9mIHR5cGUuIAoKIyBDb25jbHVzaW9uClRoZSBlZmZlY3Qgb2YgdGhlIGR1cmF0aW9uIG9mIHN1cmdlcnkgb24gdGhlIG9kZHMgb24gYSBzb3JlIHRocm9hdCBpcyBleHRyZW1lbHkgc2lnbmlmaWNhbnQgKHA8MC4wMDEpLiBJZiB0aGUgdGltZSBvZiBzdXJnZXJ5IGluY3JlYXNlcywgcGF0aWVudHMgaGF2ZSBhIGhpZ2hlciBwcm9iYWJpbGl0eSB0byB3YWtlIHVwIHdpdGggYSBzb3JlIHRocm9hdC4gVGhlIG9kZHMgcmF0aW8gZm9yIGEgb25lIG1pbnV0ZSAgaW5jcmVhc2UgaW4gc3VyZ2VyeSBkdXJhdGlvbiBpcyAxLjA3ICg5NVwlIENJICBbMS4wMywxLjE0XSkuClRoZXJlIGlzIG5vIHNpZ25pZmljYW50IGludGVyYWN0aW9uIGJldHdlZW4gdGhlIHR5cGUgb2YgYW5hZXN0aGVzaWEgYW5kIGR1cmF0aW9uIG9mIHRoZSBzdXJnZXJ5IChwPTAuMTE3KS4gCldoaWxlIHRoZXJlIGlzIHNvbWUgZXZpZGVuY2UgaW4gdGhlIGRhdGEgc3VnZ2VzdGluZyB0aGF0IHRoZSB1c2Ugb2YgYSB0dWJlIGlzIGJlbmVmaWNpYWwsIGkuZS4gdGhlIG9kZHMgb24gYSBzb3JlIHRocm9hdCBpcyBtb3JlIHRoYW4gYSBmYWN0b3Igb2YgNSBsb3dlciB3aGVuIHVzaW5nIGFuIGFuYWVzdGhlc2lhIHdpdGggYSB0dWJlIHRoYW4gd2l0aCBhIG1hc2sgKE9SPTAuMTksIDk1XCUgQ0kgWzAuMDIsMS4wOF0pLCB0aGUgbGF0dGVyIGVmZmVjdCBpcyBub3Qgc3RhdGlzdGljYWxseSBzaWduaWZpY2FudCAocD0wLjA2MSkuIAoKCi0tLQoKIyBbSG9tZV0oaHR0cHM6Ly9ndHBiLmdpdGh1Yi5pby9QU0xTMjAvKSB7LX0=